-- RTLoaderImpl.Mesa
-- Last Modified On December 20, 1982 4:32 pm 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],
RCMapOps 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],
RTSD USING[SD, sLoaderAdjunct],
RTStorageOps USING[NewObject],
RTSymbols USING[nullSymbolIndex],
RTTypesBasicPrivate USING[AcquireTypeForLoader, UniqueTypeFinger],
Runtime USING[ValidateGlobalFrame],
RuntimeInternal USING[Codebase, EnterGlobalFrame],
SafeStorage USING[NewZone],
SDDefs USING[SD, sCopy, sUnNew],
Table USING[Base],
TimeStamp USING[Null, Stamp],
TypeStrings USING[Code, TypeString];

RTLoaderImpl: PROGRAM
IMPORTS AtomsPrivate, BcdOps, Frame, Inline, Loader, LongString, plp: PilotLoadStateOps,
PrincOpsRuntime, Process, RCMapOps, RTOS, RTMicrocode, RTStorageOps,
RTTypesBasicPrivate, Runtime, RuntimeInternal, SafeStorage
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;
literalsZone: ZONE;
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: RCMapOps.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 ← RCMapOps.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 ← literalsZone.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];
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: RCMapOps.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 ← RCMapOps.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: RCMapOps.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]),
ti.ut.sei];
ts: TypeStrings.TypeString ← LOOPHOLE[@rtBase[rtBase.litBase] + ti.ct.index];

IF ti.sei = RTSymbols.nullSymbolIndex THEN {ptt[i] ← nullType; LOOP};
rcmi ← RCMapOps.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: ti.sei,
ts: ts,
rcmi: rcmi,
canonicalize: ti.canonical]};
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;
literalsZone ← SafeStorage.NewZone[];
rrlt ← literalsZone.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];
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 AcquireTypesAndLiterals and CopyNew.
-- The Cedar runtime loader is ready.
IF RTSD.SD[RTSD.sLoaderAdjunct] # 0 THEN ERROR;
RTSD.SD[RTSD.sLoaderAdjunct] ← LOOPHOLE[AcquireTypesAndLiterals, CARDINAL];
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.