-- CTLDriverImpl.Mesa, last edit May 8, 1983 6:36 pm
-- 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
--		code and code links are in same space
--	n spaces for the Bcd headers
--		(deleted on UnLoad)

DIRECTORY
  Atom: TYPE USING[MakeAtom, PutProp],
  AtomsPrivate: TYPE USING[UnsafeMakeAtom],
  BcdDefs: TYPE USING [Base, BCD, EPLimit, EXPIndex, EXPRecord, 
  	FTIndex, FTRecord, GFTIndex, IMPIndex, IMPRecord, 
	Link, MTIndex, MTRecord, NameRecord, NullLink, VersionStamp],
  BcdOps: TYPE USING [BcdBase, EXPHandle, FTHandle, IMPHandle, MTHandle, NameString,
   ProcessExports, ProcessImports, ProcessModules],
  CedarExporterImpl: TYPE USING[ProcessPendingEntries, SaveResolvedEntries],
  CedarLinkerOps: TYPE USING[FindVariableLink, GetIR, GetPendingList, IR,
  	PendingList, SetPendingList],
  CS: TYPE USING[EqualRope, MakeTS],
  CT: TYPE USING[FrameListRecord, Global, MI, ModuleList, OutsideImports,
  	OutsideImportsRecord],
  CTFakeBcd: TYPE USING[BuildFakeBcd],
  CTLoad: TYPE USING [AllocateInterfaceSeq, BuildFramePtrInterface,
   BuildInterface, CloseLinkSpace, ConvertLink, DummyMapSeq, 
	FreeLoadInfoSeq, ImpExpSeq, 
	InterfaceSeq, InvalidFile, LoadGlobalFrames, LoadIncremental, 
	LoadInfoSeq, NSToRope, OpenLinkSpace, ReadLink, ReplaceResult, WriteLink],
  Directory: TYPE USING[DeleteFile, Lookup, Error, ignore],
  File: TYPE USING [Capability, nullCapability],
  IO: TYPE USING[card, Handle, PutF, rope, string, UserAbort, UserAborted],
  List: TYPE USING[DReverse],
  Loader: TYPE USING[Error],
  LoaderPrivate: TYPE USING[FindMappedSpace, GetModuleLink],
  PilotLoaderOps: TYPE USING[DestroyMap, IthLink, LinkSegmentLength,
  	ReleaseFrames],
  PilotLoadStateFormat: TYPE USING[ConfigIndex],
  PilotLoadStateOps: TYPE USING [ConfigIndex, GetMap, InputLoadState, Map, NullConfig, 
  	ReleaseLoadState, ReleaseMap, RemoveConfig],
  PrincOps: TYPE USING [ControlLink, GFTIndex, GFTNull, GlobalFrameHandle, NullLink,
   UnboundLink],
  Process: TYPE USING [Detach],
  Rope: TYPE USING[Text],
  RTLoader: TYPE USING [AcquireTypesAndLiterals],
  Runtime: TYPE USING [ValidateGlobalFrame],
  RuntimeInternal: TYPE USING [Codebase],
  Space: TYPE USING [Create, Delete, GetHandle, Handle,
  	LongPointer, Map, nullHandle, PageFromLongPointer, virtualMemory],
  System: TYPE USING [GetClockPulses, PulsesToMicroseconds],
  Time: TYPE USING [Current],
  TimeStamp: TYPE USING [Stamp];
			
CTLDriverImpl: PROGRAM 
IMPORTS Atom, AtomsPrivate, BcdOps, CedarExporterImpl, CedarLinkerOps, 
	CTFakeBcd, CTLoad, CS, Directory,
	IO, List, Loader, LoaderPrivate, PilotLoaderOps, PilotLoadStateOps, Process, RTLoader,
	Runtime, RuntimeInternal, Space, System, Time
EXPORTS CT
SHARES CedarExporterImpl, CedarLinkerOps = {

-- no MDS usage!

LoadBcdsAndResolveImports: PUBLIC SAFE PROC[g: CT.Global, tryreplacement: BOOL] 
	RETURNS[errors: BOOL] = TRUSTED {
	
	ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
	p: LONG CARDINAL;
	time: LONG CARDINAL _ Time.Current[];
	errors _ FALSE;
	g.ttyout.PutF["Loading Phase.\n"];
	-- unload any bcds that may be around from the last invocation
	-- regardless of "replacement", old config in load state is unloaded
	IF g.configindex ~= PilotLoadStateOps.NullConfig THEN
		DeleteLoadStateEntry[g.configindex];
	IF NOT tryreplacement THEN {
		g.moduleExports _ NIL;
		g.outsideImports _ NIL;
		};
		
	g.frameInterfaces _ NIL;
	
	g.configindex _ PilotLoadStateOps.InputLoadState[];		-- locks the load state
	-- this will build all interface records
	LoadBcds[g  ! CTLoad.InvalidFile => GOTO out];
	PutExportsInLoadState[g];
	CTFakeBcd.BuildFakeBcd[g];		-- releases the load state
	IF g.ttyout.UserAbort[] THEN ERROR ABORTED;
	
	-- now fill in parameters 
	p _ System.PulsesToMicroseconds[System.GetClockPulses[]];
	g.dout.PutF["Phase 3: Fill in interface records... \n"];
	ComputeOutsideImports[g];
	-- will lock the load state
	FillInImportsFromLoadState[g, tryreplacement];
	ComingleImportsAndExports[g];
	-- IF Subr.debugflg THEN PrintInterfaceSeqs[spmodel, symbolseq];
	IF g.ttyout.UserAbort[] THEN ERROR ABORTED;
	p _ (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
	g.dout.PutF["done (%d millisec).\nPhase 4: Fill in imports (links) ... \n", IO.card[p]];
	IF g.ttyout.UserAbort[] THEN ERROR ABORTED;
	p _ System.PulsesToMicroseconds[System.GetClockPulses[]];
	-- now fill in all the frame links
	ResolveImports[g];
	-- now call Cedar related procedures to finish the loading
	ProcessCedarBcds[g, tryreplacement];
	time _ Time.Current[] - time;
	p _ (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
	g.dout.PutF["done (%d millisec).\n", IO.card[p]];
	g.ttyout.PutF["Total time to load: %d seconds.\n", IO.card[time]];
	g.ttyout.PutF["--------------------------------\n"];
	EXITS
	out => NULL;
	};
	
StartElemRecord: TYPE = RECORD [
	prog: PROGRAM,
	frame: PrincOps.GlobalFrameHandle
	];
	
StartAllControlBcds: PUBLIC SAFE PROC[g: CT.Global] = TRUSTED {
	starr: LIST OF REF StartElemRecord;
	p: PROCESS;
	mi: CT.MI;
	prog: PROGRAM;
	dontFork: BOOL _ TRUE;
	
	g.ttyout.PutF["Starting modules ... \n"];
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.loadInfoSeq = NIL OR NOT mi.controlModule THEN LOOP;
		FOR i: CARDINAL IN [0 .. mi.loadInfoSeq.size) DO
			Runtime.ValidateGlobalFrame[mi.loadInfoSeq[i].frame];
			IF mi.loadInfoSeq[i].frame.started THEN {
				g.ttyout.PutF["Error - %s has already been started.\n", 
					IO.rope[mi.bcdFileName]];
				RETURN;
				};
			ENDLOOP;
		g.dout.PutF["Will start %s\n", IO.rope[mi.bcdFileName]];
		prog _ LOOPHOLE[mi.loadInfoSeq.cm];
		starr _ CONS[NEW[StartElemRecord _ [prog: prog, frame: mi.loadInfoSeq[0].frame]],
				starr];
		ENDLOOP;
	starr _ LOOPHOLE[List.DReverse[LOOPHOLE[starr]]];
	IF dontFork THEN 
		StartProcedure[g, starr]
	ELSE
		{
		p _ FORK StartProcedure[g, starr];
		Process.Detach[p];
		};
	};
	
-- always frees the bcdbases stored in our structures
UnLoad: PUBLIC SAFE PROC[g: CT.Global, unloadthebcd: BOOL] = TRUSTED{
	nunl: CARDINAL _ 0;
	mi: CT.MI;
	
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.loadInfoSeq ~= NIL THEN {
			nunl _ nunl + 1;
			IF unloadthebcd THEN {
				IF nunl = 1 THEN g.ttyout.PutF["Unloading modules.\n"];
				-- remember that a binder bcd loaded by
				-- the modeller will have only ONE mapped
				-- space for all its code
				FOR i: CARDINAL IN [0 .. mi.loadInfoSeq.size) DO
					prog: PROGRAM _ LOOPHOLE[mi.loadInfoSeq[i].frame];
					space: Space.Handle;
					IF RuntimeInternal.Codebase[prog] ~= NIL THEN {
						space _ Space.GetHandle[
							Space.PageFromLongPointer[
								RuntimeInternal.Codebase[prog]]];
						IF space ~= Space.nullHandle 
						AND space ~= Space.virtualMemory THEN
							Space.Delete[LoaderPrivate.FindMappedSpace[space]];
						};
					ENDLOOP;
				-- frees the global frames
				PilotLoaderOps.ReleaseFrames[mi.loadInfoSeq.bcdbase, mi.loadInfoSeq.frameList,
					mi.loadInfoSeq.map];
				PilotLoaderOps.DestroyMap[mi.loadInfoSeq.map];
				};
			-- frees the bcdbase space
			mi.loadInfoSeq _ CTLoad.FreeLoadInfoSeq[mi.loadInfoSeq];
			};
		ENDLOOP;
	IF unloadthebcd THEN {
		IF g.configindex ~= PilotLoadStateOps.NullConfig THEN {
			DeleteLoadStateEntry[g.configindex];
			g.configindex _ PilotLoadStateOps.NullConfig;
			};
		IF g.fakebcdspace ~= Space.nullHandle THEN {
			Space.Delete[g.fakebcdspace];
			g.fakebcdspace _ Space.nullHandle;
			Directory.DeleteFile[LOOPHOLE[g.fakeBcdFileName]
				! Directory.Error => CONTINUE];
			g.fakeBcdFileName _ NIL;
			};
		IF nunl > 0 THEN {
			g.ttyout.PutF["%d Module%s unloaded.\n", IO.card[nunl], 
				IO.rope[IF nunl > 1 THEN "s" ELSE ""]];
			g.ttyout.PutF["All code spaces and frames have been freed.  DO NOT TRY TO USE THEM!\n"];
			g.ttyout.PutF["--------------------------------\n"];
			};
		};
	};
	
-- internal procedures
	
DeleteLoadStateEntry: PROC[index: PilotLoadStateOps.ConfigIndex] = {
	ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
	map: PilotLoadStateOps.Map;
	[] _ PilotLoadStateOps.InputLoadState[];
	map _ PilotLoadStateOps.GetMap[index];
	PilotLoadStateOps.RemoveConfig[map, index];
	PilotLoadStateOps.ReleaseMap[map];
	PilotLoadStateOps.ReleaseLoadState[];
	};
	
	
-- this procedure may be forked forked
StartProcedure: PROC[g: CT.Global, starr: LIST OF REF StartElemRecord] = {
	i: CARDINAL _ 0;
	{
	ENABLE ABORTED, IO.UserAborted => GOTO out;
	FOR l: LIST OF REF StartElemRecord _ starr, l.rest UNTIL l = NIL DO
		i _ i + 1;
		IF l.first.frame.started THEN 
			g.ttyout.PutF["Error - element %d of start list has already been started.\n",
				IO.card[i]]
		ELSE 
			START l.first.prog;
		ENDLOOP;
	EXITS
	out => NULL;
	};
	g.dout.PutF["All %d modules have been started.\n", IO.card[i]];
	g.ttyout.PutF["--------------------------------\n"];
	};

-- the load state is locked for the entire time
LoadBcds: PROC[g: CT.Global] = {
	ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
	p: LONG CARDINAL;
	configGfi: PrincOps.GFTIndex _ 1;
	mi: CT.MI;
	
	p _ System.PulsesToMicroseconds[System.GetClockPulses[]];
	g.dout.PutF["Phase 1: Load in bcd headers... \n"];
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		FillInCap[mi];
		IF NOT mi.definitions THEN {
			IF NOT mi.bcdValid THEN 
				g.ttyout.PutF["Error - can't load %s since its not on the disk.\n", 
					IO.rope[mi.bcdFileName]]
			ELSE {
				IF mi.loadInfoSeq = NIL THEN {
					[mi.loadInfoSeq, configGfi] _ 
						CTLoad.LoadGlobalFrames[mi.bcdCap, g.configindex, configGfi, g.ttyout
						! CTLoad.InvalidFile => -- not caught at this level
							g.ttyout.PutF["Error - invalid bcd %s\n", IO.rope[mi.bcdFileName]]
							];
					SetUpExports[g, mi];
					}
				ELSE IF mi.loadInfoSeq.mustreplace THEN {
					replaceResult: CTLoad.ReplaceResult;
					replaceResult _ CTLoad.LoadIncremental[mi.bcdCap, mi.loadInfoSeq, g.ttyout];
					SELECT replaceResult FROM
					ok => NULL;
					configNotReplaceable => 
						g.ttyout.PutF["Load of %s failed, is a config.\n", IO.rope[mi.bcdFileName]];
					frameTooBig => 
						g.ttyout.PutF["Load of %s failed, frame too big.\n", IO.rope[mi.bcdFileName]];
					ngfiTooBig => 
						g.ttyout.PutF["Load of %s failed, # gfis too big.\n", IO.rope[mi.bcdFileName]];
					checkForMRFailed => 
						g.ttyout.PutF["Load of %s failed, outstanding local frames(?).\n",
							IO.rope[mi.bcdFileName]];
					ENDCASE => ERROR;
					}
				ELSE g.dout.PutF["%s does not need to be reloaded.\n", 
					IO.rope[mi.bcdFileName]];
				};
			};
		ENDLOOP;
	p _ (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
	g.dout.PutF["done (%d millisec).\n", IO.card[p]];
	};
		
-- fill in exported interface records from the bcd
SetUpExports: PROC[g: CT.Global, mi: CT.MI] = {
	interfaceseq, existingseq: CTLoad.InterfaceSeq;
		
	ForEachExports: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex] 
			RETURNS[stop: BOOL] = {
		interfaceseq _ CTLoad.BuildInterface[mi.loadInfoSeq, eth];
		existingseq _ LookForExp[g, interfaceseq];
		IF existingseq ~= NIL THEN 
			PLUSExp[g, existingseq, interfaceseq, mi.bcdFileName]
		ELSE 
			AddExp[g, interfaceseq];
		RETURN[FALSE];
		};
		
	IF mi.loadInfoSeq.bcdbase.nModules = 1 THEN {
		-- build interface record for a compiler-produced module
		interfaceseq _ CTLoad.BuildFramePtrInterface[mi.loadInfoSeq.bcdbase, mi.loadInfoSeq[0].frame];
		AddExp[g, interfaceseq];
		};
	[] _ BcdOps.ProcessExports[mi.loadInfoSeq.bcdbase, ForEachExports];
	};
	
AddExp: PROC[g: CT.Global, interfaceseq: CTLoad.InterfaceSeq] = {
	g.moduleExports _ CONS[interfaceseq, g.moduleExports];
	};
	
LookForExp: PROC[g: CT.Global, interfaceseq: CTLoad.InterfaceSeq] RETURNS[CTLoad.InterfaceSeq]= {
	FOR l: LIST OF CTLoad.InterfaceSeq _ g.moduleExports, l.rest UNTIL l = NIL DO
		IF l.first.bcdVers = interfaceseq.bcdVers THEN RETURN[l.first];
		ENDLOOP;
	RETURN[NIL];
	};
	
-- existingseq _ existingseq PLUS interfaceseq
PLUSExp: PROC[g: CT.Global, existingseq, interfaceseq: CTLoad.InterfaceSeq, 
	exporterName: Rope.Text] = {
	existingseq.resolved _ TRUE;
	FOR i: CARDINAL IN [0 .. interfaceseq.size) DO
		IF NOT EmptyLink[existingseq[i].clink] 
			AND NOT EmptyLink[interfaceseq[i].clink] THEN 
				g.ttyout.PutF["Error -- more than one exporter of item #%d in interface %s (%s is an exporter).\n", 
						IO.card[i], IO.rope[existingseq.name], IO.rope[exporterName]]
		ELSE IF EmptyLink[existingseq[i].clink] THEN
			existingseq[i] _ interfaceseq[i];
		IF EmptyLink[existingseq[i].clink] THEN
			existingseq.resolved _ FALSE;
		ENDLOOP;
	};
	
EmptyLink: PROC[link: PrincOps.ControlLink] RETURNS[empty: BOOL] = {
	RETURN[link = PrincOps.UnboundLink OR link = PrincOps.NullLink];
	};
		
ComputeOutsideImports: PROC[g: CT.Global] = {
	bcdbase: BcdOps.BcdBase;
	mi: CT.MI;
		
		ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex] 
			RETURNS[stop: BOOL] = {
		fth: BcdOps.FTHandle;
		stop _ FALSE;
		fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][ith.file];
		FOR l: LIST OF CTLoad.InterfaceSeq _ g.moduleExports, l.rest UNTIL l = NIL DO
			IF l.first.bcdVers = fth.version AND l.first.resolved THEN RETURN;
			ENDLOOP;
		-- not exported by us, must be from outside
		UpdateOutsideImports[g, CTLoad.NSToRope[bcdbase, fth.name], fth.version];
		};
		
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.loadInfoSeq ~= NIL THEN {
			bcdbase _ mi.loadInfoSeq.bcdbase; 
			[] _ BcdOps.ProcessImports[mi.loadInfoSeq.bcdbase, ForEachImport];
			};
		ENDLOOP;
	};
	
UpdateOutsideImports: PROC[g: CT.Global, name: Rope.Text, intvers: TimeStamp.Stamp] = {
	FOR l: LIST OF CT.OutsideImports _ g.outsideImports, l.rest  UNTIL l = NIL DO
		IF l.first.bcdVers = intvers THEN RETURN;
		ENDLOOP;
	g.outsideImports _ CONS[NEW[CT.OutsideImportsRecord
			_ [name: name, bcdVers: intvers]], g.outsideImports];
	};
	
-- locks the load state
FillInImportsFromLoadState: PROC[g: CT.Global, replacement: BOOL] = {
	ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
	nbcds: CARDINAL;
	p: LONG CARDINAL;
	p _ System.PulsesToMicroseconds[System.GetClockPulses[]];
	g.dout.PutF["Filling in from Pilot load state... "];
	nbcds _ PilotLoadStateOps.InputLoadState[];
	FOR l: LIST OF CT.OutsideImports _ g.outsideImports, l.rest UNTIL l = NIL DO {
		ir: CedarLinkerOps.IR;
		interfaceseq: CTLoad.InterfaceSeq;
		IF replacement AND l.first.interfaceseq ~= NIL THEN LOOP;
		[interface: ir] _ CedarLinkerOps.GetIR[atom: Atom.MakeAtom[l.first.name],
				version: l.first.bcdVers
				! Loader.Error => {
					IF type = versionMismatch THEN {
						g.ttyout.PutF["Error - version mismatch on %s\n",
							IO.string[LOOPHOLE[message]]];
						PilotLoadStateOps.ReleaseLoadState[];
						GOTO inputForNextIR;
						};
					PilotLoadStateOps.ReleaseLoadState[];	-- reject it
					}];
		IF ir = NIL THEN {
			-- this is one of
			--		1) an imported module from the loadstate
			--		2) an imported interface that is all-INLINES
			--		3) or an imported interface that no one exports (error)
			LOOP;
			}
		ELSE {
			interfaceseq _ CTLoad.AllocateInterfaceSeq[l.first.name, ir.size];
			interfaceseq.bcdVers _ l.first.bcdVers;
			FOR i: CARDINAL IN [0 .. ir.size) DO
				interfaceseq[i] _ [clink: ir[i], blink: BcdDefs.NullLink];
				ENDLOOP;
			interfaceseq.size _ ir.size;
			};
		IF l.first.interfaceseq ~= NIL THEN	-- have to plus together
			PLUSExp[g,  l.first.interfaceseq, interfaceseq, "Unknown module"]
		ELSE
			l.first.interfaceseq _ interfaceseq;
		EXITS -- only called when there is an unbound import
		inputForNextIR => nbcds _ PilotLoadStateOps.InputLoadState[];
		} ENDLOOP;
	PilotLoadStateOps.ReleaseLoadState[];
	p _ (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
	g.dout.PutF["done (%d millisec).\n", IO.card[p]];
	};

LookupFrame: PROC[g: CT.Global, bcdbase: BcdOps.BcdBase, intno: CARDINAL] 
	RETURNS[CTLoad.InterfaceSeq] = {
	i: INT _ -1;
	name: Rope.Text;
	version: TimeStamp.Stamp;
	
		ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex] 
			RETURNS[stop: BOOL] = {
		fth: BcdOps.FTHandle;
		stop _ FALSE;
		i _ i + 1;
		IF i < intno THEN RETURN[FALSE];
		fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][ith.file];
		name _ CTLoad.NSToRope[bcdbase, ith.name];
		version _ fth.version;
		RETURN[TRUE];
		};
		
	{
	interfaceseq: CTLoad.InterfaceSeq;
	clink: PrincOps.ControlLink;
	atom: ATOM;
	old: REF BcdDefs.VersionStamp;
	[] _ BcdOps.ProcessImports[bcdbase, ForEachImport];
	IF name = NIL THEN ERROR;
	FOR l: LIST OF REF CT.FrameListRecord _ g.frameInterfaces, l.rest UNTIL l = NIL DO
		IF l.first.version = version
		AND CS.EqualRope[l.first.name, name]
		THEN RETURN[l.first.interfaceseq];
		ENDLOOP;
	atom _ Atom.MakeAtom[name];
	old _ NEW[BcdDefs.VersionStamp _ version];
	Atom.PutProp[atom, $version, old];
	-- try for imported module, this is very expensive
	clink _ LoaderPrivate.GetModuleLink[atom: atom];
	IF NOT EmptyLink[clink] THEN {
		-- found
		interfaceseq _ CTLoad.AllocateInterfaceSeq[name, 1];
		interfaceseq[0] _ [clink: clink, blink: BcdDefs.NullLink];
		interfaceseq.bcdVers _ version;
		interfaceseq.size _ 1;
		}
	ELSE interfaceseq _ NIL;
	-- caches result so GetModuleLink is only called once per name
	g.frameInterfaces _ CONS[NEW[CT.FrameListRecord _
		[name: name, version: version, interfaceseq: interfaceseq]], g.frameInterfaces];
	RETURN[interfaceseq];
	}};

-- fill in links
ResolveImports: PROC[g: CT.Global] = {
	mi: CT.MI;
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.loadInfoSeq ~= NIL THEN FillInImports[g, mi];
		ENDLOOP;
	};
	
-- called for loaded bcd to fill in all its links!
FillInImports: PROC[g: CT.Global, mi: CT.MI] = {
	bcdbase: BcdOps.BcdBase;
	dummymapseq: CTLoad.DummyMapSeq;
	impexpseq: CTLoad.ImpExpSeq;
	mod, imp: CARDINAL _ 0;
	namestring: BcdOps.NameString;
	
		ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex] 
			RETURNS[stop: BOOL] = {
		fth: BcdOps.FTHandle;
		stop _ FALSE;
		FOR i: CARDINAL IN [0 .. ith.ngfi) DO
			dummymapseq[ith.gfi + i] _ [ind: imp, whichone: i];
			ENDLOOP;
		-- handle funny cases where two instances are imported
		-- of the same interface
		IF ith.gfi = dummymapseq.size THEN
			dummymapseq.size _ dummymapseq.size + ith.ngfi;
		fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][ith.file];
		impexpseq[imp] _ LookUpInterface[g, fth.version];
		-- impexpseq[imp] may be NIL
		IF FALSE AND impexpseq[imp] = NIL THEN {
			-- generates spurious warnings about Inline, etc.
			sym: Rope.Text _ CTLoad.NSToRope[bcdbase, ith.name];
			g.ttyout.PutF["Warning- cannot find exporter of %s anywhere.\n",
				IO.rope[sym]];
			};
		imp _ imp + 1;
		};
		
		ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] 
			RETURNS[stop: BOOL] = {
		resolved, bound: BOOL;
		clink: PrincOps.ControlLink;
		stop _ FALSE;
		resolved _ TRUE;
		[] _ CTLoad.OpenLinkSpace[mi.loadInfoSeq[mod].frame, mth, bcdbase];
		FOR i: CARDINAL IN [0 .. PilotLoaderOps.LinkSegmentLength[mth, bcdbase]) DO
			clink _ CTLoad.ReadLink[i];
			[clink, bound] _ NewLink[g: g, blink: PilotLoaderOps.IthLink[mth, i, bcdbase], 
				oldclink: clink, mi: mi, frame: mi.loadInfoSeq[mod].frame, 
				mth: mth, bcdbase: bcdbase, linkinx: i];
			IF bound THEN 
				CTLoad.WriteLink[offset: i, link: clink]
			ELSE resolved _ FALSE;
			ENDLOOP;
		CTLoad.CloseLinkSpace[mi.loadInfoSeq[mod].frame];
		IF NOT resolved THEN mi.loadInfoSeq.linksresolved _ FALSE;
		mod _ mod + 1;
		};
		
	bcdbase _ mi.loadInfoSeq.bcdbase;
	namestring _ LOOPHOLE[bcdbase + bcdbase.ssOffset];
	IF bcdbase.nImports = 0 THEN RETURN;	-- no imports
	dummymapseq _ mi.loadInfoSeq.dummymapseq;
	impexpseq _ mi.loadInfoSeq.impexpseq;
	-- the first part of dummymapseq, the map between config gfi's and real gfi's,
	--	has already been computed
	-- set up map between dummygfi's and the import table
	-- IF dummymapseq.size > bcdbase.firstdummy THEN ERROR;
	dummymapseq.size _ bcdbase.firstdummy;	-- adjust for dummies to come
	[] _ BcdOps.ProcessImports[bcdbase, ForEachImport];
	impexpseq.size _ imp;
	IF NOT mi.loadInfoSeq.linksresolved THEN {
		mi.loadInfoSeq.linksresolved _ TRUE;
		-- now run thru the frame links looking for imports to fill in
		[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
		};
	};
	
NewLink: PROC[g: CT.Global, blink: BcdDefs.Link, oldclink: PrincOps.ControlLink, mi: CT.MI,
	frame: PrincOps.GlobalFrameHandle, mth: BcdOps.MTHandle, bcdbase: BcdOps.BcdBase,
	linkinx: CARDINAL]
	RETURNS[newclink: PrincOps.ControlLink, resolved: BOOL] = {
	loadinfoseq: CTLoad.LoadInfoSeq;
	
		FindLink: PROC[blink: BcdDefs.Link] RETURNS[PrincOps.ControlLink, BOOL] = {
		IF blink.gfi < loadinfoseq.bcdbase.firstdummy THEN {
			SELECT blink.vtag FROM
			proc0, proc1 => {
				rgfi: PrincOps.GFTIndex;
				rgfi _ loadinfoseq.dummymapseq[blink.gfi].ind;
				newclink _ CTLoad.ConvertLink[blink];
				newclink.gfi _ rgfi + 
					loadinfoseq.dummymapseq[blink.gfi].whichone;
				resolved _ rgfi ~= PrincOps.GFTNull;
				};
			var => {
				[link: newclink] _ CedarLinkerOps.FindVariableLink[bcd: loadinfoseq.bcdbase, 
						mthLink: blink, rgfi: loadinfoseq.dummymapseq[blink.vgfi].ind];
				resolved _ NOT EmptyLink[newclink];
				};
			ENDCASE => NULL;
			}
		ELSE {
			trueep: CARDINAL;
			intno: CARDINAL;
			interfaceseq: CTLoad.InterfaceSeq;
			intno _ loadinfoseq.dummymapseq[blink.gfi].ind;
			interfaceseq _ loadinfoseq.impexpseq[intno];
			trueep _ blink.ep + (loadinfoseq.dummymapseq[blink.gfi].whichone 
				* BcdDefs.EPLimit);
			IF interfaceseq = NIL THEN  -- try the module frame table
				interfaceseq _ LookupFrame[g, loadinfoseq.bcdbase, intno];
			-- import not satisfied?
			IF interfaceseq = NIL OR EmptyLink[interfaceseq[trueep].clink] THEN {
				ith: BcdOps.IMPHandle;
				fth: BcdOps.FTHandle;
				sym: Rope.Text;
				ith _ GetImpHandle[loadinfoseq.bcdbase, intno];
				fth _ @LOOPHOLE[loadinfoseq.bcdbase + loadinfoseq.bcdbase.ftOffset, BcdDefs.Base][ith.file];
				sym _ CTLoad.NSToRope[loadinfoseq.bcdbase, ith.name];
				g.ttyout.PutF["Warning - Unable to resolve import of item #%d from interface %s\n\tof %a ",
					IO.card[trueep], IO.rope[sym], CS.MakeTS[fth.version]];
				g.ttyout.PutF["(the %dth import of  %s).\n",
					IO.card[intno], IO.rope[mi.bcdFileName]];
				UpdatePendingList[sym, frame, mth, bcdbase, linkinx, trueep];
				RETURN[oldclink, FALSE];
				};
			-- at this point module and variable links are
			-- set to their absolute addresses
			newclink _ interfaceseq[trueep].clink;
			resolved _ TRUE;
			};
		RETURN[newclink, resolved];
		};
		
	loadinfoseq _ mi.loadInfoSeq;
	newclink _ oldclink;
	resolved _ FALSE;
	SELECT blink.vtag FROM
	proc0, proc1 => IF EmptyLink[oldclink] THEN
		[newclink, resolved] _ FindLink[blink];
	var => IF EmptyLink[oldclink] THEN
		[newclink, resolved] _ FindLink[blink];
	ENDCASE => newclink _ LOOPHOLE[blink.typeID];
	};
		
UpdatePendingList: PROC[name: Rope.Text, frame: PrincOps.GlobalFrameHandle,
	mth: BcdOps.MTHandle, bcdbase: BcdOps.BcdBase, linkinx, trueep: CARDINAL] = {
	atom: ATOM _ AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[name]];
	pending: CedarLinkerOps.PendingList _ CedarLinkerOps.GetPendingList[atom];
	-- pendingCount _ pendingCount + 1;
	pending _ CONS[[frame, mth, bcdbase, linkinx, LOOPHOLE[trueep]], pending];
	CedarLinkerOps.SetPendingList[atom, pending];
	};
		
	-- intno starts at 0
GetImpHandle: PROC[bcdbase: BcdOps.BcdBase, intno: CARDINAL] 
		RETURNS[ith: BcdOps.IMPHandle] = {
	RETURN[@LOOPHOLE[bcdbase + bcdbase.impOffset, BcdDefs.Base] 
		[LOOPHOLE[intno*SIZE[BcdDefs.IMPRecord], BcdDefs.IMPIndex]]];
	};
	
-- call Paul Rovner's procedure to fixup the Cedar Atoms and Strings section
ProcessCedarBcds: PROC[g: CT.Global, replacement: BOOL] = {
	loadinfoseq: CTLoad.LoadInfoSeq;
	bcdbase: BcdOps.BcdBase;
	mi: CT.MI;
	FOR l: CT.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
		mi _ l.first;
		IF mi.loadInfoSeq = NIL THEN LOOP;
		loadinfoseq _ mi.loadInfoSeq;
		bcdbase _ loadinfoseq.bcdbase;
		IF NOT bcdbase.extended THEN LOOP;
		IF replacement AND NOT loadinfoseq.mustreplace THEN LOOP;
		loadinfoseq.mustreplace _ FALSE;
		RTLoader.AcquireTypesAndLiterals[bcd: bcdbase, map: loadinfoseq.map];
		ENDLOOP;
	};
	
LookUpInterface: PROC[g: CT.Global, bcdVers: TimeStamp.Stamp] 
	RETURNS[int: CTLoad.InterfaceSeq] = {
	FOR l: LIST OF CTLoad.InterfaceSeq _ g.moduleExports, l.rest UNTIL l = NIL DO
		IF l.first.bcdVers = bcdVers THEN RETURN[l.first];
		ENDLOOP;
	FOR l: LIST OF CT.OutsideImports _ g.outsideImports, l.rest UNTIL l = NIL DO
		IF l.first.bcdVers = bcdVers THEN RETURN[l.first.interfaceseq];
		ENDLOOP;
	RETURN[NIL];	-- not found
	};
	
FillInCap: PROC[mi: CT.MI] = {
	IF mi.bcdCap ~= File.nullCapability THEN RETURN;
	mi.bcdCap _ Directory.Lookup[fileName: LOOPHOLE[mi.bcdFileName],
		permissions: Directory.ignore
		! Directory.Error => {
			mi.bcdValid _ FALSE;
			GOTO out;
			};
		];
	mi.bcdValid _ TRUE;
	IF mi.srcFileName = NIL THEN {	-- object file only, chk if defs
		bcdSpace: Space.Handle;
		bcd: BcdOps.BcdBase;
		bcdSpace _ Space.Create[size: 1, parent: Space.virtualMemory];
    	Space.Map[space: bcdSpace, window: [file: mi.bcdCap, base: 1]];
    	bcd _ Space.LongPointer[bcdSpace];
	    mi.definitions _ bcd.definitions;
	    mi.bcdVers _ bcd.version;
	    Space.Delete[bcdSpace];
		};
   EXITS 
	out => NULL;
	};
	
PutExportsInLoadState: PROC[g: CT.Global] = {
	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 {
					AddInterfaceToLoadState[g, l.first];
					-- g.ttyout.PutF["%s exported into load state.\n", IO.rope[l.first.name]];
					EXIT;
					};
				REPEAT
				FINISHED => {
					g.ttyout.PutF["Error - cannot find %s exported by this program.\n",
						IO.rope[mi.bcdFileName]];
					};
				ENDLOOP;
			};
		ENDLOOP;
	-- process any pendings we have found
	IF g.toBeProcessed ~= NIL THEN 
		CedarExporterImpl.ProcessPendingEntries[g.toBeProcessed];
	};

AddInterfaceToLoadState: PROC[g: CT.Global, interfaceseq: CTLoad.InterfaceSeq] = {
	atom: ATOM _ AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[interfaceseq.name]];
	pending: CedarLinkerOps.PendingList;
	interface: CedarLinkerOps.IR;
	interface _ CedarLinkerOps.GetIR[atom, interfaceseq.bcdVers, interfaceseq.size].interface;
	FOR i: CARDINAL IN [0 .. interfaceseq.size) DO
		IF NOT EmptyLink[interfaceseq[i].clink] THEN
			interface[i] _ interfaceseq[i].clink;
		ENDLOOP;
	-- fill in any importers
	pending _ CedarLinkerOps.GetPendingList[atom];
	IF pending ~= NIL THEN {
		[g.toBeProcessed, pending] _ CedarExporterImpl.SaveResolvedEntries[g.toBeProcessed,
			pending, interface];
		CedarLinkerOps.SetPendingList[atom, pending];
		};
	};
	
ComingleImportsAndExports: PROC[g: CT.Global] = {
	firstpref, secondpref: CTLoad.InterfaceSeq;
	FOR l: LIST OF CTLoad.InterfaceSeq _ g.moduleExports, l.rest UNTIL l = NIL DO
		IF NOT l.first.resolved THEN {
			FOR r: LIST OF CT.OutsideImports _ g.outsideImports, r.rest UNTIL r = NIL DO
				IF l.first.bcdVers = r.first.bcdVers AND r.first.interfaceseq ~= NIL THEN {
					-- imported from outside and exported
					-- inside.
					--  add things from outside if needed
					firstpref _ l.first;
					secondpref _ r.first.interfaceseq;
					firstpref.resolved _ TRUE;
					FOR i: CARDINAL IN [0 .. firstpref.size) DO
						IF EmptyLink[firstpref[i].clink] THEN
							firstpref[i] _ secondpref[i];
						IF EmptyLink[firstpref[i].clink] THEN
							firstpref.resolved _ FALSE;
						ENDLOOP;
					EXIT;
					};
				ENDLOOP;
			};
		ENDLOOP;
	};
	
}.

Ź*˜Jšœˆ
Ļkœ­U˜½Ż
—…—nĄnš