-- SMLDriverImpl.mesa
-- last edit by Schmidt, May 27, 1983 6:31 pm
-- last edit by Satterthwaite, August 15, 1983 11:51 am
-- procedures to load and start modules in a Model
    
-- links:
--    IF gfi > firstdummy, then gfi is index into Import table 
--        and ep is index into the export record paired 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],
  BcdDefs: TYPE USING [
    Base, BCD, EPLimit, EXPIndex, EXPRecord, FTIndex, FTRecord, GFTIndex,
    IMPIndex, IMPRecord, Link, MTIndex, MTRecord, NameRecord, VersionStamp],
  BcdOps: TYPE USING [
    BcdBase, EXPHandle, FTHandle, IMPHandle, MTHandle,
    ProcessExports, ProcessImports, ProcessModules],
--CedarExporterImpl: TYPE USING [ProcessPendingEntries, SaveResolvedEntries],
  CedarLinkerOps: TYPE USING [
    FindVariableLink, GetIR, GetPendingList, IR, PendingList, SetPendingList],
  CS: TYPE USING [RopeFromStamp],
  Directory: TYPE USING [DeleteFile, Error],
  File: TYPE USING [Capability],
  IO: TYPE USING [atom, card, PutF, rope, STREAM, string, 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, NullConfig],
  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],
  SMFakeBcd: TYPE USING [BuildFakeBcd],
  SMFI: TYPE USING [BcdFileInfo],
  SMLDriver: TYPE USING [],
  SMLoad: TYPE USING [
    AllocateIR, BuildFramePtrInterface, BuildInterface, CloseLinkSpace,
    ConvertLink, FreeLoadInfo, GfiMap, InvalidFile, IR, IRSeq, IRSeqRecord,
    LoadGlobalFrames, LoadIncremental, LoadInfo, NSToRope,
    OpenLinkSpace, ReadLink, ReplaceResult, WriteLink],
  SMProj: TYPE USING [Proj, Available, Fill, Find],
  SMTree: TYPE Tree USING [
    ApplOp, BindOp, Handle, Id, Link, Name, NodeName, null, nullName],
  SMTreeOps: TYPE USING [
    TM, GetExt, GetName, NSons, NthSon, OpName, PutExt, Scan, ScanSons],
  SMVal: TYPE USING [
    Binding, BtoD, BtoG, IdName, IdType, LoadMod, LoadModRecord,
    GetExtFromParse, OuterBody, PutExtInParse, Select, ValOf, ValOfNthSon, VisitNodes],
  Space: TYPE USING [
    Delete, GetHandle, Handle, nullHandle, PageFromLongPointer, virtualMemory],
  Time: TYPE USING [Current],
  TimeStamp: TYPE USING [Null, Stamp];
            
SMLDriverImpl: PROGRAM 
    IMPORTS
      Atom, BcdOps, --CedarExporterImpl,-- CedarLinkerOps, CS, Directory,
      IO, List, Loader, LoaderPrivate, PilotLoaderOps, PilotLoadStateOps, Process,
      RTLoader, Runtime, RuntimeInternal, SMFakeBcd, SMLoad, SMProj, SMTreeOps,
      SMVal, Space, Time
    EXPORTS SMLDriver
    SHARES --CedarExporterImpl,-- CedarLinkerOps ~ {
  OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

 -- no MDS usage!

  LS: TYPE~REF LoaderState;
  LoaderState: PUBLIC TYPE~RECORD[    -- state information for the modeller's loader
    z: ZONE_,
    tm: TreeOps.TM_,
    out: IO.STREAM_,                    -- for messages
    fakeBcdSpace: Space.Handle_Space.nullHandle,    -- the bcd space for a fake config
    fakeBcdFileName: Rope.Text_NIL,            -- name of backing file
    configIndex: PilotLoadStateFormat.ConfigIndex_PilotLoadStateFormat.NullConfig,
    frameInterfaces: LIST OF REF FrameListRecord_NIL,
    importedInterfaces: SMLoad.IRSeq_NIL,
    started: BOOL_FALSE];

  FrameListRecord: TYPE~RECORD[
    name: ATOM_NIL,
    stamp: TimeStamp.Stamp_TimeStamp.Null,
    ir: SMLoad.IR_NIL];


  Create: PUBLIC SAFE PROC[z: ZONE, tm: TreeOps.TM, out: IO.STREAM]
      RETURNS[LS] ~ CHECKED {
    RETURN [z.NEW[LoaderState _ [z~z, tm~tm, out~out]]]};
    

  Loaded: PUBLIC SAFE PROC[ls: LS] RETURNS[BOOL] ~ CHECKED {
    RETURN[ls ~= NIL AND ls.configIndex ~= PilotLoadStateFormat.NullConfig]};
    
    
  LoadAndBind: PUBLIC SAFE PROC[ls: LS, root: Tree.Link, replace: BOOL] 
      RETURNS[errors: BOOL _ FALSE] ~ TRUSTED {
    ENABLE UNWIND => {PilotLoadStateOps.ReleaseLoadState[]};
    time: LONG CARDINAL _ Time.Current[];
    nBcds: NAT;
    formals, body: Tree.Link;
    [formals, body] _ SMVal.OuterBody[root];
    -- unload any bcds that may be around from the last invocation
    -- regardless of "replacement", old config in load state is unloaded
    IF Loaded[ls] THEN DeleteLoadStateEntry[ls, replace];
    ls.configIndex _ PilotLoadStateOps.InputLoadState[];    -- locks the load state
    --*** load state locked ***
      -- this will acquire all the (explicit) imports from the load state
      IF ~replace THEN InputActuals[ls, formals];
      -- this will build all interface records
      nBcds _ LoadBcds[ls, body ! SMLoad.InvalidFile => {GOTO fail}];
      [ls.fakeBcdFileName, ls.fakeBcdSpace] _    -- releases the load state
    SMFakeBcd.BuildFakeBcd[ls.configIndex, body, ls.fakeBcdFileName, ls.fakeBcdSpace, ls.out];
    --*** load state released ***
    ProcessPlusAndThen[ls, body];
    -- PutExportsInLoadState[g];
    -- now fill in all the frame links
      ResolveImports[ls, body];    -- may lock the load state while finding hidden imports
    -- now call Cedar related procedures to finish the loading
    ProcessCedarBcds[ls, body];
    time _ Time.Current[] - time;
    IF nBcds = 0 THEN ls.out.PutF["Nothing was loaded.\n\n"]
    ELSE {
      ls.out.PutF["%d modules loaded\n", IO.card[nBcds]];
      ls.out.PutF["Total time to load: %d seconds.\n\n", IO.card[time]]};
    EXITS
      fail => NULL;
    };
    
-- always frees the bcdbases stored in our structures
  Unload: PUBLIC SAFE PROC[
    ls: LS, root: Tree.Link, unloadTheBcd: BOOL] ~ TRUSTED {
    nunl: NAT _ 0;
    
    -- traverses the value tree
    ForEachApply: SAFE PROC[node, parent: Tree.Link] ~ TRUSTED {
      IF TreeOps.OpName[node] IN Tree.ApplOp THEN
    WITH SMVal.GetExtFromParse[node] SELECT FROM
      loadMod: SMVal.LoadMod =>
        IF loadMod.loadInfo ~= NIL THEN {
          nunl _ nunl + 1;
          IF unloadTheBcd THEN {
        IF nunl = 1 THEN ls.out.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: NAT IN [0 .. loadMod.loadInfo.size) DO
          prog: PROGRAM _ LOOPHOLE[loadMod.loadInfo[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[
          loadMod.loadInfo.bcdBase, loadMod.loadInfo.frameList,
          loadMod.loadInfo.map];
        PilotLoaderOps.DestroyMap[loadMod.loadInfo.map]};
        -- frees the bcdBase space
        loadMod.loadInfo _ SMLoad.FreeLoadInfo[loadMod.loadInfo]};
      ENDCASE => NULL;
      };

    SMVal.VisitNodes[ls.tm, SMVal.OuterBody[root].body, ForEachApply];
    IF unloadTheBcd THEN {
      DeleteLoadStateEntry[ls, FALSE];
      IF nunl > 0 THEN {
    ls.out.PutF["%d modules unloaded.\n", IO.card[nunl]];
    ls.out.PutF["All code spaces and frames have been freed.\nDO NOT TRY TO USE THEM.\n\n"];
    };
      }
    ELSE {    -- detach the fake config from the modeller
      ls.configIndex _ PilotLoadStateOps.NullConfig;
      ls.fakeBcdSpace _ Space.nullHandle;  ls.fakeBcdFileName _ NIL};
    ls.started _ FALSE; ls.importedInterfaces _ NIL};
    
-- internal procedures
    
  DeleteLoadStateEntry: PROC[ls: LS, replace: BOOL] ~ {
    index: PilotLoadStateOps.ConfigIndex _ ls.configIndex;
    IF index ~= PilotLoadStateOps.NullConfig THEN {
      ENABLE UNWIND => {PilotLoadStateOps.ReleaseLoadState[]};
      map: PilotLoadStateOps.Map;
      ls.configIndex _ PilotLoadStateOps.NullConfig;
      [] _ PilotLoadStateOps.InputLoadState[];
      map _ PilotLoadStateOps.GetMap[index];
      PilotLoadStateOps.RemoveConfig[map, index];
      PilotLoadStateOps.ReleaseMap[map];
      PilotLoadStateOps.ReleaseLoadState[]};
    IF ~replace AND ls.fakeBcdSpace ~= Space.nullHandle THEN {
      Space.Delete[ls.fakeBcdSpace];
      ls.fakeBcdSpace _ Space.nullHandle;
      Directory.DeleteFile[LOOPHOLE[ls.fakeBcdFileName] ! Directory.Error => {CONTINUE}];
      ls.fakeBcdFileName _ NIL};
    };

    
 -- the load state is locked for the entire time
  LoadBcds: PROC[ls: LS, root: Tree.Link] RETURNS [nBcds: NAT _ 0] ~ {
    ENABLE UNWIND => {PilotLoadStateOps.ReleaseLoadState[]};
    configGfi: PrincOps.GFTIndex _ 1;
    
    ForEachApply: SAFE PROC[node, parent: Tree.Link] ~ TRUSTED {
      IF TreeOps.OpName[node] IN Tree.ApplOp THEN {
    -- this is interesting if either an Apply of a source file whose bcd is valid
    -- or an fiBcd for a .Bcd mentioned directly in the model
    bcd: SMProj.Proj _ NIL;
    WITH SMVal.ValOfNthSon[node, 1] SELECT FROM
      subNode: Tree.Handle =>
        IF TreeOps.OpName[subNode] IN Tree.ApplOp THEN
          bcd _ NARROW[TreeOps.GetExt[subNode]];
      fiBcd: SMFI.BcdFileInfo => { -- temporary (inefficient)
        bcd _ SMProj.Find[fiBcd.stamp];
        IF ~bcd.Available THEN bcd.Fill[fiBcd.localName, FALSE]}
      ENDCASE;
    IF bcd # NIL AND ~bcd.interface THEN {
      loadMod: SMVal.LoadMod _ NARROW[SMVal.GetExtFromParse[node]];
      IF loadMod = NIL THEN loadMod _ (ls.z).NEW[SMVal.LoadModRecord _ []];
      loadMod.proj _ bcd;
      IF ~bcd.Available THEN 
        ls.out.PutF["Error - can't load %s (not on the disk)\n", IO.rope[bcd.localName]]
      ELSE IF loadMod.loadInfo = NIL THEN {
        nBcds _ nBcds + 1;
        [loadMod.loadInfo, configGfi] _ 
        SMLoad.LoadGlobalFrames[bcd.capability, ls.configIndex, configGfi, ls.out
            ! SMLoad.InvalidFile => {
            ls.out.PutF["Error - invalid bcd %s\n", IO.rope[bcd.localName]];
            REJECT}    -- not caught at this level
            ];
        SetUpExports[ls, loadMod]}
      ELSE IF loadMod.mustReplace THEN {
        replaceResult: SMLoad.ReplaceResult ~
        SMLoad.LoadIncremental[bcd.capability, loadMod.loadInfo, ls.out];
        IF replaceResult = $ok THEN {
          loadMod.mustReplace _ FALSE; nBcds _ nBcds + 1;
          SetUpExports[ls, loadMod]}    -- gets any newly exported procs
        ELSE ls.out.PutF[
        SELECT replaceResult FROM
          $configNotReplaceable => "Load of %s failed, is a config.\n",
          $frameTooBig => "Load of %s failed, frame too big.\n",
          $ngfiTooBig => "Load of %s failed, # gfis too big.\n",
          $checkForMRFailed => "Load of %s failed, outstanding local frames(?).\n",
          ENDCASE => ERROR,
        IO.rope[bcd.localName]];
        };
      SMVal.PutExtInParse[node, loadMod]};
     };
      };

    SMVal.VisitNodes[ls.tm, root, ForEachApply]};
        
 -- fill in exported interface records from the bcd

  SetUpExports: PROC[ls: LS, loadMod: SMVal.LoadMod] ~ {
    loadInfo: SMLoad.LoadInfo ~ loadMod.loadInfo;
    n: NAT _ 1;
        
    ForEachExport: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex] 
    RETURNS[stop: BOOL_FALSE] ~ {
      ir: SMLoad.IR ~ SMLoad.BuildInterface[loadInfo, eth];
      loadInfo.exports[n] _ ir;
      n _ n+1};
        
    loadInfo.exports _ (ls.z).NEW[SMLoad.IRSeqRecord[loadInfo.bcdBase.nExports+1]];
    IF loadInfo.bcdBase.nModules = 1 THEN
      -- build interface record for a compiler-produced module
      loadInfo.exports[0] _ SMLoad.BuildFramePtrInterface[loadInfo.bcdBase, loadInfo[0].frame];
    [] _ BcdOps.ProcessExports[loadInfo.bcdBase, ForEachExport]};
    
 -- load state should not be locked

  ProcessPlusAndThen: PROC[ls: LS, root: Tree.Link] ~ {
    
    BinaryOp: PROC[left, right: SMLoad.IR, mode: Tree.NodeName] 
    RETURNS[result: SMLoad.IR] ~ {
      IF left = NIL THEN RETURN[right];
      IF right = NIL THEN RETURN[left];
      IF left.size ~= right.size OR left.stamp ~= right.stamp THEN {
    -- a TYPE CHECK
    ls.out.PutF["Interface mismatch between %s and %s.\n",
      IO.atom[left.name], IO.atom[right.name]];
    RETURN[left]};
      result _ SMLoad.AllocateIR[left.name, left.size];
      result.stamp _ left.stamp;
      result.resolved _ TRUE;
      FOR i: NAT IN [0 .. left.size) DO
    SELECT mode FROM
      $then =>
        result[i] _ IF EmptyLink[left[i].link] THEN right[i] ELSE left[i];
      $union => {    -- +
        IF ~EmptyLink[left[i].link] AND ~EmptyLink[right[i].link] THEN 
          ls.out.PutF["Multiple exports of item %d in interface %s.\n",
                    IO.card[i], IO.atom[left.name]];
        result[i] _ IF EmptyLink[left[i].link] THEN right[i] ELSE left[i]};
      ENDCASE => ERROR;    -- other operators not yet implemented
    IF EmptyLink[result[i].link] THEN result.resolved _ FALSE;
    ENDLOOP;
      };
    
    ForEachNode: SAFE PROC[node, parent: Tree.Link] ~ TRUSTED {
      SELECT TreeOps.OpName[node] FROM
    $union, $then => {
      left: SMLoad.IR ~ PossibleCoercion[SMVal.ValOfNthSon[node, 1]];
      right: SMLoad.IR ~ PossibleCoercion[SMVal.ValOfNthSon[node, 2]];
      TreeOps.PutExt[node, BinaryOp[left, right, TreeOps.OpName[node]]]};
    $subscript => {
      gb: Tree.Link ~ TreeOps.NthSon[node, 1];
      left: Tree.Link ~ SMVal.ValOf[gb];
      selector: Tree.Name ~ TreeOps.GetName[TreeOps.NthSon[node, 2]];
      SELECT TreeOps.OpName[left] FROM
        IN Tree.ApplOp => {
          typeName: Tree.Name ~ IndexToType[gb, selector];
          desiredName: Tree.Name ~
            (IF typeName # Tree.nullName THEN typeName ELSE selector);
          loadMod: SMVal.LoadMod ~ NARROW[SMVal.GetExtFromParse[left]];
          exports: SMLoad.IRSeq ~ loadMod.loadInfo.exports;
          FOR i: NAT IN [0 .. exports.size) DO
        IF exports[i].name = desiredName THEN {
          TreeOps.PutExt[node, exports[i]];
          EXIT};
        REPEAT
          FINISHED => 
            IF typeName # $CONTROL THEN
              ls.out.PutF["Error - %s is not exported by %s.\n",
            IO.atom[selector], IO.rope[loadMod.proj.localName]];
        ENDLOOP;
          };
        IN Tree.BindOp => {
          v: Tree.Link ~ SMVal.Select[left, selector];
          IF v # Tree.null THEN TreeOps.PutExt[node, PossibleCoercion[v]]
          ELSE ls.out.PutF["Error - %s is not a valid selector.\n", IO.atom[selector]]};
        ENDCASE;
      };
    ENDCASE => NULL;
      };

    SMVal.VisitNodes[ls.tm, root, ForEachNode]};
    
  IndexToType: PROC[gb: Tree.Link, index: Tree.Name]
      RETURNS[typeName: Tree.Name _ Tree.nullName] ~ {
    WITH gb SELECT FROM
      id: Tree.Id => {
        d: Tree.Link ~ SMVal.IdType[id];

    FindIndexType: TreeOps.Scan ~ CHECKED {
      elemName: Tree.Name ~ TreeOps.GetName[TreeOps.NthSon[t, 1]];
      IF elemName = index THEN {
        type: Tree.Link ~ TreeOps.NthSon[t, 2];
        WITH type SELECT FROM
          typeId: Tree.Id => typeName _ SMVal.IdName[typeId];
          ENDCASE =>    -- temporary
            IF TreeOps.OpName[type] = $control THEN typeName _ $CONTROL
            ELSE NULL;        -- for now
          };
      };
      
        IF TreeOps.OpName[d] # $decl THEN ERROR;
        TreeOps.ScanSons[d, FindIndexType]};
      ENDCASE => NULL;    -- for now
    };
        
    
  EmptyLink: PROC[link: PrincOps.ControlLink] RETURNS[BOOL] ~ {
    RETURN[link = PrincOps.UnboundLink OR link = PrincOps.NullLink]};

 -- fill in links

  InputActuals: PROC[ls: LS, formals: Tree.Link] ~ {
    -- called with the load state locked
    n: NAT ~ TreeOps.NSons[formals];
    IF n = 0 THEN ls.importedInterfaces _ NIL
    ELSE {
      ls.importedInterfaces _ (ls.z).NEW[SMLoad.IRSeqRecord[n]];
      FOR i: NAT IN [1 .. n] DO
    id: Tree.Id ~ NARROW[TreeOps.GetExt[TreeOps.NthSon[formals, i]]];
    type: Tree.Link ~ SMVal.ValOf[SMVal.IdType[id]];
    stamp: TimeStamp.Stamp _ TimeStamp.Null;
    -- examine first son, it is either an apply for a mesa or an fiBcd for a bcd in the model
    WITH SMVal.ValOfNthSon[type, 1] SELECT FROM
      node: Tree.Handle => 
        IF TreeOps.OpName[node] IN Tree.ApplOp THEN
          stamp _ NARROW[TreeOps.GetExt[node], SMProj.Proj].stamp;
      fiBcd: SMFI.BcdFileInfo => stamp _ fiBcd.stamp;
      ENDCASE;
    IF stamp # TimeStamp.Null THEN
      ls.importedInterfaces[i-1] _ GetInterface[ls, stamp];
    ENDLOOP;
      };
    };
    
  GetInterface: PROC[ls: LS, bcdVers: TimeStamp.Stamp] RETURNS[ir: SMLoad.IR] ~ {
    -- called with loadstate locked
    linkerIR: CedarLinkerOps.IR;
    name: ATOM;
      {
      [interface~linkerIR, name~name] _ CedarLinkerOps.GetIR[version~bcdVers
        ! Loader.Error => {
             IF type = $versionMismatch THEN {
              ls.out.PutF["Error - version mismatch on %s\n",
                    IO.string[LOOPHOLE[message]]];
              PilotLoadStateOps.ReleaseLoadState[];
              GOTO inputForNextIR};
            PilotLoadStateOps.ReleaseLoadState[]; REJECT}    -- reject it
        ];
      IF linkerIR = NIL THEN {
    -- this is one of
    --        1) an imported module from the loadstate (done on demand; see LookupFrame)
    --        2) an imported interface that is all-INLINES
    --        3) or an imported interface that no one exports (error)
    ir _ NIL}
      ELSE {
    ir _ SMLoad.AllocateIR[name, linkerIR.size];
    ir.stamp _ bcdVers;
    FOR i: NAT IN [0 .. ir.size) DO ir[i] _ [link~linkerIR[i]] ENDLOOP};
      EXITS
    inputForNextIR => [] _ PilotLoadStateOps.InputLoadState[];
      };
    RETURN};


  ResolveImports: PROC[ls: LS, root: Tree.Link] ~ {

    -- traverses the value tree
    ForEachApply: SAFE PROC[node, parent: Tree.Link] ~ TRUSTED {
      IF TreeOps.OpName[node] IN Tree.ApplOp THEN
    WITH SMVal.GetExtFromParse[node] SELECT FROM
      loadMod: SMVal.LoadMod =>
        IF ~loadMod.loadInfo.linksResolved THEN {
          rand: Tree.Link ~ SMVal.ValOfNthSon[node, 2];
          args: Tree.Link ~ (IF SMVal.Binding[rand] THEN SMVal.BtoG[rand] ELSE rand);
          FillInImports[loadMod, args]}
      ENDCASE => NULL;
      };

    FillInImports: PROC[loadMod: SMVal.LoadMod, args: Tree.Link] ~ {
      loadInfo: SMLoad.LoadInfo ~ loadMod.loadInfo;
      bcdBase: BcdOps.BcdBase ~ loadInfo.bcdBase;
      gfiMap: SMLoad.GfiMap ~ loadInfo.gfiMap;
      imports: SMLoad.IRSeq ~ loadInfo.imports;
      mod, imp: NAT _ 0;
    
      ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex] 
      RETURNS[stop: BOOL_FALSE] ~ {
    fth: BcdOps.FTHandle ~ @LOOPHOLE[bcdBase + bcdBase.ftOffset, BcdDefs.Base][ith.file];
    FOR i: NAT IN [0 .. ith.ngfi) DO
      gfiMap[ith.gfi + i] _ [index~imp, whichOne~i];
      ENDLOOP;
    -- handle funny cases where two instances of the same interface are imported    ???
    IF ith.gfi = gfiMap.size THEN
      gfiMap.size _ gfiMap.size + ith.ngfi;
    imports[imp] _ LookUpInterface[ls, fth.version, imp, args];
    -- imports[imp] may be NIL
    IF FALSE AND imports[imp] = NIL THEN {
      -- generates spurious warnings about Inline, etc.
      sym: Rope.Text ~ SMLoad.NSToRope[bcdBase, ith.name];
      ls.out.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_FALSE] ~ {
    resolved: BOOL _ TRUE;
    [] _ SMLoad.OpenLinkSpace[loadInfo[mod].frame, mth, bcdBase];
    FOR i: CARDINAL IN [0 .. PilotLoaderOps.LinkSegmentLength[mth, bcdBase]) DO
      bound: BOOL;
      clink: PrincOps.ControlLink _ SMLoad.ReadLink[i];
      [clink, bound] _ NewLink[
                ls~ls, blink~PilotLoaderOps.IthLink[mth, i, bcdBase], 
                oldclink~clink, loadMod~loadMod, frame~loadInfo[mod].frame, 
                mth~mth, bcdBase~bcdBase, linkinx~i];
      IF bound THEN SMLoad.WriteLink[offset~i, link~clink]
      ELSE resolved _ FALSE;
      ENDLOOP;
    SMLoad.CloseLinkSpace[loadInfo[mod].frame];
    IF ~resolved THEN loadInfo.linksResolved _ FALSE;
    mod _ mod + 1};
        
      IF bcdBase.nImports = 0 THEN RETURN;    -- no imports
      -- the first part of gfiMap, 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 gfiMap.size > bcdBase.firstdummy THEN ERROR;
      gfiMap.size _ bcdBase.firstdummy;    -- adjust for dummies to come
      [] _ BcdOps.ProcessImports[bcdBase, ForEachImport];
      loadInfo.linksResolved _ TRUE;
      -- now run thru the frame links looking for imports to fill in
      [] _ BcdOps.ProcessModules[bcdBase, ForEachModule]};

    SMVal.VisitNodes[ls.tm, root, ForEachApply]};
    

  PossibleCoercion: SAFE PROC[t: Tree.Link] RETURNS[SMLoad.IR] ~ CHECKED {
    SELECT TreeOps.OpName[t] FROM
      IN Tree.ApplOp => {
    -- this is a coercion, simply use the first export
    loadMod: SMVal.LoadMod ~ NARROW[SMVal.GetExtFromParse[t]];
    RETURN[loadMod.loadInfo.exports[1]]};    -- check size before allowing coercion?
      $subscript, $then, $union => 
    RETURN[NARROW[TreeOps.GetExt[t]]];
      $nil => RETURN[NIL];
      ENDCASE => RETURN[NIL]    -- ERROR?
    };
        

  LookUpInterface: PROC[
       ls: LS, bcdVers: TimeStamp.Stamp, imp: NAT, args: Tree.Link]
     RETURNS[SMLoad.IR] ~ {
    
    LookupOutside: PROC[id: Tree.Id] RETURNS[ir: SMLoad.IR] ~ {
      ir _ ls.importedInterfaces[id.p-1];    -- id must be a formal
      IF ir = NIL THEN
    ls.out.PutF["Can't import %s from load state\n", IO.atom[SMVal.IdName[id]]];
      RETURN};
        
    IF TreeOps.OpName[args] # $group THEN ERROR;
    IF imp+1 > TreeOps.NSons[args] THEN 
      RETURN[HiddenImport[ls, args, bcdVers]];
    WITH SMVal.ValOfNthSon[args, imp+1] SELECT FROM
      node: Tree.Handle => RETURN[PossibleCoercion[node]];
      id: Tree.Id => RETURN[LookupOutside[id]];
      ENDCASE => ERROR;
    };
    

  HiddenImport: PROC[ls: LS, args: Tree.Link, bcdVers: TimeStamp.Stamp] 
      RETURNS[ir: SMLoad.IR _ NIL] ~ {
    
    CheckArg: TreeOps.Scan ~ CHECKED {
      WITH t SELECT FROM
        id: Tree.Id => {
          type: Tree.Link ~ SMVal.ValOf[SMVal.IdType[id]];
          IF TreeOps.OpName[type] IN Tree.ApplOp THEN {
            typeArgs: Tree.Link ~ SMVal.ValOfNthSon[type, 2];
        
        CheckTypeArg: TreeOps.Scan ~ CHECKED {
          WITH SMVal.ValOf[t] SELECT FROM
        node: Tree.Handle => {
          argIr: SMLoad.IR ~ PossibleCoercion[node];
          IF argIr ~= NIL AND argIr.stamp = bcdVers THEN {
            IF ir ~= NIL AND ir ~= argIr THEN
              ls.out.PutF["Ambiguous implicit import of %s\n", IO.atom[ir.name]];
            ir _ argIr};
          };
        ENDCASE;
          CheckArg[t]};    -- multi-level hidden imports
          
            TreeOps.ScanSons[typeArgs, CheckTypeArg]};
          };
        node: Tree.Handle => 
          SELECT TreeOps.OpName[node] FROM
            $union, $then => {
              CheckArg[TreeOps.NthSon[node, 1]]; CheckArg[TreeOps.NthSon[node, 2]]};
            ENDCASE => NULL;    -- for now
        ENDCASE;
      };
      
    TreeOps.ScanSons[args, CheckArg];
    -- ir will be NIL here only if implicitly importing instance came from loadstate
    IF ir = NIL THEN {
      [] _ PilotLoadStateOps.InputLoadState[];
      ir _ GetInterface[ls, bcdVers ! UNWIND => {PilotLoadStateOps.ReleaseLoadState[]}];
      PilotLoadStateOps.ReleaseLoadState[]};
    RETURN};


  NewLink: PROC[
      ls: LS, blink: BcdDefs.Link, oldclink: PrincOps.ControlLink, 
    loadMod: SMVal.LoadMod,
    frame: PrincOps.GlobalFrameHandle, mth: BcdOps.MTHandle, bcdBase: BcdOps.BcdBase,
    linkinx: CARDINAL]
      RETURNS[newclink: PrincOps.ControlLink, resolved: BOOL] ~ {
    loadInfo: SMLoad.LoadInfo ~ loadMod.loadInfo;
    
    FindLink: PROC[blink: BcdDefs.Link] RETURNS[PrincOps.ControlLink, BOOL] ~ {
      IF blink.gfi < loadInfo.bcdBase.firstdummy THEN {
    SELECT blink.vtag FROM
      $proc0, $proc1 => {
        rgfi: PrincOps.GFTIndex ~ loadInfo.gfiMap[blink.gfi].index;
        newclink _ SMLoad.ConvertLink[blink];
        newclink.gfi _ rgfi + loadInfo.gfiMap[blink.gfi].whichOne;
        resolved _ (rgfi ~= PrincOps.GFTNull)};
      $var => {
        [link~newclink] _ CedarLinkerOps.FindVariableLink[
        bcd~loadInfo.bcdBase, mthLink~blink,
        rgfi~loadInfo.gfiMap[blink.vgfi].index];
        resolved _ ~EmptyLink[newclink]};
      ENDCASE => NULL;
    }
      ELSE {
    intNo: CARDINAL ~ loadInfo.gfiMap[blink.gfi].index;
    trueEP: CARDINAL ~ 
      blink.ep + (loadInfo.gfiMap[blink.gfi].whichOne * BcdDefs.EPLimit);
    ir: SMLoad.IR _ loadInfo.imports[intNo];
    IF ir = NIL THEN  -- try the module frame table
      loadInfo.imports[intNo] _ ir _ LookupFrame[ls, loadInfo.bcdBase, intNo];
    -- import not satisfied?
    IF ir = NIL OR EmptyLink[ir[trueEP].link] THEN {
      ith: BcdOps.IMPHandle ~ GetImpHandle[loadInfo.bcdBase, intNo];
      fth: BcdOps.FTHandle ~
        @LOOPHOLE[loadInfo.bcdBase + loadInfo.bcdBase.ftOffset, BcdDefs.Base][ith.file];
      sym: Rope.Text ~ SMLoad.NSToRope[loadInfo.bcdBase, ith.name];
      ls.out.PutF["Warning - Unable to resolve import of item #%d from interface %s\n\tof %s ",
        IO.card[trueEP], IO.rope[sym], IO.rope[CS.RopeFromStamp[fth.version]]];
      ls.out.PutF["(the %dth import of  %s).\n",
        IO.card[intNo], IO.rope[loadMod.proj.localName]];
      UpdatePendingList[ls, sym, frame, mth, bcdBase, linkinx, trueEP];
      RETURN[oldclink, FALSE]};
        -- at this point module and variable links are set to their absolute addresses
        newclink _ ir[trueEP].link; resolved _ TRUE};
      RETURN[newclink, resolved]};
        
    newclink _ oldclink;  resolved _ FALSE;
    SELECT blink.vtag FROM
      $proc0, $proc1,
      $var =>
    IF EmptyLink[oldclink] THEN [newclink, resolved] _ FindLink[blink];
      ENDCASE => newclink _ LOOPHOLE[blink.typeID];
    };

  UpdatePendingList: PROC[
    ls: LS,
    name: Rope.Text, frame: PrincOps.GlobalFrameHandle,
    mth: BcdOps.MTHandle, bcdBase: BcdOps.BcdBase, linkinx, trueEP: CARDINAL] ~ {
    atom: ATOM ~ Atom.MakeAtom[name];
    pending: CedarLinkerOps.PendingList _ CedarLinkerOps.GetPendingList[atom];
    -- pendingCount _ pendingCount + 1;
    pending _ (ls.z).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]]];
    };

  LookupFrame: PROC[ls: LS, bcdBase: BcdOps.BcdBase, intNo: CARDINAL] 
      RETURNS[SMLoad.IR] ~ {
    ith: BcdOps.IMPHandle ~ GetImpHandle[bcdBase, intNo];
    fth: BcdOps.FTHandle ~ @LOOPHOLE[bcdBase + bcdBase.ftOffset, BcdDefs.Base][ith.file];
    name: ATOM ~ Atom.MakeAtom[SMLoad.NSToRope[bcdBase, ith.name]];
    version: TimeStamp.Stamp ~ fth.version;
    ir: SMLoad.IR;
    clink: PrincOps.ControlLink;
    old: REF BcdDefs.VersionStamp;
    FOR l: LIST OF REF FrameListRecord _ ls.frameInterfaces, l.rest UNTIL l = NIL DO
      IF l.first.stamp = version AND l.first.ir.name = name THEN
    RETURN[l.first.ir];
      ENDLOOP;
    old _ (ls.z).NEW[BcdDefs.VersionStamp _ version];
    Atom.PutProp[name, $version, old];
    -- try for imported module, this is very expensive
    clink _ LoaderPrivate.GetModuleLink[atom~name];
    IF ~EmptyLink[clink] THEN {  -- found
      ir _ SMLoad.AllocateIR[name, 1];
      ir[0] _ [link~clink];
      ir.stamp _ version}
    ELSE ir _ NIL;
    -- caches result so GetModuleLink is only called once per name
    ls.frameInterfaces _ (ls.z).CONS[(ls.z).NEW[FrameListRecord _
    [stamp~version, ir~ir]], ls.frameInterfaces];
    RETURN[ir]};


 -- call Paul Rovner's procedure to fixup the Cedar Atoms and Ropes section
  ProcessCedarBcds: PROC[ls: LS, root: Tree.Link] ~ {

    -- traverses the value tree
    ForEachApply: SAFE PROC[node, parent: Tree.Link] ~ TRUSTED {
      IF TreeOps.OpName[node] IN Tree.ApplOp THEN
    WITH SMVal.GetExtFromParse[node] SELECT FROM
      loadMod: SMVal.LoadMod => {
        loadInfo: SMLoad.LoadInfo ~ loadMod.loadInfo;
        bcdBase: BcdOps.BcdBase;
        IF loadInfo = NIL OR loadInfo.rtStarted THEN RETURN;
        bcdBase _ loadInfo.bcdBase;
        IF ~bcdBase.extended THEN RETURN;
        RTLoader.AcquireTypesAndLiterals[bcd~bcdBase, map~loadInfo.map];
        loadInfo.rtStarted _ TRUE};
      ENDCASE => NULL;
      };

    SMVal.VisitNodes[ls.tm, root, ForEachApply]};
    

  StartElemRecord: TYPE ~ RECORD [
    prog: PROGRAM,
    frame: PrincOps.GlobalFrameHandle];
    
  Started: PUBLIC SAFE PROC[ls: LS] RETURNS[BOOL] ~ CHECKED {
    RETURN [Loaded[ls] AND ls.started]};
    
  StartAll: PUBLIC SAFE PROC[ls: LS, root: Tree.Link] ~ TRUSTED {
    starr: LIST OF REF StartElemRecord;
    prog: PROGRAM;
    dontFork: BOOL _ TRUE;
    
    -- traverses the value tree
    ForEachNode: SAFE PROC[node, parent: Tree.Link] ~ CHECKED {
      IF SMVal.Binding[node] THEN {
        d: Tree.Link ~ SMVal.BtoD[node];
        g: Tree.Link ~ SMVal.BtoG[node];
        p: NAT _ 0;
        
        CheckElem: TreeOps.Scan ~ TRUSTED {
          p _ p+1;
          IF TreeOps.OpName[SMVal.ValOfNthSon[t, 2]] = $control THEN
            StartModule[SMVal.ValOfNthSon[g, p]]
          };
          
        TreeOps.ScanSons[d, CheckElem]};
      };

    StartModule: PROC[t: Tree.Link] ~ {
      WITH t SELECT FROM
    node: Tree.Handle => {
      SELECT TreeOps.OpName[node] FROM
        IN Tree.ApplOp =>
          WITH SMVal.GetExtFromParse[node] SELECT FROM
        loadMod: SMVal.LoadMod => {
          FOR i: NAT IN [0 .. loadMod.loadInfo.size) DO
            Runtime.ValidateGlobalFrame[loadMod.loadInfo[i].frame];
            IF loadMod.loadInfo[i].frame.started THEN {
              ls.out.PutF["Error - %s has already been started.\n", 
            IO.rope[loadMod.proj.localName]];
              RETURN};
            ENDLOOP;
          ls.out.PutF["Will start %s\n", IO.rope[loadMod.proj.localName]];
          prog _ LOOPHOLE[loadMod.loadInfo.cm];
          starr _ (ls.z).CONS[(ls.z).NEW[StartElemRecord _ [
            prog~prog, frame~loadMod.loadInfo[0].frame]], starr];
          };
        ENDCASE;
        $subscript =>  StartModule[SMVal.ValOfNthSon[node, 1]];
        ENDCASE;
      };
    ENDCASE => NULL;
      };

    SMVal.VisitNodes[ls.tm, SMVal.OuterBody[root].body, ForEachNode];
    starr _ LOOPHOLE[List.DReverse[LOOPHOLE[starr]]];
    IF dontFork THEN StartProcedure[ls, starr]
    ELSE Process.Detach[FORK StartProcedure[ls, starr]];
    };
    
 -- this procedure may be forked
  StartProcedure: PROC[ls: LS, starr: LIST OF REF StartElemRecord] ~ {
    i: CARDINAL _ 0;
    ls.started _ TRUE;
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO aborted};
      FOR l: LIST OF REF StartElemRecord _ starr, l.rest UNTIL l = NIL DO
    i _ i + 1;
    IF l.first.frame.started THEN 
      ls.out.PutF["Error - element %d of start list has already been started.\n", IO.card[i]]
    ELSE START l.first.prog;
    ENDLOOP;
      EXITS
    aborted => NULL;
      };
    IF i = 0 THEN ls.out.PutF["Nothing was started.\n\n"]
    ELSE ls.out.PutF["All %d modules have been started.\n\n", IO.card[i]]};

  }.


 -- code not yet ready (needs additions to SMOps.MS or Global)

  PutExportsInLoadState: PROC[g: SM.Global] ~ {
    mi: SM.MI;
    FOR l: SM.ModuleList _ g.moduleList, l.rest UNTIL l = NIL DO
      mi _ l.first;
      IF mi.exportedInterface THEN {
    FOR l: LIST OF SMLoad.IR _ 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.fileName]];
      ENDLOOP;
    };
      ENDLOOP;
    -- process any pendings we have found
    IF g.toBeProcessed ~= NIL THEN 
      CedarExporterImpl.ProcessPendingEntries[g.toBeProcessed];
    };

  AddInterfaceToLoadState: PROC[g: SM.Global, ir: SMLoad.IR] ~ {
    atom: ATOM ~ Atom.MakeAtom[ir.name];
    pending: CedarLinkerOps.PendingList;
    linkerIR: CedarLinkerOps.IR ~ CedarLinkerOps.GetIR[atom, ir.stamp, ir.size].interface;
    FOR i: NAT IN [0 .. ir.size) DO
      IF ~EmptyLink[ir[i].link] THEN linkerIR[i] _ ir[i].link;
      ENDLOOP;
    -- fill in any importers
    pending _ CedarLinkerOps.GetPendingList[atom];
    IF pending ~= NIL THEN {
      [g.toBeProcessed, pending] _
        CedarExporterImpl.SaveResolvedEntries[g.toBeProcessed, pending, linkerIR];
      CedarLinkerOps.SetPendingList[atom, pending]};
    };