<> <> <> <<>> DIRECTORY AllocatorOps USING [permanentPageZone], Basics USING [bytesPerWord, BITAND, BITSHIFT, LowHalf], BrandXSymbolDefs USING [PreDefinedSEI], BrandYSymbolDefs USING [PreDefinedSEI], Checksum USING [ComputeChecksum], RCMap USING [Index], RCMapOps USING [Initialize], RTSymbolDefs USING [SymbolIndex, nullSymbolIndex], RTTypesBasicPrivate USING [FindSTI, InitialSTIRangeSize, LOOPHOLEDRMapStiStd, LOOPHOLEDTMapStiStd, PTypeDesc, RMapTiTd, STDesc, SymbolTableIndex, TMapStiStd, TMapTiTd, TypeDesc, UniqueTypeFinger], SafeStorage USING [TypeIndex, Type, nullType, anyType, lastPredefinedTypeIndex], StorageTraps USING [], TimeStamp USING [Null], TypeHash USING [TypeKey, nullKey, WordPerKey], TypeStrings USING [Code, TypeString], UnsafeStorage USING [GetSystemUZone], VM USING [AddressForPageNumber, Allocate]; TypesBasicImpl: MONITOR IMPORTS AllocatorOps, Basics, Checksum, RTTypesBasicPrivate, RCMapOps, UnsafeStorage, VM EXPORTS RTTypesBasicPrivate, SafeStorage, StorageTraps, TypeHash = BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTSymbolDefs, RTTypesBasicPrivate, RTTypesBasicPrivate, RTTypesBasicPrivate, SafeStorage, TypeHash, TypeStrings; <> <<>> TypeKey: TYPE = TypeHash.TypeKey; nullKey: TypeKey = TypeHash.nullKey; KeyPtr: TYPE = LONG POINTER TO TypeKey; <> <<>> InitialTiRangeSize: CARDINAL = 10000B; <> InitialUTFRangeSize: CARDINAL = 10000B; <> InitialTsRangeSize: CARDINAL = 4000B; <> rcMapBasePages: CARDINAL = 30; <> <<>> 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; <> <<>> 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 [BOOL] = TRUSTED { IF t1 = t2 THEN RETURN [TRUE]; RETURN [GetCanonicalType[t1] = GetCanonicalType[t2]]; }; GetCanonicalType: PUBLIC ENTRY SAFE PROC [t: Type] RETURNS [Type] = TRUSTED { <> ENABLE UNWIND => NULL; RETURN [DoGetCanonicalType[t]]; }; <> NotifyAtomRecType: PUBLIC PROC [type: Type] = { atomRecType _ type}; <> GetLastTypeIndex: PUBLIC PROC RETURNS [ans: TypeIndex _ lastTypeIndex] = {}; CheckForNarrowRefFault: PUBLIC PROC [ref: REF, targetType: Type] RETURNS [REF _ NIL] = { <> IF ref # NIL THEN 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, sei: SymbolIndex, ts: TypeString, rcmi: RCMap.Index, canonicalize: BOOL _ 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 = TypeStrHash[ts]; IF EqualKey[tk, nullKey] THEN ERROR; ptd _ FindCanonicalPTDFromKey[tk]; }; <<>> <<***********************************>> <> <<***********************************>> MakeNewType: PUBLIC INTERNAL PROC [utf: UniqueTypeFinger, std: STDesc, sei: SymbolIndex, ts: TypeString, rcmx: RCMap.Index, canonicalize: BOOL _ FALSE, initializing: BOOL _ 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]; }; 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 _ 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 <> 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] = { <> 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; <> 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; <> ENDLOOP; MapUTFTi[utfProbe] _ atomRecType; MapTiTd[LOOPHOLE[atomRecType]].utf _ utf; }; < 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; <> ENDLOOP; IF ts # NIL AND IsAtomRecTS[ts] THEN { IF atomRecType = nullType THEN ERROR; EstablishAtomRecUTF[utf]; RETURN [MapTiTd[atomRecType]]; } ELSE RETURN [NIL]; }; <> IsAtomRecTS: INTERNAL PROC [ts: TypeString] RETURNS [BOOL] = { RETURN [ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]]; }; EqualKey: PROC [key1, key2: TypeKey] RETURNS [ans: BOOL _ 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[Basics.LowHalf[utf.umid.time] + LOOPHOLE[utf.seIndex, CARDINAL], 2], MapUTFTi.length-1]]; }; NextUTFProbe: INTERNAL PROC [probe: CARDINAL] RETURNS [CARDINAL] = INLINE { RETURN [Basics.BITAND[probe + 1, MapUTFTi.length-1]]; }; <> KeyAsChars: TYPE = PACKED ARRAY [0 .. CharsPerKey) OF CHAR; WordsPerKey: CARDINAL = SIZE[TypeKey]; CharsPerKey: CARDINAL = Basics.bytesPerWord*WordsPerKey; KeyAsCharsPtr: TYPE = LONG POINTER TO KeyAsChars; DoubleKey: TYPE = RECORD [key1: TypeKey, key2: TypeKey]; EndBytes: TYPE = PACKED ARRAY [0..Basics.bytesPerWord) OF CHAR; EndBytesPtr: TYPE = LONG POINTER TO EndBytes; TypeStrHash: PUBLIC PROC [ts: TypeString] RETURNS [key: TypeKey _ nullKey] = { <> chars: CARDINAL _ ts.length; ptr: LONG POINTER TO CARDINAL _ LOOPHOLE[ts+SIZE[StringBody]]; double: DoubleKey _ [nullKey, nullKey]; pos: CARDINAL _ 0; double.key1[0] _ chars+1; WHILE chars >= Basics.bytesPerWord DO mod: [0..WordsPerKey) _ pos MOD WordsPerKey; double.key2[mod] _ (ptr+pos)^; pos _ pos + SIZE[CARDINAL]; double.key1[mod] _ Checksum.ComputeChecksum[pos, WordsPerKey+1, @double.key1[mod]]; chars _ chars - Basics.bytesPerWord; ENDLOOP; IF chars # 0 THEN { endBytesPtr: EndBytesPtr _ LOOPHOLE[ptr+pos]; endBytes: EndBytes _ ALL[0C]; mod: [0..WordsPerKey) _ pos MOD WordsPerKey; FOR i: NAT IN [0..chars) DO endBytes[i] _ endBytesPtr[i]; ENDLOOP; double.key2[mod] _ LOOPHOLE[endBytes]; double.key1[mod] _ Checksum.ComputeChecksum[pos+1, WordsPerKey+1, @double+(pos MOD WordsPerKey)]; }; key _ double.key1; IF key[0] = 0 AND key[1] = 0 AND key[2] = 0 AND key[3] = 0 THEN { <> key[0] _ chars+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; atomRecString _ LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TEXT[1]]]; atomRecString.length _ 1; atomRecString[0] _ LOOPHOLE[TypeStrings.Code[atomRec]]; atomRecKey _ 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 <> <>