TypesBasicImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Russ Atkinson, October 23, 1984 2:46:35 pm PDT
DIRECTORY
AllocatorOps USING[permanentPageZone],
BrandXSymbolDefs USING[PreDefinedSEI],
BrandYSymbolDefs USING[PreDefinedSEI],
Basics USING[BITAND, BITSHIFT, LowHalf],
RCMap USING[Index],
RCMapOps USING[Initialize],
RTSymbolDefs USING[SymbolIndex, nullSymbolIndex],
RTTypesBasicPrivate
USING
[FindSTI, UniqueTypeFinger, STDesc, TMapStiStd, SymbolTableIndex, LOOPHOLEDTMapStiStd, LOOPHOLEDRMapStiStd, TypeDesc, TMapTiTd, PTypeDesc, RMapTiTd],
RTTypesBasicPrivateChanges USING [InitialSTIRangeSize],
SafeStorage USING[TypeIndex, Type, nullType, anyType, lastPredefinedTypeIndex],
StorageTraps USING[],
TimeStamp USING[Null],
TypeHash USING [TypeKey, nullKey, TypeStrHash, WordPerKey],
TypeStrings USING[Code, TypeString],
UnsafeStorage USING[GetSystemUZone],
VM USING[AddressForPageNumber, Allocate];
TypesBasicImpl:
MONITOR
-- protects data structures for runtime types
IMPORTS AllocatorOps, Basics, RTTypesBasicPrivate, RCMapOps, TypeHash, UnsafeStorage, VM
EXPORTS RTTypesBasicPrivate, SafeStorage, StorageTraps
= BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTSymbolDefs, RTTypesBasicPrivate, RTTypesBasicPrivate, RTTypesBasicPrivateChanges, SafeStorage, TypeHash, TypeStrings;
Constants
InitialTiRangeSize:
CARDINAL = 10000B;
a power of 2, divisible by PageSize (for MapTiTd)
InitialUTFRangeSize:
CARDINAL = 10000B;
a power of 2, divisible by PageSize (for MapUTFTi)
InitialTsRangeSize:
CARDINAL = 4000B;
a power of 2, divisible by PageSize (for MapTsTdl)
rcMapBasePages: CARDINAL = 30;
Variables
uz: UNCOUNTED ZONE ← UnsafeStorage.GetSystemUZone[];
lastTypeIndex: TypeIndex ← lastPredefinedTypeIndex;
nullTD: TypeDesc ← [utf: [umid: TimeStamp.Null, seIndex: nullSymbolIndex], symbolAccess: [], myType: nullType, typekey: nullKey];
atomRecType: Type ← nullType;
atomRecString: TypeString ← NIL;
atomRecKey: TypeKey;
TypeMap stuff
MapTiTd: PUBLIC TMapTiTd; -- table: TypeIndex -> PTypeDesc
TMapTsTdl: TYPE = RECORD[SEQUENCE length: CARDINAL OF PTypeDesc];
MapTsTdl:
LONG
POINTER
TO TMapTsTdl;
hash map: TypeStructure -> PTypeDesc
TMapUTFTi: TYPE = RECORD[SEQUENCE length: CARDINAL OF TypeIndex];
MapUTFTi:
LONG
POINTER
TO TMapUTFTi;
hash map: UniqueTypeFinger -> TypeIndex
MapStiStd: PUBLIC TMapStiStd; -- EXTREMELY delicate initialization. WATCH OUT.
ERRORs
InvalidType: PUBLIC ERROR[type: Type] = CODE;
NarrowFault: PUBLIC ERROR = CODE;
NarrowRefFault: PUBLIC ERROR[ref: REF ANY, targetType: Type] = CODE;
TooManyTypes: ERROR = CODE;
PUBLIC procedures
EquivalentTypes:
PUBLIC
SAFE
PROC[t1, t2: Type]
RETURNS[
BOOLEAN] =
TRUSTED {
IF t1 = t2 THEN RETURN[TRUE];
RETURN[GetCanonicalType[t1] = GetCanonicalType[t2]];
};
BEWARE NOTE don't microcode this without changing InternalGetCanonicalReferentType
GetCanonicalType:
PUBLIC
ENTRY
SAFE
PROC[t: Type]
RETURNS[Type] =
TRUSTED {
ENABLE UNWIND => NULL;
RETURN[DoGetCanonicalType[t]];
};
The Atom pkg is ready
NotifyAtomRecType: PUBLIC PROC[type: Type] = { atomRecType ← type};
Use by CedarProbe
GetLastTypeIndex: PUBLIC PROC RETURNS[ans: TypeIndex ← lastTypeIndex] = {};
This procedure value goes into SD and used by NARROW
CheckForNarrowRefFault:
PUBLIC
PROC[ref:
REF
ANY, targetType: Type]
RETURNS[
REF
ANY] = {
IF ref = NIL THEN RETURN[NIL]
ELSE ERROR NarrowRefFault[ref: ref, targetType: targetType];
};
GetMapTiTd: PUBLIC PROC RETURNS [ans: LONG POINTER TO RMapTiTd ← MapTiTd] = {};
Enter: PUBLIC ENTRY PROC[inner: PROC] = { ENABLE UNWIND => NULL; inner[]; };
AcquireTypeForLoader:
PUBLIC
ENTRY
PROC
[utf: UniqueTypeFinger,
std: STDesc,
std identifies original source symbolStamp,
bcd and sgi for a symbol seg that contains
below sei (entry may be copied and relocated).
sei: SymbolIndex,
ts: TypeString,
rcmi: RCMap.Index,
canonicalize: BOOLEAN ← FALSE,
initializing: BOOL ← FALSE]
RETURNS[Type] = {
ENABLE UNWIND => NULL;
ptd: PTypeDesc;
IF canonicalize THEN ptd ← FindCanonicalPTD[ts] ELSE ptd ← FindPTD[utf, ts];
IF ptd # NIL THEN RETURN [ptd.myType];
RETURN [MakeNewType[utf, std, sei, ts, rcmi, canonicalize, initializing]];
};
FindCanonicalPTD:
PUBLIC
INTERNAL
PROC[ts: TypeString]
RETURNS[ptd: PTypeDesc] = {
tk: TypeKey = TypeHash.TypeStrHash[ts];
IF EqualKey[tk, nullKey] THEN ERROR;
ptd ← FindCanonicalPTDFromKey[tk];
};
***********************************
PRIVATE procedures
***********************************
MakeNewType:
PUBLIC
INTERNAL
PROC[utf: UniqueTypeFinger,
std: STDesc,
sei: SymbolIndex,
ts: TypeString,
rcmx: RCMap.Index,
canonicalize: BOOLEAN ← FALSE,
initializing: BOOLEAN ← FALSE,
type: Type ← nullType]
RETURNS[Type] = {
ptd: PTypeDesc;
tk: TypeKey = TypeStrHash[ts];
sti: SymbolTableIndex;
IF type = nullType THEN type ← [NewTypeIndex[utf]];
sti ←
IF (
WITH sei
SELECT
FROM
t: SymbolIndex.x => LOOPHOLE[t.e, CARDINAL] IN bx.PreDefinedSEI,
t: SymbolIndex.y => LOOPHOLE[t.e, CARDINAL] IN by.PreDefinedSEI,
ENDCASE => ERROR) AND MapStiStd[1] # NIL
THEN 1
ELSE FindSTI[std, initializing];
MapTiTd[type] ← ptd ← uz.NEW [TypeDesc ← [rcmx: rcmx,
equivalentType: nullType,
utf: utf,
symbolAccess: [sti: sti, sei: sei],
myType: type,
typekey: tk]
];
IF canonicalize
THEN {
ptd.equivalentType ← type;
EnterNewCanonicalType[ptd];
}
ELSE
ptd.equivalentType ← DoGetCanonicalType[type];
RETURN[type];
};
BEWARE NOTE don't microcode this without changing InternalGetCanonicalReferentType
DoGetCanonicalType:
INTERNAL
PROC[t: Type]
RETURNS[Type] = {
cptd, ptd: PTypeDesc;
IF t <= anyType THEN RETURN[t];
ptd ← MapTiTd[t];
IF ptd.equivalentType # nullType THEN RETURN[ptd.equivalentType];
here to "canonicalize" t
cptd ← FindCanonicalPTDFromKey[ptd.typekey];
IF cptd =
NIL
THEN {
ptd.equivalentType ← t;
EnterNewCanonicalType[ptd];
RETURN[t];
}
ELSE {
ptd.equivalentType ← cptd.equivalentType;
ptd.extension ← cptd.extension; -- there can't be one already
t would have been canonicalized
RETURN[ptd.equivalentType];
};
EnterNewCanonicalType:
INTERNAL
PROC[ptd: PTypeDesc] = {
probe: CARDINAL = ptd.typekey[0] MOD InitialTsRangeSize;
ptd.next ← MapTsTdl[probe];
MapTsTdl[probe] ← ptd;
NewTypeIndex:
INTERNAL
PROC[utf: UniqueTypeFinger]
RETURNS[typeIndex: TypeIndex] = {
here if utf is not yet registered
utfProbe: CARDINAL;
nLooks: CARDINAL ← 0;
lastTypeIndex ← (typeIndex ← lastTypeIndex + 1);
IF lastTypeIndex = InitialTiRangeSize
OR lastTypeIndex =
LAST[TypeIndex]
THEN
ERROR TooManyTypes;
FOR utfProbe ← FirstUTFProbe[utf] , NextUTFProbe[utfProbe]
UNTIL MapUTFTi[utfProbe] = nullType DO
IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN ERROR TooManyTypes;
It would be nice to double the size and chek; get a new hash table; rehash; release old table and try again.
ENDLOOP;
MapUTFTi[utfProbe] ← typeIndex;
};
EstablishAtomRecUTF:
INTERNAL
PROC[utf: UniqueTypeFinger] = {
utfProbe: CARDINAL;
nLooks: CARDINAL ← 0;
FOR utfProbe ← FirstUTFProbe[utf] , NextUTFProbe[utfProbe]
UNTIL MapUTFTi[utfProbe] = nullType
DO
IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN ERROR TooManyTypes;
It would be nice to double the size and chek; get a new hash table; rehash; release old table and try again.
ENDLOOP;
MapUTFTi[utfProbe] ← atomRecType; MapTiTd[LOOPHOLE[atomRecType]].utf ← utf;
};
keep track of the canonical types. The representation is a hash map: TypeStructure -> PTypeDesc
FindCanonicalPTDFromKey:
INTERNAL
PROC[tk: TypeKey]
RETURNS[ptd: PTypeDesc] = {
IF tk = atomRecKey
THEN {
IF atomRecType = nullType THEN ERROR;
ptd ← MapTiTd[atomRecType];
}
ELSE
ptd ← FindEQVTypeFromKey[tk];
};
FindEQVTypeFromKey:
INTERNAL
PROC[tk: TypeKey]
RETURNS[PTypeDesc] = {
start: CARDINAL ← tk[0] MOD InitialTsRangeSize;
FOR candidate: PTypeDesc ← MapTsTdl[start], candidate.next
UNTIL candidate =
NIL
DO
IF EqualKey[tk, candidate.typekey] THEN RETURN[candidate];
ENDLOOP;
RETURN[NIL];
FindPTD:
PUBLIC
INTERNAL
PROC[utf: UniqueTypeFinger, ts: TypeString ←
NIL]
RETURNS[ptd: PTypeDesc] = {
utfProbe: CARDINAL;
nLooks: CARDINAL ← 0;
FOR typeIndex: TypeIndex ← MapUTFTi[utfProbe ← FirstUTFProbe[utf]],
MapUTFTi[utfProbe ← NextUTFProbe[utfProbe]] UNTIL Type[typeIndex] = nullType DO
IF MapTiTd[typeIndex].utf = utf
THEN
RETURN[MapTiTd[typeIndex]];
IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN ERROR TooManyTypes;
It would be nice to double the size and chek; get a new hash table; rehash; release old table and try again.
ENDLOOP;
IF ts #
NIL
AND IsAtomRecTS[ts]
THEN {
IF atomRecType = nullType THEN ERROR;
EstablishAtomRecUTF[utf];
RETURN[MapTiTd[atomRecType]];
} ELSE RETURN[NIL];
};
Stolen from TexHash.mesa
IsAtomRecTS:
INTERNAL
PROC[ts: TypeString]
RETURNS[
BOOLEAN] = {
RETURN[ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]];
};
EqualKey:
PROC [key1, key2: TypeKey]
RETURNS [ans:
BOOLEAN ←
TRUE] = {
FOR i:
CARDINAL
IN [0..WordPerKey)
DO
IF key1[i] # key2[i] THEN RETURN [FALSE];
ENDLOOP;
};
FirstUTFProbe:
INTERNAL
PROC[utf: UniqueTypeFinger]
RETURNS[
CARDINAL] =
INLINE {
RETURN [
Basics.BITAND[Basics.BITSHIFT[LOOPHOLE[Basics.LowHalf[utf.umid.time], CARDINAL] +
LOOPHOLE[utf.seIndex, CARDINAL], 2], MapUTFTi.length-1]
]
NextUTFProbe:
INTERNAL
PROC[probe:
CARDINAL]
RETURNS[
CARDINAL] =
INLINE { RETURN[Basics.BITAND[probe + 1, MapUTFTi.length-1]] };
*****************************
M O D U L E I N I T I A L I Z A T I O N S T A R T S H E R E
LOOPHOLE[MapStiStd, LOOPHOLEDTMapStiStd]
-- until the sun comes up.
← AllocatorOps.permanentPageZone.NEW[LOOPHOLEDRMapStiStd[InitialSTIRangeSize]];
FOR i:
CARDINAL
IN [0..InitialSTIRangeSize)
DO
LOOPHOLE[MapStiStd, LOOPHOLEDTMapStiStd][i] ← NIL;
ENDLOOP;
MapTiTd ← LOOPHOLE[AllocatorOps.permanentPageZone.NEW[RMapTiTd[InitialTiRangeSize]]];
FOR i: CARDINAL IN [0..InitialTiRangeSize) DO MapTiTd[i] ← NIL ENDLOOP;
MapTiTd[nullType] ← @nullTD;
atomRecString ← LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TEXT[1]]];
atomRecString.length ← 1;
atomRecString[0] ← LOOPHOLE[TypeStrings.Code[atomRec]];
atomRecKey ← TypeHash.TypeStrHash[atomRecString];
MapUTFTi ←
LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TMapUTFTi[InitialUTFRangeSize]]];
FOR i: CARDINAL IN [0..InitialUTFRangeSize) DO MapUTFTi[i] ← nullType ENDLOOP;
MapTsTdl ← LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TMapTsTdl[InitialTsRangeSize]]];
FOR i: CARDINAL IN [0..InitialTsRangeSize) DO MapTsTdl[i] ← NIL ENDLOOP;
RCMapOps.Initialize
[
LOOPHOLE
[VM.AddressForPageNumber[VM.Allocate[count: rcMapBasePages, in64K: TRUE].page]],
rcMapBasePages
];
END.
CHANGE
LOG
Changed by Koo on June 28, 1984 3:45:57 pm PDT:
Changes are done throughout to reflect the change of the definition of TypeDesc in RTTypesBasicPrivate. One significant change is when canonicalization is performed; now it is done when a new type is entered into MapTiTd.