-- MDFakeBcdImpl.Mesa
-- last edit by Schmidt,  2-Mar-82 12:49:02
-- last edit by Satterthwaite, January 31, 1983 9:23 am
-- Mesa 7.0/ Pilot 6.0
-- procedures to load and start modules in a Model

-- can't use PilotLoaderOps since it is not exported by CoPilotDorado.Config
-- may use PilotLoadStateOps, however

-- links:
--	IF gfi > firstdummy, then gfi is index into Import table 
--		and ep is index into the export record pared with that import
--		binding is simply to copy control link in the export record
--		into this link
-- 	IF gfi < firstdummy, then gfi in this link is an index into the config's
--		moduletable.  Do not alter the ep

-- spaces:
--	assume there are n modules
--	there will be 
--	1 space in MDS for all the frames (and frame links)
--	1 space in VM for the Fake Config Bcd for the load state
--	n ReadOnly spaces for Code
--		n (up to n) subspaces for the code links
--		n subspaces for the code segments
--			(unless the bcd is Binder-output)
--	n spaces for the Bcd headers
--		(deleted on UnLoad)

DIRECTORY
  BcdDefs: TYPE USING [Base, BCD, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord, 
  	FTIndex, FTNull, FTRecord, FTSelf, GFTIndex, 
	Link, MTIndex, MTRecord, NameRecord, NullVersion, SGIndex, SGRecord, VersionID],
  BcdOps: TYPE USING [BcdBase, MTHandle, NameString, ProcessModules],
  CWF: TYPE USING [WF0, WF1, WF2, WF3, WF4],
  Dir: TYPE USING [FileInfo],
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [Capability],
  Inline: TYPE USING [LowHalf],
  LowLoader: TYPE USING [CloseLinkSpace, DummyMapSeq, InterfaceSeq, LinkSegmentLength, 
  	LoadInfoSeq, OpenLinkSpace, ReadLink, Zero],
  MDLoad: TYPE USING [],
  MDModel: TYPE USING [APPLSymbol, LISTSymbol, LOCSymbol, MODELSymbol, 
  	NarrowToAPPL, NarrowToLIST, NarrowToLOC, 
	NarrowToPROC, PROCSymbol, Symbol, SymbolSeq, TraverseList, TraverseTree],
  PilotLoadStateOps: TYPE USING [ConfigIndex, EnterModule, ReleaseLoadState, UpdateLoadState],
  PrincOps: TYPE USING [ControlLink, GFTIndex, GlobalFrameHandle, NullLink, UnboundLink],
  Space: TYPE USING [Create, Delete, ForceOut, Handle, LongPointer, Map, 
  	nullHandle, virtualMemory],
  Subr: TYPE USING [NewFile, ReadWrite];
			
MDFakeBcdImpl: PROGRAM 
IMPORTS BcdOps, CWF, Inline, LowLoader, MDModel, PilotLoadStateOps, Space, Subr
EXPORTS MDLoad  = {

-- 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[spmodel: MDModel.MODELSymbol, symbolseq: MDModel.SymbolSeq] = {
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;
cap: File.Capability;

	ProcAnalyze: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL _ TRUE] = {
	sgb, ftb: BcdDefs.Base;
	bcdbase: BcdOps.BcdBase;
	sploc: MDModel.LOCSymbol;
	namestring: BcdOps.NameString;
	
		ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
			RETURNS[stop: BOOL] = {
		rgfi: CARDINAL;
		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 >= sploc.fi.loadInfoSeq.dummymapseq.size THEN ERROR;
		rgfi _ sploc.fi.loadInfoSeq.dummymapseq[mth.gfi].ind;
		FOR i: CARDINAL IN [0 .. mth.ngfi) DO
			PilotLoadStateOps.EnterModule[rgfi+i, [resolved: TRUE, 
				config: spmodel.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[sploc.fi.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 sp.stype ~= typeLOC THEN RETURN;
	sploc _ MDModel.NarrowToLOC[sp];
	IF sploc.fi = NIL OR sploc.fi.loadInfoSeq = NIL THEN RETURN;
	bcdbase _ sploc.fi.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[oldstring: LONG STRING]
		RETURNS[newname: BcdDefs.NameRecord] = {
	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;
	};
	
	AddToExports: PROC[interfaceseq: LowLoader.InterfaceSeq] = {
	Check[Cfti + SIZE[BcdDefs.FTRecord], Cbcdbase.ftLimit];
	Check[Ceti + SIZE[BcdDefs.EXPRecord] + interfaceseq.size, Cbcdbase.expLimit];
	Cftb[Cfti] _ [name: NewString[interfaceseq.intname], version: interfaceseq.versstamp];
	Cetb[Ceti] _ [name: NewString[interfaceseq.intname], 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;
	};
	
bcdSpace _ Space.Create[size: BCDPAGES, parent: Space.virtualMemory];
cap _ Subr.NewFile["FakeConfig.Bcd"L, Subr.ReadWrite, BCDPAGES];
Space.Map[space: bcdSpace, window: [cap, 1]];
Cbcdbase _ Space.LongPointer[bcdSpace];
LowLoader.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["FakeConfig"L], 
	namedInstance: FALSE, file: BcdDefs.FTNull, config: BcdDefs.CTNull, 
	nControls: 0, controls:];

-- that sets all the booleans to FALSE, etc.
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];

-- now put exports in export table
{
splist: MDModel.LISTSymbol;
spproc: MDModel.PROCSymbol _ NIL;
splist _ spmodel.model;
WHILE splist ~= NIL AND splist.first.stype ~= typePROC DO
	splist _ splist.rest;
	ENDLOOP;
spproc _ MDModel.NarrowToPROC[splist.first];
splist _ spproc.procret;
WHILE splist ~= NIL DO
	IF splist.first.stype = typeAPPL THEN {
		spappl: MDModel.APPLSymbol _ MDModel.NarrowToAPPL[splist.first];
		IF spappl.interfaceseq ~= NIL THEN 
			AddToExports[spappl.interfaceseq];
		};
	splist _ splist.rest;
	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;

spmodel.fakebcdspace _ bcdSpace;
-- now insert the new bcdbase
-- newer version of BcdOps
PilotLoadStateOps.UpdateLoadState[spmodel.configindex, LOOPHOLE[Cbcdbase]];
PilotLoadStateOps.ReleaseLoadState[];
CWF.WF1["Total # of gfi's needed to load: %u.\n"L, @Cngfi];
Space.ForceOut[bcdSpace];
CWF.WF0["Fake bcd written out on FakeConfig.Bcd\n"L];
}};

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];
};

PrintFrameLinks: PROC[frame: PrincOps.GlobalFrameHandle, 
	bcdbase: BcdOps.BcdBase, mth: BcdOps.MTHandle] = {
links: LONG POINTER;
l, t: POINTER;
links _ LowLoader.OpenLinkSpace[frame, mth, bcdbase];
l _ Inline.LowHalf[links];
t _ l + LowLoader.LinkSegmentLength[mth, bcdbase];
CWF.WF3["Links from %bB to %bB, frame at %bB.\n"L, @l, @t, @frame];
FOR i: CARDINAL IN [0..LowLoader.LinkSegmentLength[mth, bcdbase]) DO
	PrintCLink[i, LowLoader.ReadLink[i]];
	ENDLOOP;
LowLoader.CloseLinkSpace[frame];
};

-- also in LowLoader, this one uses this CWF
PrintCLink: PROC[j: CARDINAL, link: PrincOps.ControlLink] = {
IF link = PrincOps.NullLink THEN 
	CWF.WF1["#%u: NullLink\n"L, @j]
ELSE IF link = PrincOps.UnboundLink THEN 
	CWF.WF1["#%u: UnboundLink\n"L, @j]
ELSE {
	gfi, ep: CARDINAL;
	gfi _ link.gfi;
	ep _ link.ep;
	CWF.WF4["#%u: gfi %bB ep %u, address %bB\n"L, @j, @gfi, @ep, @link];
	};
};

PrintFrames: PROC[spmodel: MDModel.MODELSymbol, 
	symbolseq: MDModel.SymbolSeq] = {

	ProcAnalyze: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL _ TRUE] = {
	
		-- calls itself recursively
		-- spmodel, sptop is passed in
		ProcLoc: PROC[spl: MDModel.Symbol] = {
		IF spl = NIL THEN RETURN;
		IF spl.stype = typeLIST THEN 
			MDModel.TraverseList[MDModel.NarrowToLIST[spl], ProcLoc]
		ELSE IF spl.stype = typeLOC THEN {
			mti: BcdDefs.MTIndex _ FIRST[BcdDefs.MTIndex];
			mth: BcdOps.MTHandle;
			bcdbase: BcdOps.BcdBase;
			sploc: MDModel.LOCSymbol;
			sploc _ MDModel.NarrowToLOC[spl];
			IF sploc.fi = NIL OR sploc.fi.loadInfoSeq = NIL THEN RETURN;	-- defs file
			CWF.WF1["Frame of %s.Bcd:\n"L, sploc.tail];
			FOR m: CARDINAL IN [0 .. sploc.fi.loadInfoSeq.size) DO
				bcdbase _ sploc.fi.loadInfoSeq.bcdbase;
				mth _ @LOOPHOLE[bcdbase + bcdbase.mtOffset, 
					BcdDefs.Base][mti];
				PrintFrameLinks[sploc.fi.loadInfoSeq[m].frame, 
					bcdbase, mth];
				mti _ mti + MTRecordLength[mth];
				ENDLOOP;
			};
		};
		
	WITH spt: sptop SELECT FROM
	typeTYPE => ProcLoc[spt.typeval];
	typeAPPL => ProcLoc[spt.applval];
	typeLET => ProcLoc[spt.letval];
	ENDCASE => NULL;
	RETURN[TRUE];
	};


CWF.WF0["Print Frames:\n"L];
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];
};

PrintInterfaceSeqs: PROC[spmodel: MDModel.MODELSymbol, 
	symbolseq: MDModel.SymbolSeq] = {

	ProcAnalyze: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL _ TRUE] = {
	WITH spt: sptop SELECT FROM
	typeAPPL => {
		i: CARDINAL;
		interfaceseq: LowLoader.InterfaceSeq;
		interfaceseq _ spt.interfaceseq;
		IF interfaceseq = NIL THEN RETURN;
		CWF.WF2["%s: %u entries:\n"L, spt.applsym, @interfaceseq.size];
		FOR i IN [0 .. interfaceseq.size) DO
			PrintCLink[i, interfaceseq[i].clink];
			ENDLOOP;
		};
	ENDCASE => NULL;
	RETURN[TRUE];
	};


CWF.WF0["Print Interface Records:\n"L];
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];
};


}.