-- RTTSupportImpl.mesa -- Last Modified On December 21, 1982 3:05 pm by Paul Rovner DIRECTORY AMTypes USING[Error], AtomsPrivate USING[UnsafeMakeAtom], ConvertUnsafe USING[ToRope], RCMap USING[Index], RCMapOps USING[Acquire], Rope USING[ROPE], RTBasic USING[TypeIndex], RTOS USING[UnRavelUSUs], RTMiniModel USING[], -- EXPORTS only RTSymbolDefs USING[SymbolTableHandle, nullHandle, SymbolTableBase, SymbolIndex, SymbolRecordIndex, SymbolNameIndex, SymbolConstructorIndex, nullSymbolIndex, SymbolIdIndex, symbolIndexForANY, StandardSymbolContextIndex, contextLevelZero], RTSymbolOps USING[EnumerateCtxIseis, PeelAllButLast], RTSymbols USING[Outer, AcquireSTBFromMDI, AcquireSTB, ReleaseSTB], RTSymbolsPrivate USING[AcquireSTHFromSTX, GetSTHForModule], RTTypesBasic USING[Type, nullType, unspecType, listOfRefAnyType, refAnyType, anyType], RTTypesBasicPrivate USING[PTypeDesc, TypeStructure, UniqueTypeFinger, SymbolAccess, MapStiStd, STDesc, MakeNewType, MapTiTd, GetLastTypeIndex, FindCanonicalPTD, Enter, FindPTD, SymbolTableIndex, FindSTI, PreDefinedSEI], Space USING[Handle, GetHandle, WindowOrigin, GetWindow, GetAttributes, PageFromLongPointer], Strings USING[SubString, EqualSubStrings, SubStringDescriptor, AppendSubString], SymbolTable USING[SetCacheSize], TimeStamp USING[Null], TypeStrings USING[Create], UnsafeStorage USING[NewUZone]; RTTSupportImpl: PROGRAM IMPORTS AMTypes, AtomsPrivate, ConvertUnsafe, RCMapOps, RTOS, RTSymbolOps, RTSymbols, RTSymbolsPrivate, RTTypesBasicPrivate, Space, Strings, SymbolTable, TypeStrings, UnsafeStorage EXPORTS RTSymbolOps, RTSymbols = BEGIN OPEN Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, RTSymbolsPrivate, RTBasic, RTTypesBasic, RTTypesBasicPrivate; standardSTH: SymbolTableHandle _ nullHandle; typeStringZone: UNCOUNTED ZONE = UnsafeStorage.NewUZone[]; -- ***************************** -- S U P P O R T F O R T H E D E B U G G E R AcquireType: PUBLIC PROC[stb: SymbolTableBase, seIndex: SymbolIndex, canonicalize: BOOLEAN _ FALSE, rcmi: RCMap.Index _ LAST[RCMap.Index]] RETURNS[type: Type] = {inner: PROC = { ENABLE UNWIND => NULL; ptd: PTypeDesc; utf: UniqueTypeFinger; ustb: SymbolTableBase; usei: SymbolIndex; csei: SymbolConstructorIndex = stb.UnderType[seIndex]; isConsType: BOOLEAN = WITH stb.seb[seIndex] SELECT FROM id => FALSE, cons => TRUE, ENDCASE => ERROR; MakePredefinedType: PROC[preType: Type] = INLINE{utf: UniqueTypeFinger; ustb: SymbolTableBase; usei: SymbolIndex; std: STDesc; [utf, ustb, usei] _ ComputeUTF[stb, seIndex]; std _ [symbolsStamp: ustb.stHandle.version, sth: SymbolHandleFromLongPointer[ustb.stHandle]]; IF stb # ustb THEN ReleaseSTB[ustb]; IF rcmi = LAST[RCMap.Index] THEN rcmi _ RCMapOps.Acquire[stb, csei]; [] _ MakeNewType[utf, std, usei, TypeStrings.Create[stb, csei, typeStringZone], rcmi, FALSE, preType]}; IF seIndex = nullSymbolIndex THEN ERROR; IF csei = symbolIndexForANY THEN {IF MapTiTd[unspecType] = NIL THEN MakePredefinedType[unspecType]; type _ unspecType; RETURN}; IF isConsType THEN { isListOfRefAny: BOOLEAN _ FALSE; isRefAny: BOOLEAN _ FALSE; isAny: BOOLEAN _ FALSE; WITH ser: stb.seb[csei] SELECT FROM long => WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM ref => IF rse.counted THEN IF rse.list THEN NULL --someday figure out whether this is a LORA ELSE IF stb.seb[stb.UnderType[rse.refType]].typeTag = any THEN isRefAny _ TRUE; ENDCASE; any => isAny _ TRUE; -- opaque => canonicalize _ TRUE; ENDCASE; IF isListOfRefAny THEN {IF MapTiTd[listOfRefAnyType] = NIL THEN MakePredefinedType[listOfRefAnyType]; type _ listOfRefAnyType; RETURN}; IF isRefAny THEN {IF MapTiTd[refAnyType] = NIL THEN MakePredefinedType[refAnyType]; type _ refAnyType; RETURN}; IF isAny THEN {IF MapTiTd[anyType] = NIL THEN MakePredefinedType[anyType]; type _ anyType; RETURN}}; IF canonicalize THEN { ts: TypeStructure; [ptd, ts, utf] _ FindCanonicalType[stb, csei]; -- ts new storage only if ptd = NIL IF ptd # NIL THEN {type _ ptd.equivalentType; RETURN} ELSE {std: STDesc = [symbolsStamp: stb.stHandle.version, sth: SymbolHandleFromLongPointer[stb.stHandle]]; IF rcmi = LAST[RCMap.Index] THEN rcmi _ RCMapOps.Acquire[stb, csei]; type _ MakeNewType[utf, std, csei, ts, rcmi, TRUE]; RETURN}} ELSE { IF NOT isConsType THEN seIndex _ PeelAllButLast[stb, LOOPHOLE[seIndex]]; [ptd, utf, ustb, usei] _ FindUTF[stb, seIndex]; IF ptd # NIL THEN {IF stb # ustb THEN ReleaseSTB[ustb]; type _ ptd.myType; RETURN} ELSE {std: STDesc = [symbolsStamp: ustb.stHandle.version, sth: SymbolHandleFromLongPointer[ustb.stHandle]]; IF stb # ustb THEN ReleaseSTB[ustb]; IF rcmi = LAST[RCMap.Index] THEN rcmi _ RCMapOps.Acquire[stb, csei]; type _ MakeNewType[utf, std, usei, TypeStrings.Create[stb, csei, typeStringZone], rcmi]; RETURN}}}; Enter[inner]}; AcquireSequenceType: PUBLIC PROC[stb: SymbolTableBase, sei: SymbolIndex, -- of sequence part recordSTB: SymbolTableBase, recordSEIndex: SymbolRecordIndex] RETURNS[type: Type] = {inner: PROC = { ptd: PTypeDesc; utf: UniqueTypeFinger; ustb: SymbolTableBase; usei: SymbolIndex; csei: SymbolConstructorIndex = stb.UnderType[sei]; WITH s: stb.seb[csei] SELECT FROM sequence => NULL; ENDCASE => ERROR; WITH ser: stb.seb[sei] SELECT FROM id => sei _ PeelAllButLast[stb, LOOPHOLE[sei]]; ENDCASE; [ptd, utf, ustb, usei] _ FindUTF[stb, sei]; IF ptd # NIL THEN {IF stb # ustb THEN ReleaseSTB[ustb]; type _ ptd.myType} ELSE {rcmi: RCMap.Index = RCMapOps.Acquire[recordSTB, recordSEIndex]; std: STDesc = [symbolsStamp: ustb.stHandle.version, sth: SymbolHandleFromLongPointer[ustb.stHandle]]; IF stb # ustb THEN ReleaseSTB[ustb]; type _ MakeNewType [utf, std, usei, TypeStrings.Create[recordSTB, recordSEIndex, typeStringZone], rcmi]}}; Enter[inner]}; AcquireRope: PUBLIC PROC[stb: SymbolTableBase, hti: SymbolNameIndex] RETURNS[ROPE] = { a: Strings.SubStringDescriptor; s: STRING = [100]; stb.SubStringForHash[@a, hti]; s.length _ 0; Strings.AppendSubString[s, @a]; RETURN[ConvertUnsafe.ToRope[LONG[s]]]}; AcquireAtom: PUBLIC PROC[stb: SymbolTableBase, hti: SymbolNameIndex] RETURNS[atom: ATOM] = { a: Strings.SubStringDescriptor; s: STRING = [100]; stb.SubStringForHash[@a, hti]; s.length _ 0; Strings.AppendSubString[s, @a]; RETURN[AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[LONG[s]]]]}; EnumerateTypes: PROC[p: PROC[Type] RETURNS[stop: BOOLEAN]] RETURNS[stopped: BOOLEAN _ FALSE] = {FOR t: TypeIndex IN [FIRST[TypeIndex]..GetLastTypeIndex[]] DO IF p[[t]] THEN RETURN[TRUE] ENDLOOP}; GetTypeSymbols: PUBLIC PROC[type: Type] RETURNS[stb: SymbolTableBase, sei: SymbolIndex] = { moduleName: ROPE; IF type = nullType THEN ERROR AMTypes.Error[reason: typeFault, type: type]; [stb, sei, moduleName] _ DoGetTypeSymbols[type]; IF stb = NIL THEN ERROR AMTypes.Error[reason: noSymbols, msg: moduleName]}; GetOriginalTypeSymbols: PUBLIC PROC[type: Type] RETURNS[stb: SymbolTableBase, sei: SymbolIndex] = { IF type = nullType THEN ERROR AMTypes.Error[reason: typeFault, type: type]; [stb, sei,] _ DoGetTypeSymbols[type, TRUE]; IF stb = NIL THEN ERROR AMTypes.Error[reason: noSymbols]}; DoGetTypeSymbols: PROC[type: Type, originalOnly: BOOL _ FALSE] RETURNS[stb: SymbolTableBase, sei: SymbolIndex, moduleName: ROPE _ NIL] = {stInfo: SymbolAccess = MapTiTd[type].symbolAccess; sth: SymbolTableHandle _ IF originalOnly THEN nullHandle ELSE MapStiStd[stInfo.sti].sth; sei _ IF originalOnly THEN MapTiTd[type].utf.seIndex ELSE stInfo.sei; IF sth = nullHandle THEN IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI THEN -- standard symbol; any table will do {IF standardSTH # nullHandle THEN sth _ standardSTH ELSE FOR i: SymbolTableIndex IN [1..MapStiStd.length) DO IF MapStiStd[i] = NIL THEN LOOP ELSE IF MapStiStd[i].sth # nullHandle THEN {sth _ MapStiStd[i].sth; EXIT} ELSE { -- go find the symbol table bits [sth: sth, moduleName: moduleName] _ AcquireSTHFromSTX[i]; MapStiStd[i].sth _ sth; IF sth # nullHandle THEN EXIT}; -- found one. ENDLOOP; } ELSE -- go find the symbol table bits {IF originalOnly THEN sth _ GetSTHForModule [MapTiTd[type].utf.umid, NIL, NIL ! AMTypes.Error => CONTINUE] ELSE {[sth: sth, moduleName: moduleName] _ AcquireSTHFromSTX[stInfo.sti]; MapStiStd[stInfo.sti].sth _ sth; IF sth = nullHandle THEN -- try for the original defining module { std: STDesc = [symbolsStamp: MapTiTd[type].utf.umid, bcd: MapStiStd[stInfo.sti].bcd]; sei _ MapTiTd[type].utf.seIndex; IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI THEN {IF standardSTH # nullHandle THEN sth _ standardSTH ELSE FOR i: SymbolTableIndex IN [1..MapStiStd.length) DO IF MapStiStd[i] = NIL THEN LOOP ELSE IF MapStiStd[i].sth # nullHandle THEN {sth _ MapStiStd[i].sth; EXIT} ELSE { -- go find the symbol table bits [sth: sth, moduleName: moduleName] _ AcquireSTHFromSTX[i]; MapStiStd[i].sth _ sth; IF sth # nullHandle THEN EXIT}; -- found one. ENDLOOP; } ELSE [sth: sth, moduleName: moduleName] _ AcquireSTHFromSTX[FindSTI[std]]; }}; }; IF sth = nullHandle THEN stb _ NIL ELSE {IF standardSTH = nullHandle THEN standardSTH _ sth; stb _ AcquireSTB[sth]}; }; -- Creation of new runtime Type descriptors -- ts new storage only if ptd = NIL FindCanonicalType: PROC[stb: SymbolTableBase, csei: SymbolConstructorIndex] RETURNS[ptd: PTypeDesc, ts: TypeStructure, utf: UniqueTypeFinger] = { ts _ TypeStrings.Create[stb, csei, typeStringZone]; ptd _ FindCanonicalPTD[ts]; IF ptd # NIL THEN {typeStringZone.FREE[@ts]; RETURN[ptd, ptd.typeStructure, ptd.utf]} ELSE {[utf,,] _ ComputeUTF[stb, csei]; RETURN[NIL, ts, utf]}}; -- Recognize identical type previously entered -- hash map: UniqueTypeFinger -> TypeIndex FindUTF: PROC [stb: SymbolTableBase, sei: SymbolIndex] RETURNS[ptd: PTypeDesc, utf: UniqueTypeFinger, ustb: SymbolTableBase, usei: SymbolIndex] = { [utf, ustb, usei] _ ComputeUTF[stb, sei]; RETURN[FindPTD[utf], utf, ustb, usei]}; -- ComputeUTF might return a new (ustb, usei) only if sei is an SymbolIdIndex ComputeUTF: PROC [outerSTB: SymbolTableBase, sei: SymbolIndex] RETURNS[utf: UniqueTypeFinger, ustb: SymbolTableBase, usei: SymbolIndex] = INLINE BEGIN ustb _ outerSTB; usei _ sei; WITH ser: outerSTB.seb[sei] SELECT FROM id => IF ser.idCtx IN StandardSymbolContextIndex THEN utf _ [umid: TimeStamp.Null, seIndex: sei] -- a primitive type ELSE WITH ctxr: outerSTB.ctxb[ser.idCtx] SELECT FROM included => IF ctxr.level # contextLevelZero THEN utf _ [umid: outerSTB.mdb[ctxr.module].stamp, seIndex: LOOPHOLE[ser.idValue]] ELSE { inner: PROC[stb: SymbolTableBase] = { p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = { ssd1: Strings.SubStringDescriptor; ssd2: Strings.SubStringDescriptor; ss1: Strings.SubString = @ssd1; ss2: Strings.SubString = @ssd2; outerSTB.SubStringForHash[ss1, ser.hash]; stb.SubStringForHash[ss2, stb.seb[isei].hash]; IF Strings.EqualSubStrings[ss1, ss2]--stb.seb[isei].idValue = ser.idValue THEN { utf _ [umid: stb.stHandle.version, seIndex: isei]; usei _ isei; RETURN[TRUE]} ELSE RETURN[FALSE]; }; IF NOT EnumerateCtxIseis[stb: stb, ctx: ctxr.map, proc: p] THEN ERROR; }; Outer[stb: outerSTB, mdi: ctxr.module, inner: inner]; ustb _ AcquireSTBFromMDI[outerSTB, ctxr.module]; RETURN }; ENDCASE => utf _ [umid: outerSTB.stHandle.version, seIndex: sei]; cons => utf _ [umid: (IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI THEN TimeStamp.Null ELSE outerSTB.stHandle.version), -- NOTE seIndex: sei]; ENDCASE => ERROR END; SymbolHandleFromLongPointer: PROC[p: LONG POINTER] RETURNS[SymbolTableHandle] = { OPEN Space; space: Handle = RTOS.UnRavelUSUs[GetHandle[PageFromLongPointer[p]]]; window: WindowOrigin _ GetWindow[space]; sth: SymbolTableHandle _ [file: window.file, span: [base: window.base, pages: GetAttributes[space].size]]; RETURN[sth]}; -- START HERE SymbolTable.SetCacheSize[pages: 512]; END.