-- RTLoaderImpl.Mesa
-- Last Modified On July 7, 1983 10:07 am by Paul Rovner

DIRECTORY
AtomPrivate USING[UnsafeMakeAtom],
BasicLoadState USING
[ConfigID, ModuleToGlobalFrame, ConfigInfo, SetType, EnumerateConfigs,
GlobalFrameToModule, TypeCode],
BcdDefs USING
[VersionStamp, MTIndex, SGIndex, RFNull, RFIndex, TFNull, TFIndex, FTSelf,
BcdBase, MTHandle, ModuleIndex],
BcdOps USING[ProcessModules],
MPCodes USING[storageInitialized],
PrincOps USING[GlobalFrameHandle, wordsPerPage],
PrincOpsUtils USING[LongCOPY],
ProcessorFace USING[SetMP],
RCMap USING[Index, Base, invalidIndex],
RCMapOps USING[Include, MapMap, FindMapMapEntry],
RTBcd USING[AnyStamp, RTBase, StampList, TypeList, VersionID, TypeItem, RefLitItem],
RTFlags USING[takingStatistics],
RTSymbolDefs USING[nullXSymbolIndex],
RTTypesBasicPrivate USING
[AcquireTypeForLoader, UniqueTypeFinger, BlessMapStiStd, NotifyAtomRecType],
SafeStorage USING[GetPermanentZone, Type, nullType, TypeIndex],
SafeStorageOps USING[],
SafeStoragePrivate USING[NewObject, PrivateHeapZone],
Table USING[Base],
TimeStamp USING[Null, Stamp],
TypeStrings USING[Code, TypeString];

RTLoaderImpl: PROGRAM

IMPORTS AtomPrivate, BasicLoadState, BcdOps, PrincOpsUtils, ProcessorFace, RCMapOps,
RTTypesBasicPrivate, SafeStorage, SafeStoragePrivate

EXPORTS SafeStorageOps

= BEGIN OPEN AtomPrivate, BcdDefs, RTBcd, SafeStorage, SafeStoragePrivate;

-- Statistics

-- Whiz thru THIS config in the loadstate, acquiring Types.
-- This config includes SafeStoragePackage.bcd.
AcquireBasicTypes: PROC =
{rtBase: RTBcd.RTBase; -- base of RTBcd
tfBase: Table.Base; -- type table part of the RTBcd

-- foreach module in this bcd...
doModule: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOLEAN ← FALSE] =
{ gfh: PrincOps.GlobalFrameHandle = BasicLoadState.ModuleToGlobalFrame[configID, mth.gfi];
IF mth = NIL THEN ERROR;
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 BasicLoadState.SetType[gfh, LOOPHOLE[pat[mth.frameType]]];
--fill in gftype in gftshadow--
};
ENDCASE};

IF (NOT bcd.extended) OR (bcd.rtPages.pages = 0) THEN ERROR;
-- this bcd (SafeStoragePackage and friends) better have somethin' to say
rtBase ← LOOPHOLE[bcd + bcd.rtPages.relPageBase*PrincOps.wordsPerPage];
IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR RTBcdVersionMismatch;
tfBase ← LOOPHOLE[bcd + bcd.tfOffset];
IF rtBase.rcMapLength = 0 THEN ERROR;
-- this bcd (SafeStoragePackage and friends) better have somethin' to say

-- now merge the BCD's RCMap base into the rcMapBase that is maintained by CedarRuntime.
-- construct rcMapMap: (BCD rcmapx -> CedarRuntime rcmapx)
rcMapMap ← RCMapOps.Include[LOOPHOLE[@rtBase[rtBase.rcMapBase]],
rtBase.rcMapLength,
PrivateHeapZone];
ptt ← AcquireTypes[bcd, rcMapMap, TRUE];
[] ← BcdOps.ProcessModules[bcd, doModule];
}; -- end AcquireBasicTypes

AcquireTypes: PROC
[bcd: BcdDefs.BcdBase, rcMapMap: RCMapOps.MapMap, initializing: BOOLEAN ← FALSE]
RETURNS[ptt: LONG POINTER TO TypeTable ← NIL] =
{ rtBase: RTBcd.RTBase = LOOPHOLE[bcd + bcd.rtPages.relPageBase*PrincOps.wordsPerPage];
typeTable: RTBase RELATIVE POINTER TO TypeList ← rtBase.typeTable;
l: NAT ← rtBase[typeTable].length;

IF l # 0
THEN { ptt ← 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 ← RCMapOps.FindMapMapEntry[rcMapMap, LOOPHOLE[ti.rcMap]];
IF rcmi = RCMap.invalidIndex THEN ERROR;
-- to solve the atom type bootstrapping problem.
IF initializing 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: TRUE,
initializing: initializing]};
ENDLOOP}}; -- end AcquireTypes

-- Called AFTER the allocator and ATOM machinery have been initialized.
AcquireBasicLiterals: PUBLIC PROC[aType: Type] =
{rtBase: RTBcd.RTBase;
rfBase: Table.Base;
l: NAT;
RefLitTable: TYPE = RECORD[SEQUENCE length: NAT OF REF ANY];
rrlt: REF RefLitTable ← NIL;

-- foreach module found in the loadstate for this config...
doModule: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOLEAN ← FALSE] =
{ gfh: PrincOps.GlobalFrameHandle = BasicLoadState.ModuleToGlobalFrame[configID, 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};
ENDCASE};

-- START AcquireBasicLiterals here

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

-- next, finish initilizing MapStiStd
RTTypesBasicPrivate.BlessMapStiStd[];

-- next, get the BCD that contains this module (and RT.bcd)
rtBase ← LOOPHOLE[bcd + bcd.rtPages.relPageBase*PrincOps.wordsPerPage];
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
{ 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: GetPermanentZone[]];
Bump[@stats.nLiteralWords, rli.length];
PrincOpsUtils.LongCOPY[from: p, to: LOOPHOLE[rrlt[i]], nwords: rli.length]};
ENDLOOP;
[] ← BcdOps.ProcessModules[bcd, doModule];

-- 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]];
Bump[@stats.nAtoms];
Bump[@stats.nAtomPrintNameWords, rli.length]}
-- 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;
[] ← BcdOps.ProcessModules[bcd, doModule];
};

-- now cleanup after the work on this BCD
IF ptt # NIL THEN PrivateHeapZone.FREE[@ptt];
IF rcMapMap = NIL THEN ERROR;
PrivateHeapZone.FREE[@rcMapMap];

-- and foreach config except this one in the basic loadstate invoke (vanilla)
-- AcquireTypesAndLiterals.
{p: PROC[otherConfigID: BasicLoadState.ConfigID] RETURNS [BOOL] = {
IF otherConfigID # configID THEN {
moduleToGFH: PROC[mx: BcdDefs.ModuleIndex]RETURNS[PrincOps.GlobalFrameHandle] ={
RETURN[BasicLoadState.ModuleToGlobalFrame[otherConfigID, mx]];
};
setType: PROC[gfh: PrincOps.GlobalFrameHandle, type: Type] = {
BasicLoadState.SetType[gfh, LOOPHOLE[type, BasicLoadState.TypeCode]];
};
AcquireTypesAndLiterals[
bcd: BasicLoadState.ConfigInfo[otherConfigID].bcd,
moduleToGFH: moduleToGFH,
setType: setType
];
};
RETURN[FALSE];
};
[] ← BasicLoadState.EnumerateConfigs[p];
};

-- now set the maintenance panel code to indicate that SafeStorage is ready for business

ProcessorFace.SetMP[MPCodes.storageInitialized];

}; -- end AcquireBasicLiterals

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


--START HERE

END.