///users/koo.pa/TypesBasicImplExtra.mesa
Last Modified by Richard Koo on June 28, 1984 3:51:32 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;
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];
RETURN[
IF ptd #
NIL
THEN ptd.myType
ELSE
MakeNewType[utf, std, sei, ts, rcmi, canonicalize, initializing]
];
***********************************
PRIVATE procedures
***********************************
CopyString:
PROC[s:
LONG
STRING]
RETURNS[ns:
LONG
STRING] = {
ns ← LOOPHOLE[uz.NEW[TEXT[s.length]]];
AppendString[to: ns, from: s];
};
AppendString:
PROC [to:
LONG
STRING, from:
LONG
STRING] = {
i, j, n: CARDINAL;
IF to = NIL OR from = NIL THEN RETURN;
IF from.length + to.length > to.maxlength THEN ERROR;
n ← MIN[from.length, LOOPHOLE[to.maxlength - to.length, CARDINAL]];
i ← to.length;
j ← 0;
WHILE j < n DO to[i] ← from[j]; i ← i + 1; j ← j + 1; ENDLOOP;
to.length ← i;
};
EqualStrings:
PROC[s1, s2:
LONG
STRING]
RETURNS [ans:
BOOL ←
TRUE] = {
IF s1 = NIL AND s2 = NIL THEN RETURN[TRUE];
IF s1 = NIL OR s2 = NIL OR s1.length # s2.length THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..s1.length) DO IF s1[i] # s2[i] THEN RETURN[FALSE]; ENDLOOP;
};
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, ts];
}
ELSE
ptd.equivalentType ← DoGetCanonicalType[type, ts];
RETURN[type];
};
BEWARE NOTE don't microcode this without changing InternalGetCanonicalReferentType
DoGetCanonicalType:
INTERNAL
PROC[t: Type, ts: TypeString ← ""]
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 ← FindCanonicalPTD[ts];
IF cptd =
NIL
THEN {
ptd.equivalentType ← t;
EnterNewCanonicalType[ptd, ts];
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, ts: TypeString] = {
probe: CARDINAL = TsHash[ts];
ptd.next ← MapTsTdl[probe];
MapTsTdl[probe] ← ptd;
};
here if utf is not yet registered
NewTypeIndex:
INTERNAL
PROC[utf: UniqueTypeFinger]
RETURNS[typeIndex: TypeIndex] = {
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
FindCanonicalPTD:
PUBLIC
INTERNAL
PROC[ts: TypeString]
RETURNS[ptd: PTypeDesc] = {
IF IsAtomRecTS[ts]
THEN {
IF atomRecType = nullType THEN ERROR;
ptd ← MapTiTd[atomRecType];
}
ELSE
ptd ← FindEQVType[ts];
};
FindEQVType:
INTERNAL
PROC[ts: TypeString]
RETURNS[PTypeDesc] = {
key: TypeKey = TypeStrHash [ts];
FOR candidate: PTypeDesc ← MapTsTdl[TsHash[ts]], candidate.next
UNTIL candidate =
NIL
DO IF EqualKey[key, 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
TsHash:
INTERNAL
PROC[ts: TypeString]
RETURNS[
CARDINAL] =
INLINE {
acc: CARDINAL ← 0;
FOR i:
CARDINAL
IN [0..
MIN[7, ts.length])
DO
acc ← 7*acc+LOOPHOLE[ts[i], CARDINAL];
ENDLOOP;
RETURN[acc MOD InitialTsRangeSize];
EqualTS:
INTERNAL
PROC[ts1, ts2: TypeString]
RETURNS[ans:
BOOLEAN ←
TRUE] =
INLINE { RETURN[EqualStrings[ts1, ts2]] };
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;
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.