-- RTTypesBasicImpl.mesa -- Last Modified On January 12, 1983 4:44 pm by Paul Rovner DIRECTORY BrandXSymbolDefs USING[PreDefinedSEI], BrandYSymbolDefs USING[PreDefinedSEI], Environment USING[wordsPerPage], Inline, LongString USING[EqualStrings, AppendString], RCMap USING[Index], NewRCMapOps USING[Initialize], RTBasic USING[TypeIndex], RTOS USING[GetPermanentDataPages, PrivateHeapZone, PermanentPageZone], RTSymbolDefs USING[SymbolIndex, nullSymbolIndex], RTTypesBasicPrivate USING[TypeDesc, TMapTiTd, PTypeDesc, FindSTI, TypeStructure, UniqueTypeFinger, RMapTiTd, STDesc, MapStiStd, SymbolTableIndex], RTTypesBasic USING[Type, nullType, anyType], SafeStorage USING[], -- EXPORTS only TimeStamp USING[Null], TypeStrings USING[Code]; RTTypesBasicImpl: MONITOR -- protects data structures for runtime types IMPORTS Inline, LongString, NewRCMapOps, RTOS, RTTypesBasicPrivate EXPORTS RTTypesBasic, RTTypesBasicPrivate, SafeStorage SHARES RTTypesBasic = BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTBasic, RTSymbolDefs, RTTypesBasic, RTTypesBasicPrivate; -- 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 -- lastTypeIndex: TypeIndex _ 6; nullTD: TypeDesc _ [utf: [umid: TimeStamp.Null, seIndex: nullSymbolIndex], symbolAccess: [], myType: nullType, typeStructure: ""]; atomRecType: Type _ nullType; MapTiTd: PUBLIC TMapTiTd; -- table: TypeIndex -> PTypeDesc MapTsTdl: LONG DESCRIPTOR FOR ARRAY OF PTypeDesc; -- hash map: TypeStructure -> PTypeDesc MapUTFTi: LONG DESCRIPTOR FOR ARRAY OF TypeIndex; -- hash map: UniqueTypeFinger -> TypeIndex -- ERRORs InvalidType: PUBLIC ERROR[type: Type] = CODE; CantEstablishFinalization: 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]; t1 _ GetCanonicalType[t1]; t2 _ GetCanonicalType[t2]; RETURN[t1 = 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]]}; NotifyAtomRecType: PUBLIC PROC[type: Type] = {atomRecType _ type}; GetLastTypeIndex: PUBLIC PROC RETURNS[TypeIndex] = -- for use by CedarProbe {RETURN[lastTypeIndex]}; -- this procedure value goes into SD 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, -- 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: TypeStructure, rcmi: RCMap.Index, canonicalize: BOOLEAN _ 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]]}; -- *********************************** --PRIVATE procedures -- *********************************** CopyString: PROC[s: LONG STRING] RETURNS[ns: LONG STRING] = { ns _ LOOPHOLE[RTOS.PrivateHeapZone.NEW[TEXT[s.length]]]; LongString.AppendString[to: ns, from: s]}; MakeNewType: PUBLIC INTERNAL PROC[utf: UniqueTypeFinger, std: STDesc, sei: SymbolIndex, ts: TypeStructure, rcmx: RCMap.Index, canonicalize: 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]; MapTiTd[type] _ ptd _ RTOS.PrivateHeapZone.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]}; -- 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 _ 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 -- t would have been canonicalized RETURN[ptd.equivalentType]}}; EnterNewCanonicalType: INTERNAL PROC[ptd: PTypeDesc] = { probe: CARDINAL = TsHash[ptd.typeStructure]; 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) > LENGTH[MapUTFTi] THEN -- { double the size and chek -- Get a new hash table. -- rehash. -- release old table. -- try again -- } 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) > LENGTH[MapUTFTi] THEN -- { double the size and chek -- Get a new hash table. -- rehash. -- release old table. -- try again -- } ERROR TooManyTypes; -- hash table is full 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: 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) > LENGTH[MapUTFTi] THEN -- { double the size and chek -- Get a new hash table. -- rehash. -- release old table. -- try again -- } 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 -- stolen from TexHash.mesa 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[LongString.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 { OPEN Inline; RETURN [BITAND [BITSHIFT[LOOPHOLE[LowHalf[utf.umid.time], CARDINAL] + LOOPHOLE[utf.seIndex, CARDINAL], 2], LENGTH[MapUTFTi] - 1]]}; NextUTFProbe: INTERNAL PROC[probe: CARDINAL] RETURNS[CARDINAL] = INLINE {RETURN[Inline.BITAND[probe + 1, LENGTH[MapUTFTi] - 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 MapTiTd _ LOOPHOLE[RTOS.PermanentPageZone.NEW[RMapTiTd[InitialTiRangeSize]]]; FOR i: CARDINAL IN [0..InitialTiRangeSize) DO MapTiTd[i] _ NIL ENDLOOP; MapTiTd[nullType] _ @nullTD; MapUTFTi _ DESCRIPTOR[RTOS.GetPermanentDataPages [InitialUTFRangeSize * SIZE[TypeIndex]/Environment.wordsPerPage], InitialUTFRangeSize]; FOR i: CARDINAL IN [0..InitialUTFRangeSize) DO MapUTFTi[i] _ nullType; ENDLOOP; MapTsTdl _ DESCRIPTOR[RTOS.GetPermanentDataPages [InitialTsRangeSize * SIZE[PTypeDesc]/Environment.wordsPerPage], InitialTsRangeSize]; FOR i: CARDINAL IN [0..InitialTsRangeSize) DO MapTsTdl[i] _ NIL ENDLOOP; NewRCMapOps.Initialize[LOOPHOLE[RTOS.GetPermanentDataPages[rcMapBasePages]], rcMapBasePages, NIL]; END.