<> <> <> <> 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]; <> ptt: LONG POINTER TO TypeTable _ NIL; rcMapMap: RCMapOps.MapMap _ NIL; <> atomTypeChain: POINTER TO Type _ NIL; <> <> 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] = { <> 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 <> setType[gfh, LOOPHOLE[pat[mth.frameType]]]; }; }; ENDCASE; }; <> <> IF (NOT bcd.extended) OR (bcd.rtPages.pages = 0) THEN RETURN; <> 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 <> < 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 { <> rrlt[i] _ UnsafeMakeAtom[LOOPHOLE[p]] } ELSE { <> 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 { <> 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 { <> 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 = { <> rtBase: RTBcd.RTBase; -- base of RTBcd tfBase: Table.Base; -- type table part of the RTBcd <> 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 { <> (pat+i)^ _ LOOPHOLE[atomTypeChain]; atomTypeChain _ (pat+i); } ELSE (pat+i)^ _ ptt[tFrag[i]]; ENDLOOP; IF NOT mth.tableCompiled AND mth.frameRefs THEN <> BasicLoadState.SetType[gfh, LOOPHOLE[(pat+mth.frameType)^]]; }; ENDCASE; }; IF (NOT bcd.extended) OR (bcd.rtPages.pages = 0) THEN ERROR; <> 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; <> <> < 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; <> 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] = { <> rtBase: RTBcd.RTBase; rfBase: Table.Base; l: NAT; rrlt: REF RefLitTable _ NIL; doModule: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex] RETURNS [stop: BOOL _ FALSE] = { <> 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; }; <> <> atomType _ aType; RTTypesBasicPrivate.NotifyAtomRecType[atomType]; UNTIL atomTypeChain = NIL DO next: POINTER TO Type = LOOPHOLE[atomTypeChain^]; atomTypeChain^ _ atomType; atomTypeChain _ next; ENDLOOP; <> RTTypesBasicPrivate.BlessMapStiStd[]; <> rtBase _ LOOPHOLE[bcd + bcd.rtPages.relPageBase*PrincOps.wordsPerPage]; rfBase _ LOOPHOLE[bcd + bcd.rfOffset]; <> l _ rtBase[rtBase.refLitTable].length; IF l # 0 THEN { rrlt _ NEW[RefLitTable[l]]; <> <> 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]; <> 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]] <> <<(but no ATOM literals). The parts of RT.config have no ATOM>> <> ELSE LOOP; ENDLOOP; [] _ BcdOps.ProcessModules[bcd, doModule]; }; <> IF ptt # NIL THEN uz.FREE[@ptt]; IF rcMapMap = NIL THEN ERROR; uz.FREE[@rcMapMap]; { <> 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]; }; <> ProcessorFace.SetMP[MPCodes.storageInitialized]; }; RefLitTable: TYPE = RECORD [spare: NAT _ 0, refs: SEQUENCE length: NAT OF REF ANY]; <> 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]; <> gfRefTab: LONG POINTER _ LONG[gfh+ABS[offset]]; IF offset > 0 THEN { <> FOR i: NAT IN [0..rFrag.length) DO LOOPHOLE[gfRefTab+i*SIZE[REF ANY], RRA]^ _ rrlt[rFrag[i]] <> <> ENDLOOP; } ELSE { <> 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]; <> abs: NAT _ ABS[offset]; gfRefTab: LONG POINTER _ LONG[gfh+abs]; ngfRefTab: LONG POINTER _ LONG[ngfh+abs]; IF abs = offset THEN { <> 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]^; <> <> ENDLOOP; } ELSE <> 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]]]; }; <> AcquireBasicTypes[]; AllocatorOps.Initialize[]; END.