-- RTLoaderImpl.Mesa
  -- Last Modified On March 7, 1983 8:57 am by Paul Rovner 

DIRECTORY
    AtomsPrivate USING[UnsafeMakeAtom],
    BcdDefs USING[VersionStamp, MTIndex, SGIndex, RFNull,
                       RFIndex, TFNull, TFIndex, NameRecord, FTSelf],
    BcdOps USING[BcdBase, MTHandle, ProcessModules, NameString],
    Environment USING[wordsPerPage],
    Frame USING[Alloc],
    Inline USING[LongCOPY, COPY, BITAND],
    Loader USING[Error],
    LongString USING[AppendString, SubStringDescriptor, AppendSubString],
    PilotLoadStateFormat USING[ModuleInfo, ConfigIndex],
    PilotLoadStateOps USING[ReleaseBcd, ReleaseLoadState, Map, ConfigIndex,
                            InputLoadState, MapRealToConfig, AcquireBcd,
                            EnumerateModules, EnumerateBcds, GetMap, ReleaseMap],
    PrincOps USING[GlobalFrameHandle, GFTIndex, ProcDesc, CSegPrefix, NullGlobalFrame,
                       MainBodyIndex, LastAVSlot, FrameVec],
    PrincOpsRuntime USING[GetFrame, GFT],
    Process USING[GetCurrent],
    RCMap USING[Index, Base, invalidIndex],
    NewRCMapOps USING[Include, MapMap, FindMapMapEntry],
    RTBasic USING[Type, nullType, TypeIndex],
    RTBcd USING[AnyStamp, RTBase, StampList, TypeList, VersionID, TypeItem, RefLitItem],
    RTLoader USING[],  -- EXPORTS only
    RTOS USING[PrivateHeapZone, IsAllocatorReady, RegisterCedarProcess, SameCode,
                   EnumerateGlobalFrames],
    RTMicrocode USING[LONGZERO],
    RTStorageOps USING[NewObject],
    RTSymbolDefs USING[nullXSymbolIndex],
    RTTypesBasicPrivate USING[AcquireTypeForLoader, UniqueTypeFinger],
    Runtime USING[ValidateGlobalFrame],
    RuntimeInternal USING[Codebase, EnterGlobalFrame],
    SDDefs USING[SD, sCopy, sUnNew],
    SafeStorageExtras USING[permanentZone],
    SSExtra USING[useSizeToZn],
    Table USING[Base],
    TimeStamp USING[Null, Stamp],
    TypeStrings USING[Code, TypeString];

RTLoaderImpl: PROGRAM
    IMPORTS AtomsPrivate, BcdOps, Frame, Inline, Loader, LongString, plp: PilotLoadStateOps,
               PrincOpsRuntime, Process, NewRCMapOps, RTOS, RTMicrocode, RTStorageOps,
               RTTypesBasicPrivate, Runtime, RuntimeInternal, SafeStorageExtras
    EXPORTS RTLoader
    SHARES RTBasic =
BEGIN OPEN AtomsPrivate, BcdDefs, plsf: PilotLoadStateFormat, RTBcd, RTStorageOps, RTBasic;

atomType: Type _ nullType;
TypeTable: TYPE = RECORD[SEQUENCE length: NAT OF Type];

GFTShadow: TYPE = LONG POINTER TO GFTShadowTable;
GFTShadowTable: TYPE = ARRAY PrincOps.GFTIndex OF GFTShadowEntry;
GFTShadowEntry: TYPE = Type;
gftShadow: GFTShadow _ NIL;
oldUnNew: PROC[frame: PrincOps.GlobalFrameHandle] _ NIL;

GetGFRCType: PUBLIC PROC[gfi: PrincOps.GFTIndex] RETURNS[Type] =
 {RETURN[gftShadow[gfi]]};
 
   -- called by the Mesa runtime loader or the Cedar modeller after loading a bcd
   -- this initializes the type table and REF literal table in each new global frame.
AcquireTypesAndLiterals: PUBLIC PROC[bcd: BcdOps.BcdBase,
                                                   map: PilotLoadStateOps.Map] =
{  -- fill in the master tables (types, collectible literals) for the BCD.
   -- Then, foreach MT entry, fix up its type table and collectible literal table
   -- in the corresponding GF.
 rtBase: RTBcd.RTBase;
 rfBase, tfBase: Table.Base;
 l: NAT;
 ptrTypeTable: LONG POINTER TO TypeTable _ NIL;
 RefLitTable: TYPE = RECORD[SEQUENCE length: NAT OF REF ANY];
 rrlt: REF RefLitTable _ NIL;
 rcmm: NewRCMapOps.MapMap _ NIL;
                  
   -- foreach module in this bcd...
 doModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS[stop: BOOLEAN _ FALSE] =
   { OPEN PrincOpsRuntime;
     gfh: PrincOps.GlobalFrameHandle = GetFrame[GFT[map[mth.gfi]]];
     IF mth = NIL THEN ERROR;
     WITH mth: mth SELECT FROM
       multiple =>
        { IF mth.refLiterals # RFNull
           THEN {rl: RFIndex = mth.refLiterals;
                 gfRefLiteralTable: LONG POINTER _ LONG[gfh+rfBase[rl].offset];
                 FOR i: NAT IN [0..rfBase[rl].length)
                   DO LOOPHOLE[gfRefLiteralTable+i*SIZE[REF ANY], REF REF ANY]^ _ rrlt[rfBase[rl].frag[i]]
                       --GFs are initially cleared to all NIL
                  ENDLOOP};
          IF mth.types # TFNull
           THEN {t: TFIndex = mth.types;
                 pat: POINTER TO ARRAY [0..0) OF Type _ LOOPHOLE[gfh+tfBase[t].offset];
                 FOR i: NAT IN [0..tfBase[t].length)
                   DO pat[i] _ ptrTypeTable[tfBase[t].frag[i]]
                  ENDLOOP;
                 IF NOT mth.tableCompiled AND mth.frameRefs
                  THEN gftShadow[map[mth.gfi]] _ pat[mth.frameType];
                        --fill in gftype in gftshadow--
                }};
      ENDCASE};

   -- START AcquireTypesAndLiterals HERE
 RTOS.RegisterCedarProcess[LOOPHOLE[Process.GetCurrent[]]];
 IF (NOT bcd.extended) OR (bcd.rtPages.pages = 0) THEN RETURN;  -- old-style bcd or empty rtBase
 IF atomType = nullType THEN ERROR;  -- better have done AcquireBasicTypes by now
 rtBase _ LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage];
 IF rtBase.versionIdent # RTBcd.VersionID
   THEN {s: STRING = "RTBcd version mismatch";
            ERROR Loader.Error[invalidBcd, LOOPHOLE[LONG[s]]]};
 rfBase _ LOOPHOLE[bcd + bcd.rfOffset];
 tfBase _ LOOPHOLE[bcd + bcd.tfOffset];

--now merge the BCD's RCMap base into the rcMapBase that is maintained by RT.
-- construct rcmm: (BCD rcmapx -> RT rcmapx)
 IF rtBase.rcMapLength # 0
   THEN rcmm _ NewRCMapOps.Include[LOOPHOLE[@rtBase[rtBase.rcMapBase]], rtBase.rcMapLength, RTOS.PrivateHeapZone];

 ptrTypeTable _ AcquireTypes[bcd, rcmm];

 l _ rtBase[rtBase.refLitTable].length;
 IF l # 0
  THEN { IF NOT RTOS.IsAllocatorReady[] THEN ERROR;
         rrlt _ NEW[RefLitTable[l]];  -- collectible!!
         FOR i: NAT IN [0..l)
          DO
            rli: RefLitItem = rtBase[rtBase.refLitTable][i];
            p: LONG POINTER _ (@rtBase[rtBase.litBase]) + rli.offset;
            IF rli.length = 0 THEN {rrlt[i] _ NIL; LOOP};
            IF ptrTypeTable[rli.referentType] = atomType
             THEN rrlt[i] _ UnsafeMakeAtom[LOOPHOLE[p]]
             ELSE {rrlt[i] _ NewObject[type: ptrTypeTable[rli.referentType],
                                            size: rli.length,
                                            zone: SafeStorageExtras.permanentZone];
                   Inline.LongCOPY[from: p, to: LOOPHOLE[rrlt[i]], nwords: rli.length]};
          ENDLOOP};

 [] _ BcdOps.ProcessModules[bcd, doModule];

 IF ptrTypeTable # NIL THEN RTOS.PrivateHeapZone.FREE[@ptrTypeTable];
 IF rcmm # NIL THEN RTOS.PrivateHeapZone.FREE[@rcmm];
};



 ptt: LONG POINTER TO TypeTable _ NIL;
 MTMapRec: TYPE = RECORD[SEQUENCE length: NAT OF BcdOps.MTHandle];
 mtMap: LONG POINTER TO MTMapRec _ NIL;
 rcMapMap: NewRCMapOps.MapMap _ NIL;
 atomTypeChain: POINTER TO Type _ NIL;  -- NOTE assume TypeTable (in gf) entry is 1 word

 -- Whiz thru THIS config in the loadstate, acquiring Types.
 -- This config includes at least RT.bcd.
AcquireBasicTypes: PROC =
{config: plp.ConfigIndex;
 bcd: BcdOps.BcdBase;
 rtBase: RTBcd.RTBase;
 tfBase: Table.Base;

   -- foreach module found in the loadstate for this config...
 processLSModule: PROC[rgfi: PrincOps.GFTIndex, module: plsf.ModuleInfo]
      RETURNS[stop: BOOLEAN _ FALSE] =
   { gfh: PrincOps.GlobalFrameHandle = PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]];
     mth: BcdOps.MTHandle;
     IF module.config # config THEN RETURN;
     mth _ mtMap[module.gfi];
     IF mth = NIL THEN RETURN; --Ignore multiple gfi's for the same module.
     WITH mth: mth SELECT FROM
       multiple =>
        { IF mth.types # TFNull
           THEN {t: TFIndex = mth.types;
                 pat: POINTER TO ARRAY [0..0) OF Type _ LOOPHOLE[gfh+tfBase[t].offset];
                 FOR i: NAT IN [0..tfBase[t].length)
                   DO IF ptt[tfBase[t].frag[i]] = LAST[TypeIndex] -- special case for ATOMs.
                                                           -- Link this into atomTypeChain.
                       THEN {pat[i] _ LOOPHOLE[atomTypeChain]; atomTypeChain _ @pat[i]}
                       ELSE pat[i] _ ptt[tfBase[t].frag[i]];
                  ENDLOOP;
                 IF NOT mth.tableCompiled AND mth.frameRefs
                  THEN gftShadow[rgfi] _ pat[mth.frameType];
                         --fill in gftype in gftshadow--
                 }};
      ENDCASE};

 buildMTMap: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
      RETURNS[stop: BOOLEAN _ FALSE] = {mtMap[mth.gfi] _ mth};
                  
 pd: PrincOps.ProcDesc = LOOPHOLE[AcquireBasicTypes];

 [] _ plp.InputLoadState[];
 [, config] _ plp.MapRealToConfig[pd.gfi];
 bcd _ plp.AcquireBcd[config];
 IF (NOT bcd.extended) OR bcd.rtPages.pages = 0 THEN ERROR;
   -- this bcd (RT and friends) better have somethin' to say
 rtBase _ LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage];
 IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR;
 tfBase _ LOOPHOLE[bcd + bcd.tfOffset];
 IF rtBase.rcMapLength = 0 THEN ERROR;

 mtMap _ RTOS.PrivateHeapZone.NEW[MTMapRec[bcd.firstdummy--gfi's start at 1--]];
 FOR i: NAT IN [0..bcd.firstdummy) DO mtMap[i] _ NIL; ENDLOOP;
 [] _ BcdOps.ProcessModules[bcd, buildMTMap];  -- NIL entries in mtMap represent dummy gfi's

--now merge the BCD's RCMap base into the rcMapBase that is maintained by RT.
-- construct rcMapMap: (BCD rcmapx -> RT rcmapx)
 rcMapMap _ NewRCMapOps.Include[LOOPHOLE[@rtBase[rtBase.rcMapBase]], rtBase.rcMapLength, RTOS.PrivateHeapZone];

 ptt _ AcquireTypes[bcd, rcMapMap, TRUE];

 [] _ plp.EnumerateModules[processLSModule]; 

 plp.ReleaseBcd[bcd]; plp.ReleaseLoadState[]};

AcquireTypes: PROC[bcd: BcdOps.BcdBase, rcMapMap: NewRCMapOps.MapMap, checkAtom: BOOLEAN _ FALSE]
      RETURNS[ptt: LONG POINTER TO TypeTable _ NIL] =
 { rtBase: RTBcd.RTBase = LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage];
   typeTable: RTBase RELATIVE POINTER TO TypeList _ rtBase.typeTable;
   l: NAT _ rtBase[typeTable].length;

   IF l # 0
   THEN { ptt _ RTOS.PrivateHeapZone.NEW[TypeTable[l]];
          FOR i: NAT IN [0..l)
            DO
             rcmi: RCMap.Index;
             ti: TypeItem = rtBase[typeTable][i];
             st: RTBase RELATIVE POINTER TO StampList = rtBase.stampTable;
             utf: RTTypesBasicPrivate.UniqueTypeFinger
                 _ [(IF ti.ut.version = AnyStamp
                      THEN TimeStamp.Null 
                      ELSE rtBase[st][ti.ut.version]),
                     [x[ti.ut.sei]]];
             ts: TypeStrings.TypeString _ LOOPHOLE[@rtBase[rtBase.litBase] + ti.ct.index];

             IF ti.sei = RTSymbolDefs.nullXSymbolIndex THEN {ptt[i] _ nullType; LOOP};
             rcmi _ NewRCMapOps.FindMapMapEntry[rcMapMap, LOOPHOLE[ti.rcMap]];
             IF rcmi = RCMap.invalidIndex THEN ERROR;
               -- to solve the atom type bootstrapping problem.
             IF checkAtom AND IsAtomRecTS[ts]
              THEN ptt[i] _ [LAST[TypeIndex]]  -- special case for ATOMs
              ELSE {sgb: Table.Base = LOOPHOLE[bcd + bcd.sgOffset];
                    ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
                    version: TimeStamp.Stamp;
                    IF sgb[ti.table].file = BcdDefs.FTSelf
                     THEN version _ bcd.version
                     ELSE version _ ftb[sgb[ti.table].file].version;
                    ptt[i] _ RTTypesBasicPrivate.AcquireTypeForLoader
                                  [utf: utf,
                                   std: [symbolsStamp: version,
                                         bcd: bcd,
                                         sgi: ti.table],
                                   sei: [x[ti.sei]],
                                   ts: ts,
                                   rcmi: rcmi,
                                   canonicalize: (SSExtra.useSizeToZn OR ti.canonical)]};  -- XXX
           ENDLOOP}};

GetFileNameString: PROC[ssb: BcdOps.NameString, n: BcdDefs.NameRecord, nameString: LONG STRING] = 
 {ssd: LongString.SubStringDescriptor _ [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
  dot: BOOLEAN _ FALSE;
  nameString.length _ 0;
  LongString.AppendSubString[to: nameString, from: @ssd];
  FOR i: CARDINAL IN [0..nameString.length) DO
    IF nameString[i] = '. THEN {dot _ TRUE; EXIT};
   ENDLOOP;
  IF ~dot THEN LongString.AppendString[to: nameString, from: ".bcd"]};

CopyString: PROC[s: LONG STRING] RETURNS[ns: LONG STRING] =
 { ns _ LOOPHOLE[RTOS.PrivateHeapZone.NEW[TEXT[s.length]]];
   LongString.AppendString[to: ns, from: s]};

  -- Called AFTER the allocator and basic ATOM machinery have been initialized.
AcquireBasicLiterals: PUBLIC PROC[aType: Type] =
{config: plp.ConfigIndex;
 bcd: BcdOps.BcdBase;
 rtBase: RTBcd.RTBase;
 rfBase: Table.Base;
 l: NAT;
 RefLitTable: TYPE = RECORD[SEQUENCE length: NAT OF REF ANY];
 rrlt: REF RefLitTable _ NIL;
 pd: PrincOps.ProcDesc = LOOPHOLE[AcquireBasicLiterals];

   -- foreach module found in the loadstate for this config...
 processLSModule: PROC[rgfi: PrincOps.GFTIndex, module: plsf.ModuleInfo]
      RETURNS[stop: BOOLEAN _ FALSE] =
   { gfh: PrincOps.GlobalFrameHandle = PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]];
     mth: BcdOps.MTHandle;
     IF module.config # config THEN RETURN;
     mth _ mtMap[module.gfi];
     IF mth = NIL THEN RETURN; --Ignore multiple gfi's for the same module.
     WITH mth: mth SELECT FROM
       multiple =>
          IF mth.refLiterals # RFNull
           THEN {rl: RFIndex = mth.refLiterals;
                 gfRefLiteralTable: LONG POINTER _ LONG[gfh+rfBase[rl].offset];
                 FOR i: NAT IN [0..rfBase[rl].length)
                   DO LOOPHOLE[gfRefLiteralTable+i*SIZE[REF ANY], REF REF ANY]^ _ rrlt[rfBase[rl].frag[i]]
                       --GFs are initially cleared to all NIL
                  ENDLOOP};
      ENDCASE};

  -- START AcquireBasicLiterals here

    -- first, fixup the atom type chain.
 atomType _ aType;
 UNTIL atomTypeChain = NIL
  DO next: POINTER TO Type = LOOPHOLE[atomTypeChain^];
     atomTypeChain^ _ atomType;
     atomTypeChain _ next;
  ENDLOOP;

  -- next, get the BCD that contains this module (and RT.bcd)
 [] _ plp.InputLoadState[];  -- acquire the lock on the loadstate
 [, config] _ plp.MapRealToConfig[pd.gfi];
 bcd _ plp.AcquireBcd[config];
 IF (NOT bcd.extended) OR bcd.rtPages.pages = 0 THEN ERROR;
   -- this bcd (RT) better have somethin' to say
 rtBase _ LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage];
 IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR;
 rfBase _ LOOPHOLE[bcd + bcd.rfOffset];

  -- now construct rrlt if there are any REF literals or ATOM constants, and store
  -- such REFs in indicated global frames
 l _ rtBase[rtBase.refLitTable].length;
 IF l # 0
  THEN
       { IF NOT RTOS.IsAllocatorReady[] THEN ERROR;
         rrlt _ NEW[RefLitTable[l]];
           -- collectible!! Types have been acquired for RTLoaderImpl by this time.

           -- first acquire REF literals (the rope implementation, invoked by 
           -- UnsafeMakeAtom, needs 'em)
         FOR i: NAT IN [0..l)
          DO
            rli: RefLitItem = rtBase[rtBase.refLitTable][i];
            p: LONG POINTER _ (@rtBase[rtBase.litBase]) + rli.offset;
            IF rli.length = 0 THEN {rrlt[i] _ NIL; LOOP};
            IF ptt[rli.referentType] = LAST[TypeIndex]  -- special case for ATOMs
             THEN LOOP
             ELSE {rrlt[i] _ NewObject[type: ptt[rli.referentType],
                                            size: rli.length,
                                            zone: SafeStorageExtras.permanentZone];
                   Inline.LongCOPY[from: p, to: LOOPHOLE[rrlt[i]], nwords: rli.length]};
          ENDLOOP;
         [] _ plp.EnumerateModules[processLSModule];
         
           -- now acquire ATOMs
         FOR i: NAT IN [0..l)
          DO
            rli: RefLitItem = rtBase[rtBase.refLitTable][i];
            p: LONG POINTER _ (@rtBase[rtBase.litBase]) + rli.offset;
            IF rli.length = 0 THEN {rrlt[i] _ NIL; LOOP};
            IF ptt[rli.referentType] = LAST[TypeIndex]  -- special case for ATOMs
             THEN rrlt[i] _ UnsafeMakeAtom[LOOPHOLE[p]]
                   -- UnsafeMakeAtom invokes the ROPE package, which uses REF literals
                   -- (but no ATOM literals). The parts of RT.config have no ATOM
                   -- literals
             ELSE LOOP;
          ENDLOOP;
         [] _ plp.EnumerateModules[processLSModule];
         }; 

  -- now cleanup after the work on this BCD
 RTOS.PrivateHeapZone.FREE[@mtMap];
 IF ptt # NIL THEN RTOS.PrivateHeapZone.FREE[@ptt];
 IF rcMapMap = NIL THEN ERROR;
 RTOS.PrivateHeapZone.FREE[@rcMapMap];
 plp.ReleaseBcd[bcd];
 
 -- and foreach config except this one in the current loadstate invoke (vanilla)
 -- AcquireTypesAndLiterals.
 {p: PROC[otherConfig: plp.ConfigIndex] RETURNS [BOOLEAN] =
    {IF otherConfig # config
      THEN {otherBcd: BcdOps.BcdBase = plp.AcquireBcd[otherConfig];
            otherMap: PilotLoadStateOps.Map = plp.GetMap[otherConfig];
            AcquireTypesAndLiterals[otherBcd, otherMap];
            plp.ReleaseMap[otherMap];
            plp.ReleaseBcd[otherBcd]};
     RETURN[FALSE]};
   
  [] _ plp.EnumerateBcds[recentfirst, p];
 };

  -- finish cleanup by releasing the loadstate lock
 plp.ReleaseLoadState[];

        -- Finally, stuff SD with CopyNew.
        -- The Cedar runtime loader is ready.
 SDDefs.SD[SDDefs.sCopy] _ CopyNew;
 oldUnNew _ LOOPHOLE[SDDefs.SD[SDDefs.sUnNew]];
 SDDefs.SD[SDDefs.sUnNew] _ UnNew;
};

IsAtomRecTS: PROC[ts: TypeStrings.TypeString] RETURNS[BOOLEAN] =
  {RETURN[ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]]};

UnNew: --PUBLIC-- PROC[frame: PrincOps.GlobalFrameHandle] =
    -- conceptually, UnNew is PUBLIC, but is accessed via the System Dispatch table.
  { gftShadow[frame.gfi] _ nullType;
    oldUnNew[frame];
  };

CopyNew: --PUBLIC-- PROC [old: PrincOps.GlobalFrameHandle]
    RETURNS [new: PrincOps.GlobalFrameHandle] =
    -- conceptually, Copy is PUBLIC, but it is accessed via the System Dispatch table,
    -- which is stuffed with this guy by AcquireBasicLiterals.
  { linkspace: CARDINAL;
    codebase: LONG POINTER TO PrincOps.CSegPrefix;
    Runtime.ValidateGlobalFrame[old];
    codebase _ RuntimeInternal.Codebase[LOOPHOLE[old, PROGRAM]];
    [new, linkspace] _ AllocGlobalFrame[old, codebase];
    new _ new + linkspace;
    new^ _ [gfi:, alloced: TRUE, shared: TRUE, copied: TRUE, started: FALSE,
               trapxfers: FALSE, codelinks: old.codelinks, code: old.code, global:];
    new.code.out _ TRUE;  -- cause trap
    new.global[0] _ PrincOps.NullGlobalFrame;
    IF linkspace # 0
     THEN Inline.COPY[from: old - linkspace, to: new - linkspace, nwords: linkspace];

    IF old.copied
     THEN {findOriginal: PROC[f: PrincOps.GlobalFrameHandle] RETURNS[BOOL] =
                {RETURN[(f # old) AND (RTOS.SameCode[old, f] = identical) AND (~f.copied)]};
              old _ RTOS.EnumerateGlobalFrames[findOriginal];
              IF old = PrincOps.NullGlobalFrame THEN ERROR};

      -- now get types and literals
    {cgfi: PrincOps.GFTIndex;
     config: PilotLoadStateFormat.ConfigIndex;
     bcd: BcdOps.BcdBase;
     [] _ plp.InputLoadState[];
     [cgfi, config] _ plp.MapRealToConfig[old.gfi];
     bcd _ plp.AcquireBcd[config];
     plp.ReleaseLoadState[];

     IF bcd.extended AND bcd.rtPages.pages # 0
      THEN -- this bcd has an RTBcd
        {rtBase: RTBcd.RTBase
                       = LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage];
         rfBase: Table.Base = LOOPHOLE[bcd + bcd.rfOffset];
         tfBase: Table.Base = LOOPHOLE[bcd + bcd.tfOffset];
         findMTH: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
               RETURNS[stop: BOOLEAN _ FALSE] =
           { IF cgfi IN [mth.gfi .. mth.gfi + mth.ngfi)  -- this is the mth for the old global frame
              THEN {WITH mth: mth SELECT FROM
                         multiple =>
                          { IF mth.refLiterals # RFNull
                             THEN {rl: RFIndex = mth.refLiterals;
                                      gfRefLiteralTable: LONG POINTER _ LONG[new+rfBase[rl].offset];
                                      oldGFRefLiteralTable: LONG POINTER
                                                _ LONG[old+rfBase[rl].offset];
                                      FOR i: NAT IN [0..rfBase[rl].length)
                                        DO LOOPHOLE[gfRefLiteralTable+i*SIZE[REF ANY],
                                                         REF REF ANY]^
                                                 _ LOOPHOLE[oldGFRefLiteralTable+i*SIZE[REF ANY],
                                                                REF REF ANY]^;
                                          --GFs are initially cleared to all NIL
                                       ENDLOOP};
                            IF mth.types # TFNull
                             THEN {t: TFIndex = mth.types;
                                      newPAT: POINTER TO ARRAY [0..0) OF Type
                                                     _ LOOPHOLE[new+tfBase[t].offset];
                                      oldPAT: POINTER TO ARRAY [0..0) OF Type
                                                     _ LOOPHOLE[old+tfBase[t].offset];
                                      Inline.COPY[from: oldPAT,
                                                    nwords: tfBase[t].length * SIZE[Type],
                                                    to: newPAT];
                                          --fill in gftype in gftshadow--
                                     };
                          };
                        ENDCASE;
                       stop _ TRUE};
           };
         IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR;
         IF BcdOps.ProcessModules[bcd, findMTH].mth = NIL THEN ERROR;
        };
    };

    [] _ RuntimeInternal.EnterGlobalFrame[new, codebase.header.info.ngfi];
    old.shared _ TRUE;
    gftShadow[new.gfi] _ gftShadow[old.gfi];
  };

  AllocGlobalFrame: PROC[old: PrincOps.GlobalFrameHandle,
                                  cp: LONG POINTER TO PrincOps.CSegPrefix]
        RETURNS[frame: PrincOps.GlobalFrameHandle, linkspace: CARDINAL] =
  { pbody: LONG POINTER = cp + CARDINAL[cp.entry[PrincOps.MainBodyIndex].initialpc];
    nlinks: CARDINAL = cp.header.info.nlinks;
    nWords: CARDINAL;
    linkspace _ IF ~old.codelinks
                   THEN nlinks + Inline.BITAND[-LOOPHOLE[nlinks, INTEGER], 3B]
                   ELSE 0;
    nWords _ (pbody - 1)^ + linkspace;
    frame _ Frame.Alloc[MakeFsi[nWords]];
    [] _ RTMicrocode.LONGZERO[LONG[frame], nWords];
  };

  MakeFsi: PROC[words: CARDINAL] RETURNS[fsi: CARDINAL] =
  { FOR fsi IN [0..PrincOps.LastAVSlot)
      DO IF PrincOps.FrameVec[fsi] >= words THEN RETURN;
     ENDLOOP;
    RETURN[words]};


--START HERE

gftShadow _ RTOS.PrivateHeapZone.NEW[GFTShadowTable _ ALL[nullType]];

AcquireBasicTypes[];

END.


Ę
ö˜Jšå
Īcœ:œ
Īk	œžœžœzžœAžœžœžœžœžœžœžœOžœ1žœŲ
žœ–
žœžœžœžœ-žœ0žœ'žœWžœœžœ
žœžœ
žœžœžœ,žœ6žœ+žœ)žœ
žœ(žœžœžœžœžœ#žœžœˆ
žœqžœžœžœ
žœyžœžœ
žœ	žœ
žœžœžœ
žœ
žœ!žœžœžœ!žœ žœžœ&žœĪnœžœ
žœžœžœOœSŸœžœ
žœjHœOœœ8žœžœ
žœ
žœ
žœžœžœ
žœ	žœ
žœ
žœ
žœ
žœžœžœ!œžœ-žœžœžœ	žœBžœžœžœ
žœ
žœžœ
žœ
žœžœ%žœEžœ
žœžœ*žœžœ
žœ+žœ
žœžœ
žœ
žœžœ
žœ
žœ5'œžœ
žœžœ0žœ
žœ
žœžœžœ)žœžœ
žœ*žœ<žœžœ
žœžœ!žœGœžœ&œ
žœžœžœžœžœžœ
žœ!œ
žœžœ
žœ-œ
žœ;žœ*žœžœ)žœžœ
žœžœ žœ{œ
žœžœžœ1žœgžœ	žœžœ
žœ
žœžœ
žœžœœ	žœžœ
žœžœMžœ
žœ7žœžœžœžœžœ8žœžœžœū
žœ+žœ2žœžœ
žœ
žœžœžœžœ
žœ
žœžœžœ
žœ
žœ
žœ
žœžœ
žœ	žœ
žœžœ
žœ
žœžœ"žœžœ
žœžœ1œ<œ
)Ÿœžœc<œžœ9žœžœžœTžœ)žœžœ
žœ%žœžœ
žœ
žœ-œžœ
žœ
žœžœžœ0žœ
žœ
žœžœžœ)žœžœ
žœ*žœ
žœžœœ;!œžœžœAžœ4žœžœ
žœžœ!žœ@œžœžœ3žœžœžœHžœ}žœžœžœžœ
žœ:œ
žœ;žœ'žœ
žœžœžœžœ
žœžœžœœžœžœ
žœžœžœžœ1.œ
œ žœ1žœ7žœcŸœžœ?žœžœžœžœ
žœ
žœ
žœžœOžœ
žœ
žœ$žœ!žœ
žœ	žœžœžœžœ
žœžœkžœ
žœ
žœlžœ0žœ'žœmžœ7žœ(žœžœ=žœžœžœ
žœ1œ
žœžœžœžœœžœžœ<žœXžœ:žœ,žœ žœœžœŸœžœ<žœ
žœTžœžœžœWžœžœ
žœžœžœžœžœžœžœžœžœ:Ÿ
œžœžœ
žœžœžœ
žœžœ
žœžœ
žœ?NŸœžœ
žœpžœžœžœ
žœ	žœ
žœ
žœ
žœ
žœžœžœ<œžœ9žœžœžœTžœ)žœžœ
žœ%žœžœ
žœ
žœ-œžœ
žœ
žœžœ%žœEžœ
žœžœ*žœžœ
žœ+žœ
žœžœ
žœ
žœžœ
žœ
žœ5'œžœ	žœ#œ%œžœžœžœžœ
žœžœOžœ<œ%œKžœžœžœžœ
žœ.œ
žœ;žœ'žœ
žœžœQœ(œ)žœ	žœ
žœ
žœ
žœžœ
žœžœIœDœœ	žœžœ
žœžœMžœ
žœ7žœžœžœžœžœžœ
œ
žœ
žœžœõ
žœ+žœLœ	žœžœ
žœžœMžœ
žœ7žœžœžœžœžœžœ
œ
žœžœDœ?œœ
žœ
žœžœG*œ
žœžœžœžœ
žœ
žœžœ	žœžœ
žœ
žœžœžœ&Pœ
œžœžœžœ	žœžœŒžœ
žœ92œ"#œ&œžœ&žœžœžœŸœžœžœ
žœžœžœ	žœ Ÿœ
œ
žœ*Qœ@Ÿœ
œ
žœ'žœ)Sœ;œžœžœ
žœ
žœdžœžœržœ
žœ
žœžœžœIžœœ2žœžœžœFžœžœžœ žœ
žœžœžœžœžœ$žœ4žœ žœ
žœ
œžœžœžœ
œ7žœXžœ4žœ(žœ<žœžœžœžœžœ",œžœžœ
žœ
žœBžœ7žœZžœ
žœžœUžœ
žœ3žœ?žœžœ
žœ@žœ
žœžœ
žœ
žœ<žœ
žœ
žœ6žœžœ
žœ
žœCžœ
žœ
žœ.'œ'žœžœ1žœHžœ
žœ
žœžœ=žœFžœ
žœ
žœžœ=žœEžœ^žœsœ^žœ žœžœ'žœ
žœžœ+žœ
žœ
žœqžœ7ŸœžœHžœ
žœ
žœžœ/žœžœ
žœžœ:žœ&žœžœ#žœžœžœ	žœžœsžœŸœžœžœžœžœžœžœ žœ
žœ!žœ
žœžœžœ
œ
žœžœžœ$žœ˜Æ´
—…—ZHeD