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