SafeStorageOpsImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Paul Rovner, June 27, 1983 11:30 am
Russ Atkinson (RRA) March 2, 1985 11:31:47 pm PST
DIRECTORY
AllocatorOps USING [Initialize, NewObject],
AtomPrivate USING [UnsafeMakeAtom],
BasicLoadState USING [ConfigID, ConfigInfo, EnumerateConfigs, GlobalFrameToModule, GlobalFrameToType, ModuleToGlobalFrame, SetType, TypeCode],
BcdDefs USING [BcdBase, FTSelf, ModuleIndex, MTHandle, MTIndex, RefLitFrag, RFIndex, RFNull, SGIndex, TFIndex, TFNull, TypeFrag, VersionStamp],
BcdOps USING [ProcessModules],
MPCodes USING [storageInitialized],
PrincOps USING [GlobalFrameHandle, wordsPerPage],
PrincOpsUtils USING [LongCopy],
ProcessorFace USING [SetMP],
RCMap USING [Base, Index, invalidIndex],
RCMapOps USING [Include, MapMap, FindMapMapEntry],
RTBcd USING [AnyStamp, RefLitItem, RTBase, StampList, TypeItem, TypeList, VersionID],
RTSymbolDefs USING [nullXSymbolIndex],
RTTypesBasicPrivate USING [AcquireTypeForLoader, BlessMapStiStd, NotifyAtomRecType, UniqueTypeFinger],
SafeStorage USING [GetPermanentZone, nullType, Type, TypeIndex],
SafeStorageOps USING [],
Table USING [Base],
TimeStamp USING [Null, Stamp],
TypeStrings USING [Code, TypeString],
UnsafeStorage USING [GetSystemUZone];
SafeStorageOpsImpl: PROGRAM
IMPORTS AllocatorOps, AtomPrivate, BasicLoadState, BcdOps, PrincOpsUtils, ProcessorFace, RCMapOps, RTTypesBasicPrivate, SafeStorage, UnsafeStorage
EXPORTS SafeStorageOps
= BEGIN OPEN AtomPrivate, BcdDefs, RTBcd, SafeStorage;
RTBcdVersionMismatch: ERROR = CODE;
uz: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];
configID: BasicLoadState.ConfigID
= BasicLoadState.GlobalFrameToModule[LOOPHOLE[SafeStorageOpsImpl]].config;
bcd: BcdDefs.BcdBase = BasicLoadState.ConfigInfo[configID].bcd;
atomType: Type ← nullType; -- the concrete type code for ATOM referents
TypeTable: TYPE = RECORD[SEQUENCE length: NAT OF Type];
TypeArray: TYPE = LONG POINTER TO TypeArrayRep;
TypeArrayRep: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF Type];
stuff used during CedarRuntime initialization
ptt: LONG POINTER TO TypeTable ← NIL;
rcMapMap: RCMapOps.MapMap ← NIL;
communication between AcquireBasicTypes and AcquireBasicLiterals
atomTypeChain: POINTER TO Type ← NIL;
NOTE assume TypeTable entry in gf is 1 word
this threads thru ATOM referent types in global frame type tables until atomType is known
GetGFRCType: PUBLIC PROC [gfh: PrincOps.GlobalFrameHandle] RETURNS [Type] = {
RETURN[LOOPHOLE[BasicLoadState.GlobalFrameToType[gfh], Type]];
};
AcquireTypesAndLiterals: PUBLIC PROC [bcd: BcdDefs.BcdBase, moduleToGFH: PROC [BcdDefs.ModuleIndex] RETURNS [PrincOps.GlobalFrameHandle], setType: PROC [PrincOps.GlobalFrameHandle, SafeStorage.Type]] = {
... is 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.
rtBase: RTBcd.RTBase;
rfBase, tfBase: Table.Base;
l: NAT;
ptrTypeTable: LONG POINTER TO TypeTable ← NIL;
rrlt: REF RefLitTable ← NIL;
rcmm: RCMapOps.MapMap ← NIL;
doModule: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex] RETURNS [stop: BOOL ← FALSE] = {
foreach module in this bcd...
WITH mth: mth SELECT FROM
multiple => {
gfh: PrincOps.GlobalFrameHandle = moduleToGFH[mth.gfi];
InternalAssignLiterals[gfh, rrlt, rfBase, mth.refLiterals];
IF mth.types # TFNull THEN {
tFrag: LONG POINTER TO BcdDefs.TypeFrag ← @tfBase[mth.types];
pat: TypeArray ← LOOPHOLE[LONG[gfh+tFrag.offset]];
FOR i: NAT IN [0..tFrag.length) DO
pat[i] ← ptrTypeTable[tFrag[i]]
ENDLOOP;
IF NOT mth.tableCompiled AND mth.frameRefs THEN
fill in gftype in gftshadow
setType[gfh, LOOPHOLE[pat[mth.frameType]]];
};
};
ENDCASE;
};
START AcquireTypesAndLiterals HERE
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.
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*PrincOps.wordsPerPage];
IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR RTBcdVersionMismatch;
rfBase ← LOOPHOLE[bcd + bcd.rfOffset];
tfBase ← LOOPHOLE[bcd + bcd.tfOffset];
IF rtBase.rcMapLength # 0 THEN
now merge the BCD's RCMap base into the rcMapBase that is maintained by RT.
construct rcmm: (BCD rcmapx -> RT rcmapx)
rcmm ← RCMapOps.Include[LOOPHOLE[@rtBase[rtBase.rcMapBase]], rtBase.rcMapLength, uz];
ptrTypeTable ← AcquireTypes[bcd, rcmm];
l ← rtBase[rtBase.refLitTable].length;
IF l # 0 THEN {
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 {
Make a new atom from the pointer. The allocation will happen inside of UnsafeMakeAtom.
rrlt[i] ← UnsafeMakeAtom[LOOPHOLE[p]]
}
ELSE {
Allocate the literal and copy its contents.
rrlt[i] ← AllocatorOps.NewObject[type: ptrTypeTable[rli.referentType], size: rli.length, zone: GetPermanentZone[]];
PrincOpsUtils.LongCopy[from: p, to: LOOPHOLE[rrlt[i]], nwords: rli.length];
};
ENDLOOP;
};
[] ← BcdOps.ProcessModules[bcd, doModule];
IF ptrTypeTable # NIL THEN uz.FREE[@ptrTypeTable];
IF rcmm # NIL THEN uz.FREE[@rcmm];
};
CopyTypesAndLiterals: PUBLIC PROC [bcd: BcdDefs.BcdBase, mi: BcdDefs.ModuleIndex, old, new: PrincOps.GlobalFrameHandle] = {
IF bcd.extended AND bcd.rtPages.pages # 0 THEN {
this bcd has an RTBcd
rtBase: RTBcd.RTBase = LOOPHOLE[bcd + bcd.rtPages.relPageBase*PrincOps.wordsPerPage];
rfBase: Table.Base = LOOPHOLE[bcd + bcd.rfOffset];
tfBase: Table.Base = LOOPHOLE[bcd + bcd.tfOffset];
findMTH: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex] RETURNS [stop: BOOL ← FALSE] = {
IF mi IN [mth.gfi .. mth.gfi + mth.ngfi) THEN {
this is the mth for the old global frame
WITH mth: mth SELECT FROM
multiple => {
InternalCopyLiterals[old, new, rfBase, mth.refLiterals];
IF mth.types # BcdDefs.TFNull THEN {
t: BcdDefs.TFIndex = mth.types;
offset: CARDINAL = tfBase[t].offset;
PrincOpsUtils.LongCopy[
from: LOOPHOLE[LONG[old]+offset],
nwords: tfBase[t].length * SIZE[SafeStorage.Type],
to: LOOPHOLE[LONG[new]+offset]
];
};
};
ENDCASE;
stop ← TRUE;
};
};
IF rtBase.versionIdent # RTBcd.VersionID THEN ERROR;
IF BcdOps.ProcessModules[bcd, findMTH].mth = NIL THEN ERROR;
}; -- end IF bcd.extended AND bcd.rtPages.pages # 0
};
AcquireBasicTypes: PROC = {
Whiz thru THIS config in the loadstate, acquiring Types. This config includes SafeStoragePackage.bcd.
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: BOOL ← 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 {
tFrag: LONG POINTER TO BcdDefs.TypeFrag ← @tfBase[mth.types];
pat: POINTER TO Type ← LOOPHOLE[gfh+tFrag.offset];
FOR i: NAT IN [0..tFrag.length) DO
IF ptt[tFrag[i]] = LAST[TypeIndex]
THEN {
special case for ATOMs ... link this into atomTypeChain.
(pat+i)^ ← LOOPHOLE[atomTypeChain];
atomTypeChain ← (pat+i);
}
ELSE (pat+i)^ ← ptt[tFrag[i]];
ENDLOOP;
IF NOT mth.tableCompiled AND mth.frameRefs THEN
fill in gftype in gftshadow
BasicLoadState.SetType[gfh, LOOPHOLE[(pat+mth.frameType)^]];
};
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, uz];
ptt ← AcquireTypes[bcd, rcMapMap, TRUE];
[] ← BcdOps.ProcessModules[bcd, doModule];
};
AcquireTypes: PROC [bcd: BcdDefs.BcdBase, rcMapMap: RCMapOps.MapMap, initializing: BOOL ← 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 ← uz.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;
};
};
AcquireBasicLiterals: PUBLIC PROC [aType: Type] = {
Called AFTER the allocator and ATOM machinery have been initialized.
rtBase: RTBcd.RTBase;
rfBase: Table.Base;
l: NAT;
rrlt: REF RefLitTable ← NIL;
doModule: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex] RETURNS [stop: BOOL ← FALSE] = {
foreach module found in the loadstate for this config...
IF mth = NIL THEN ERROR;
WITH mth: mth SELECT FROM
multiple => {
gfh: PrincOps.GlobalFrameHandle = BasicLoadState.ModuleToGlobalFrame[configID, mth.gfi];
InternalAssignLiterals[gfh, rrlt, rfBase, mth.refLiterals];
};
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 SafeStorageOpsImpl 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] ← AllocatorOps.NewObject[type: ptt[rli.referentType],
size: rli.length,
zone: GetPermanentZone[]];
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]]
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 uz.FREE[@ptt];
IF rcMapMap = NIL THEN ERROR;
uz.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];
};
RefLitTable: TYPE = RECORD [spare: NAT ← 0, refs: SEQUENCE length: NAT OF REF ANY];
RRA: The spare is not used, but it present to get the REFs on even-word boundaries. The compiler knows that the references start at word 2, so don't change this!
RRA: TYPE = REF REF ANY;
InternalAssignLiterals: PROC [gfh: PrincOps.GlobalFrameHandle, rrlt: REF RefLitTable, rfBase: Table.Base, rl: RFIndex] = {
IF rl # RFNull THEN {
rFrag: LONG POINTER TO BcdDefs.RefLitFrag ← @rfBase[rl];
offset: INTEGER ← LOOPHOLE[rFrag.offset, INTEGER];
This used to be a CARDINAL, but we now use it to determine whether we load the literal into the global frame (positive) or into the indirect slot (negative).
gfRefTab: LONG POINTER ← LONG[gfh+ABS[offset]];
IF offset > 0
THEN {
Do it the old way, which puts the references into the global frame.
FOR i: NAT IN [0..rFrag.length) DO
LOOPHOLE[gfRefTab+i*SIZE[REF ANY], RRA]^ ← rrlt[rFrag[i]]
the destination address isn't really a REF, but we need to make the compiler think so in order to increment the reference count correctly.
GFs are initially cleared to all NIL, so this assignment is OK
ENDLOOP;
}
ELSE {
Do it the new way, which is to use indirection. The offset tells us where to put the indirect chunk in the global frame, and we put the literal references in the indirect chunk. This is the way it always should have been done!
refFrag: REF RefLitTable ← NEW[RefLitTable[rFrag.length]];
FOR i: NAT IN [0..rFrag.length) DO
refFrag[i] ← rrlt[rFrag[i]]
ENDLOOP;
LOOPHOLE[gfRefTab, RRA]^ ← refFrag;
};
};
};
InternalCopyLiterals: PROC [gfh, ngfh: PrincOps.GlobalFrameHandle, rfBase: Table.Base, rl: RFIndex] = {
IF rl # RFNull THEN {
rFrag: LONG POINTER TO BcdDefs.RefLitFrag ← @rfBase[rl];
offset: INTEGER ← LOOPHOLE[rFrag.offset, INTEGER];
This used to be a CARDINAL, but we now use it to determine whether we load the literal into the global frame (positive) or into the indirect slot (negative).
abs: NAT ← ABS[offset];
gfRefTab: LONG POINTER ← LONG[gfh+abs];
ngfRefTab: LONG POINTER ← LONG[ngfh+abs];
IF abs = offset
THEN {
Do it the old way, which gets the references from the global frame.
refFrag: REF RefLitTable ← NEW[RefLitTable[rFrag.length]];
FOR i: NAT IN [0..rFrag.length) DO
delta: CARDINAL = i*SIZE[REF ANY];
LOOPHOLE[ngfRefTab+delta, RRA]^ ← LOOPHOLE[gfRefTab+delta, RRA]^;
the addresses are not really REFs, but we need to make the compiler think so;
GFs are initially cleared to all NIL, so this assignment is OK
ENDLOOP;
}
ELSE
The literals for the frame are already in the right form, and are at the given slot.
LOOPHOLE[ngfRefTab, REF REF ANY]^ ← LOOPHOLE[gfRefTab, REF REF ANY]^;
};
};
IsAtomRecTS: PROC [ts: TypeStrings.TypeString] RETURNS [BOOL] = {
RETURN[ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]];
};
START HERE
AcquireBasicTypes[];
AllocatorOps.Initialize[];
END.