<> <> 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 [TypeDesc, TMapTiTd, PTypeDesc, FindSTI, TypeStructure, UniqueTypeFinger, RMapTiTd, STDesc, TMapStiStd, SymbolTableIndex, LOOPHOLEDTMapStiStd, LOOPHOLEDRMapStiStd, InitialSTIRangeSize], SafeStorage USING[TypeIndex, Type, nullType, anyType, lastPredefinedTypeIndex], UnsafeStorage USING[GetSystemUZone], StorageTraps USING[], TimeStamp USING[Null], TypeStrings USING[Code], VM USING[AddressForPageNumber, Allocate]; TypesBasicImpl: MONITOR -- protects data structures for runtime types IMPORTS AllocatorOps, Basics, RCMapOps, RTTypesBasicPrivate, UnsafeStorage, VM EXPORTS RTTypesBasicPrivate, SafeStorage, StorageTraps--CheckForNarrowRefFault, MapStiStd, MapTiTd-- = BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTSymbolDefs, RTTypesBasicPrivate, SafeStorage; -- 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, typeStructure: ""]; atomRecType: Type _ nullType; MapTiTd: PUBLIC TMapTiTd; -- table: TypeIndex -> PTypeDesc TMapTsTdl: TYPE = RECORD[SEQUENCE length: CARDINAL OF PTypeDesc]; MapTsTdl: LONG POINTER TO TMapTsTdl; < PTypeDesc>> TMapUTFTi: TYPE = RECORD[SEQUENCE length: CARDINAL OF TypeIndex]; MapUTFTi: LONG POINTER TO TMapUTFTi; < TypeIndex>> MapStiStd: PUBLIC TMapStiStd; -- EXTREMELY delicate initialization. WATCH OUT. <> InvalidType: PUBLIC ERROR[type: Type] = CODE; NarrowFault: PUBLIC ERROR = CODE; NarrowRefFault: PUBLIC ERROR[ref: REF ANY, targetType: Type] = CODE; TooManyTypes: ERROR = CODE; <> EquivalentTypes: PUBLIC SAFE PROC[t1, t2: Type] RETURNS[BOOLEAN] = TRUSTED { IF t1 = t2 THEN RETURN[TRUE]; t1 _ GetCanonicalType[t1]; t2 _ GetCanonicalType[t2]; RETURN[t1 = t2]}; <> GetCanonicalType: PUBLIC ENTRY SAFE PROC[t: Type] RETURNS[Type] = TRUSTED {ENABLE UNWIND => NULL; RETURN[DoGetCanonicalType[t]]}; NotifyAtomRecType: PUBLIC PROC[type: Type] = -- the Atom pkg is ready {atomRecType _ type}; GetLastTypeIndex: PUBLIC PROC RETURNS[TypeIndex] = -- for use by CedarProbe {RETURN[lastTypeIndex]}; <> CheckForNarrowRefFault: PUBLIC PROC[ref: REF ANY, targetType: Type] RETURNS[REF ANY] = -- used by NARROW {IF ref = NIL THEN RETURN[NIL] ELSE ERROR NarrowRefFault[ref: ref, targetType: targetType]}; GetMapTiTd: PUBLIC PROC RETURNS [LONG POINTER TO RMapTiTd] = {RETURN[MapTiTd]}; Enter: PUBLIC ENTRY PROC[inner: PROC] = {ENABLE UNWIND => NULL; inner[]}; AcquireTypeForLoader: PUBLIC ENTRY PROC [utf: UniqueTypeFinger, std: STDesc, <> <> <> sei: SymbolIndex, ts: TypeStructure, 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, CopyString[ts], rcmi, canonicalize, initializing]]}; <<***********************************>> <> <<***********************************>> 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: TypeStructure, rcmx: RCMap.Index, canonicalize: BOOLEAN _ FALSE, initializing: BOOLEAN _ FALSE, type: Type _ nullType] RETURNS[Type] = { ptd: PTypeDesc; 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, utf: utf, symbolAccess: [sti: sti, sei: sei], myType: type, typeStructure: ts]]; IF canonicalize THEN {ptd.equivalentType _ type; EnterNewCanonicalType[ptd]}; RETURN[type]}; <> 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]; <> cptd _ FindCanonicalPTD[ptd.typeStructure]; 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 <> RETURN[ptd.equivalentType]}}; EnterNewCanonicalType: INTERNAL PROC[ptd: PTypeDesc] = { probe: CARDINAL = TsHash[ptd.typeStructure]; ptd.next _ MapTsTdl[probe]; MapTsTdl[probe] _ ptd}; <> 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 <<{ double the size and chek>> <> <> <> <> <<}>> ERROR TooManyTypes; -- hash table is full 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 <<{ double the size and chek>> <> <> <> <> <<}>> ERROR TooManyTypes; -- hash table is full ENDLOOP; MapUTFTi[utfProbe] _ atomRecType; MapTiTd[LOOPHOLE[atomRecType]].utf _ utf}; < PTypeDesc>> FindCanonicalPTD: PUBLIC INTERNAL PROC[ts: TypeStructure] RETURNS[ptd: PTypeDesc] = { IF IsAtomRecTS[ts] THEN {IF atomRecType = nullType THEN ERROR; ptd _ MapTiTd[atomRecType]} ELSE {ptd _ FindEQVType[ts]}}; FindEQVType: INTERNAL PROC[ts: TypeStructure] RETURNS[PTypeDesc] = { FOR candidate: PTypeDesc _ MapTsTdl[TsHash[ts]], candidate.next UNTIL candidate = NIL DO IF EqualTS[ts, candidate.typeStructure] THEN RETURN[candidate] ENDLOOP; RETURN[NIL]}; FindPTD: PUBLIC INTERNAL PROC[utf: UniqueTypeFinger, ts: TypeStructure _ 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 <<{ double the size and chek>> <> <> <> <> <<}>> ERROR TooManyTypes; -- hash table is full ENDLOOP; IF ts # NIL AND IsAtomRecTS[ts] THEN {IF atomRecType = nullType THEN ERROR; EstablishAtomRecUTF[utf]; RETURN[MapTiTd[atomRecType]]} ELSE RETURN[NIL]}; -- end FindPTD <> TsHash: INTERNAL PROC[ts: TypeStructure] 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: TypeStructure] RETURNS[ans: BOOLEAN _ TRUE] = INLINE {RETURN[EqualStrings[ts1, ts2]]}; IsAtomRecTS: INTERNAL PROC[ts: TypeStructure] RETURNS[BOOLEAN] = INLINE {RETURN[ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]]}; 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]]}; <<*****************************>> <> 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.