-- CTFakeBcdImpl.Mesa, last edit March 21, 1983 5:52 pm
-- procedures to build the fake config in the compile tool
	
DIRECTORY
 BcdDefs: TYPE USING [Base, BCD, CTIndex, CTNull, CTRecord, EXPIndex, 
 	FTIndex, FTNull, FTRecord, FTSelf, GFTIndex, 
	Link, MTIndex, MTRecord, NameRecord, NullVersion, SGIndex, SGRecord, VersionID],
  BcdOps: TYPE USING [BcdBase, MTHandle, NameString, ProcessModules],
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [Capability],
  IO: TYPE USING[card, PutF, rope],
  -- CedarLinkerOps: TYPE USING[Export],
  CS: TYPE USING[NewFile, ReadWrite],
  CT: TYPE USING[GenUniqueBcdName, Global, MI, ModuleList],
  CTFakeBcd: TYPE USING[],
  CTLoad: TYPE USING [LoadInfoSeq, Zero],
  PilotLoadStateFormat: TYPE USING [ConfigIndex],
  PilotLoadStateOps: TYPE USING [ConfigIndex, EnterModule, GetMap, 
  		Map, ReleaseLoadState, ReleaseMap, UpdateLoadState],
  PrincOps: TYPE USING[GFTIndex],
  Rope: TYPE USING[Text],
  Space: TYPE USING [Create, Delete, -- ForceOut, -- Handle, LongPointer, Map, 
  	nullHandle, virtualMemory];
				
CTFakeBcdImpl: PROGRAM 
IMPORTS BcdOps, -- CedarLinkerOps, -- CS, CT, CTLoad, IO, PilotLoadStateOps, Space
EXPORTS CTFakeBcd  = {
	
-- no MDS usage!
	
MTPAGE: CARDINAL = (SIZE[BcdDefs.BCD]/Environment.wordsPerPage) + 1;
nmtp: CARDINAL = 20;
FTPAGE: CARDINAL = MTPAGE + nmtp;
nftp: CARDINAL = 6;
SGPAGE: CARDINAL = FTPAGE + nftp;
nsgp: CARDINAL = 6;
CTPAGE: CARDINAL = SGPAGE + nsgp;
nctp: CARDINAL = 1;
SSPAGE: CARDINAL = CTPAGE + nctp;
nssp: CARDINAL = 16;
EXPAGE: CARDINAL = SSPAGE + nssp;
nexp: CARDINAL = 3;
BCDPAGES: CARDINAL = EXPAGE + nexp;

-- also updates the load state with the modules
BuildFakeBcd: PUBLIC PROC[g: CT.Global] = {
	bcdSpace: Space.Handle _ Space.nullHandle;
	{
	ENABLE UNWIND => 
		IF bcdSpace ~= Space.nullHandle THEN Space.Delete[bcdSpace];
	Cbcdbase: BcdOps.BcdBase;
	Cctb, Cmtb, Csgb, Cftb, Cetb: BcdDefs.Base;
	Cmti: BcdDefs.MTIndex _ FIRST[BcdDefs.MTIndex];
	Cfti: BcdDefs.FTIndex _ FIRST[BcdDefs.FTIndex];
	Csgi: BcdDefs.SGIndex _ FIRST[BcdDefs.SGIndex];
	Ceti: BcdDefs.EXPIndex _ FIRST[BcdDefs.EXPIndex];
	Cnamei: CARDINAL;
	Cnamestring: BcdOps.NameString;
	Cngfi: CARDINAL _ 1;
	
	ProcAnalyze: PROC[mi: CT.MI] = {
		sgb, ftb: BcdDefs.Base;
		bcdbase: BcdOps.BcdBase;
		namestring: BcdOps.NameString;
		
			ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
				RETURNS[stop: BOOL] = {
			rgfi: PrincOps.GFTIndex;
			stop _ FALSE;
			Check[Cmti + MTRecordLength[mth], Cbcdbase.mtLimit];
			Cmtb[Cmti] _ mth^;
			Cmtb[Cmti].name _ NewName[namestring, mth.name];
			Cmtb[Cmti].gfi _ Cngfi;
			Cmtb[Cmti].extension _ direct[length: 0, frag:];
			IF mth.gfi >= mi.loadInfoSeq.dummymapseq.size THEN ERROR;
			-- this has previously been done in 
			--	CedarLoaderImpl.CreateGlobalFrames
			-- we do it here to set the map for the fake config
			rgfi _ mi.loadInfoSeq.dummymapseq[mth.gfi].ind;
			FOR i: CARDINAL IN [0 .. mth.ngfi) DO
				PilotLoadStateOps.EnterModule[rgfi+i, [resolved: TRUE, 
					config: g.configindex, gfi: Cngfi+i]];
				ENDLOOP;
			Cngfi _ Cngfi + mth.ngfi;
			Check[Cfti + SIZE[BcdDefs.FTRecord], Cbcdbase.ftLimit];
			IF mth.file = BcdDefs.FTSelf THEN {
				-- get info from header
				Cftb[Cfti] _ [NewName[namestring, bcdbase.source], 
					bcdbase.version];
				Cmtb[Cmti].file _ Cfti;
				Cfti _ Cfti + SIZE[BcdDefs.FTRecord];
				}
			ELSE IF mth.file = BcdDefs.FTNull THEN {
				Cmtb[Cmti].file _ BcdDefs.FTNull;
				}
			ELSE {
				Cftb[Cfti] _ ftb[mth.file];
				Cftb[Cfti].name _ NewName[namestring, 
					ftb[mth.file].name];
				Cmtb[Cmti].file _ Cfti;
				Cfti _ Cfti + SIZE[BcdDefs.FTRecord];
				};
			Check[Csgi + SIZE[BcdDefs.SGRecord], Cbcdbase.sgLimit];
			Csgb[Csgi] _ sgb[mth.sseg];
			Cmtb[Cmti].sseg _ Csgi;
			Check[Cfti + SIZE[BcdDefs.FTRecord], Cbcdbase.ftLimit];
			IF Csgb[Csgi].file = BcdDefs.FTSelf THEN {
				-- if self then the symbols are in the config's file
				Cftb[Cfti] _ [NewString[mi.bcdFileName], 
					bcdbase.version];
				Csgb[Csgi].file _ Cfti;
				Cfti _ Cfti + SIZE[BcdDefs.FTRecord];
				}
			ELSE IF Csgb[Csgi].file = BcdDefs.FTNull THEN {
				Csgb[Csgi].file _ BcdDefs.FTNull;
				}
			ELSE {
				Cftb[Cfti] _ ftb[Csgb[Csgi].file];
				Cftb[Cfti].name _ NewName[namestring, 
					ftb[Csgb[Csgi].file].name];
				Csgb[Csgi].file _ Cfti;
				Cfti _ Cfti + SIZE[BcdDefs.FTRecord];
				};
			Csgi _ Csgi + SIZE[BcdDefs.SGRecord];
			Cmti _ Cmti + SIZE[BcdDefs.MTRecord[direct]];
			Cbcdbase.nModules _ Cbcdbase.nModules + 1;
			};
			
		IF mi.loadInfoSeq = NIL THEN RETURN;
		bcdbase _ mi.loadInfoSeq.bcdbase;
		sgb _ LOOPHOLE[bcdbase + bcdbase.sgOffset, BcdDefs.Base];
		ftb _ LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base];
		namestring _ LOOPHOLE[bcdbase + bcdbase.ssOffset];
		[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
		};
		
	NewName: PROC[namestring: BcdOps.NameString, oldname: BcdDefs.NameRecord]
			RETURNS[newname: BcdDefs.NameRecord] = {
		newname _ LOOPHOLE[Cnamei];
		Check[(Cnamei + namestring.size[oldname] + 1)/2 + 1, Cbcdbase.ssLimit];
		Cnamestring.size[newname] _ namestring.size[oldname];
		FOR i: CARDINAL IN [0 .. Cnamestring.size[newname]) DO
			Cnamestring.string.text[newname + i] _
				namestring.string.text[oldname + i];
			ENDLOOP;
		Cnamei _ Cnamei + Cnamestring.size[newname] + 1;
		};
		
	NewString: PROC[oldrope: Rope.Text] RETURNS[newname: BcdDefs.NameRecord] = {
		oldstring: LONG STRING _ LOOPHOLE[oldrope];
		newname _ LOOPHOLE[Cnamei];
		Check[(Cnamei + oldstring.length + 1)/2, Cbcdbase.ssLimit];
		Cnamestring.size[newname] _ oldstring.length;
		FOR i: CARDINAL IN [0 .. Cnamestring.size[newname]) DO
			Cnamestring.string.text[newname + i] _ oldstring[i];
			ENDLOOP;
		Cnamei _ Cnamei + Cnamestring.size[newname] + 1;
		};
		
	
	{
	cap: File.Capability;
	map: PilotLoadStateOps.Map;
	bcdSpace _ Space.Create[size: BCDPAGES, parent: Space.virtualMemory];
	g.fakeBcdFileName _ CT.GenUniqueBcdName["FakeConfig"];
	cap _ CS.NewFile[g.fakeBcdFileName, CS.ReadWrite, BCDPAGES];
	Space.Map[space: bcdSpace, window: [cap, 1]];
	Cbcdbase _ Space.LongPointer[bcdSpace];
	[] _ CTLoad.Zero[Cbcdbase, BCDPAGES * Environment.wordsPerPage];
	Cbcdbase.versionIdent _ BcdDefs.VersionID;
	Cbcdbase.nPages _ BCDPAGES;
	Cbcdbase.version  _ BcdDefs.NullVersion;
	Cbcdbase.nConfigs _ 1;
	Cbcdbase.nModules _ 0;
	Cbcdbase.extended _ TRUE;	-- to keep the RT happy
	Cbcdbase.nImports _ Cbcdbase.nExports _ 0;
	-- all the Limit vars are set to 0
	Cbcdbase.impOffset _ Cbcdbase.evOffset _ 0;
	Cbcdbase.spOffset _ Cbcdbase.ntOffset _ Cbcdbase.typOffset _ 0;
	Cbcdbase.tmOffset _ Cbcdbase.fpOffset _ 0;
	Cbcdbase.ctOffset _ CTPAGE * Environment.wordsPerPage;
	Cbcdbase.mtOffset _ MTPAGE * Environment.wordsPerPage;
	Cbcdbase.sgOffset _ SGPAGE * Environment.wordsPerPage;
	Cbcdbase.ftOffset _ FTPAGE * Environment.wordsPerPage;
	Cbcdbase.expOffset _ EXPAGE * Environment.wordsPerPage;
	Cbcdbase.ssOffset _ SSPAGE * Environment.wordsPerPage;
	Cnamei _ 0;
	Cctb _ LOOPHOLE[Cbcdbase + Cbcdbase.ctOffset, BcdDefs.Base];
	Cmtb _ LOOPHOLE[Cbcdbase + Cbcdbase.mtOffset, BcdDefs.Base];
	Csgb _ LOOPHOLE[Cbcdbase + Cbcdbase.sgOffset, BcdDefs.Base];
	Cftb _ LOOPHOLE[Cbcdbase + Cbcdbase.ftOffset, BcdDefs.Base];
	Cetb _ LOOPHOLE[Cbcdbase + Cbcdbase.expOffset, BcdDefs.Base];
	Cnamestring _ LOOPHOLE[Cbcdbase + Cbcdbase.ssOffset, BcdDefs.Base];
	Cbcdbase.ctLimit _ FIRST[BcdDefs.CTIndex] + SIZE[BcdDefs.CTRecord];
	Cbcdbase.mtLimit _ LOOPHOLE[nmtp * Environment.wordsPerPage];
	Cbcdbase.ftLimit _ LOOPHOLE[nftp * Environment.wordsPerPage];
	Cbcdbase.sgLimit _ LOOPHOLE[nsgp * Environment.wordsPerPage];
	Cbcdbase.expLimit _ LOOPHOLE[nexp * Environment.wordsPerPage];
	Cbcdbase.ssLimit _ LOOPHOLE[nssp * Environment.wordsPerPage];
	LOOPHOLE[Cnamestring+1, LONG POINTER TO CARDINAL]^ _ (Cbcdbase.ssLimit-2)*2;	-- the maxlength of namestring
	Cnamestring.string.length _ Cnamestring.string.maxlength;
	 
	Cctb[FIRST[BcdDefs.CTIndex]] _ [name: NewString[g.fakeBcdFileName], 
		namedInstance: FALSE, file: BcdDefs.FTNull, config: BcdDefs.CTNull, 
		nControls: 0, controls:];
	
	-- that sets all the booleans to FALSE, etc.
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		ProcAnalyze[l.first];
		ENDLOOP;
	
	Cbcdbase.firstdummy _ Cngfi;	-- # gfi's needed for the modules in the config
	Cbcdbase.mtLimit _ Cmti;
	Cbcdbase.ftLimit _ Cfti;
	Cbcdbase.sgLimit _ Csgi;
	Cbcdbase.expLimit _ Ceti;
	Cbcdbase.ssLimit _ (Cnamei/2)+1;
	
	g.fakebcdspace _ bcdSpace;
	-- now insert the new bcdbase
	-- newer version of BcdOps
	PilotLoadStateOps.UpdateLoadState[g.configindex, LOOPHOLE[Cbcdbase]];
	map _ PilotLoadStateOps.GetMap[g.configindex];
	-- CedarLinkerOps.Export[LOOPHOLE[Cbcdbase], map];
	PilotLoadStateOps.ReleaseMap[map];
	PilotLoadStateOps.ReleaseLoadState[];
	g.dout.PutF["Total # of gfi's needed to load: %s.\n", IO.card[Cngfi]];
	-- this ForceOut is expensive, only need it for debugging
	-- Space.ForceOut[bcdSpace];
	g.dout.PutF["Fake bcd written out on %s\n", IO.rope[g.fakeBcdFileName]];
	}}};
	
Check: PROC[val, limit: UNSPECIFIED] = {
	IF LOOPHOLE[val, CARDINAL] >= LOOPHOLE[limit, CARDINAL] THEN ERROR;
	};
	
MTRecordLength: PROC[mth: BcdOps.MTHandle] RETURNS[len: CARDINAL] = {
	RETURN[WITH m: mth SELECT FROM
		direct => SIZE[BcdDefs.MTRecord[direct]] + m.length*SIZE[BcdDefs.Link],
		indirect => SIZE[BcdDefs.MTRecord[indirect]],
		multiple => SIZE[BcdDefs.MTRecord[multiple]],
		ENDCASE => ERROR];
	};
	
}.
	
	
	
	-- no longer needed
	AddToExports: PROC[interfaceseq: CTLoad.InterfaceSeq] = {
		Check[Cfti + SIZE[BcdDefs.FTRecord], Cbcdbase.ftLimit];
		Check[Ceti + SIZE[BcdDefs.EXPRecord] + interfaceseq.size, Cbcdbase.expLimit];
		Cftb[Cfti] _ [name: NewString[interfaceseq.name], version: interfaceseq.bcdVers];
		Cetb[Ceti] _ [name: NewString[interfaceseq.name], size: interfaceseq.size,
			port: interface, namedInstance: FALSE, typeExported: FALSE,
			file: Cfti, links: ];
		FOR i: CARDINAL IN [0 .. Cetb[Ceti].size) DO
			Cetb[Ceti].links[i] _ interfaceseq[i].blink;
			ENDLOOP;
		Cfti _ Cfti + SIZE[BcdDefs.FTRecord];
		Ceti _ Ceti + SIZE[BcdDefs.EXPRecord] + interfaceseq.size;
		Cbcdbase.nExports _ Cbcdbase.nExports + 1;
		};
			-- now put exports in export table
	{
	mi: CT.MI;
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.exportedInterface THEN {
			FOR l: LIST OF CTLoad.InterfaceSeq _ g.moduleExports, l.rest UNTIL l = NIL DO
				IF l.first.bcdVers = mi.bcdVers THEN {
					AddToExports[l.first];
					EXIT;
					};
				REPEAT
				FINISHED => {
					g.ttyout.PutF["Error - cannot find %s exported by this program.\n",
						IO.rope[mi.bcdFileName]];
					};
				ENDLOOP;
			};
		ENDLOOP;
	};