-- RTTypesImpl.Mesa -- Paul Rovner, December 21, 1982 9:13 am -- NOTE do Equal, AsGoodAs -- try to avoid acquisition of already acquired symbol tables -- status stuff is wrong. DIRECTORY AMBridge USING [SetTVFromLC, SetTVFromLI, TVForReferent], AMTypes USING[Class, Index, Status, TypedVariable, ErrorReason, New], Environment USING[bitsPerWord], Rope USING [ROPE, Equal, Text], RTBasic USING [nullType], RTCommon USING [ShortenLongCardinal], RTStorageOps USING[NewObject], RTSymbols USING [EnumerateCtxIseis, EnumerateRecordIseis, CountComponents, AcquireType, AcquireSequenceType, AcquireRope, GetTypeSymbols, GetOriginalTypeSymbols, SymbolTableBase, ReleaseSTB, STBToModuleName, SymbolConstructorIndex, SymbolContextIndex, SymbolIdIndex, SymbolModuleIndex, SymbolRecordIndex, SymbolIndex, nullSymbolIndex, symbolIndexForANY, StandardSymbolContextIndex, thisModuleIndex, typeCodeForINT, typeCodeForCHAR], RTTCache USING[RefEntry, LookupRef, FillRefEntry, IntEntry, LookupInt, FillIntEntry, ComponentMap, NewComponentMap, FillTypeComponent, FillNameComponent, GetComponentAtIndex, GetComponentForName, ComponentEntry], RTTypesBasic USING[Type, unspecType, nullType, fhType, gfhType, GetCanonicalType, listOfRefAnyType, refAnyType, anyType], RTTypesPrivate USING[GetTVZones]; RTTypesImpl: PROGRAM IMPORTS AMBridge, AMTypes, Rope, RTCommon, RTStorageOps, RTSymbols, RTTCache, RTTypesBasic, RTTypesPrivate EXPORTS AMTypes, RTTypesPrivate = BEGIN OPEN AMBridge, AMTypes, Environment, Rope, RTTypesPrivate, RTTypesBasic, RTSymbols, RTStorageOps; -- T Y P E S BitsForTypeInfo: TYPE = RECORD [bft: LONG CARDINAL, argumentRecord, interfaceRecord: BOOLEAN]; -- must be the same as the return type of BitsForType -- C O N S T A N T S tvqZone: ZONE = GetTVZones[].qz; tvpZone: ZONE = GetTVZones[].pz; -- E R R O R Error: PUBLIC ERROR[ reason: ErrorReason, msg: ROPE _ NIL, type: Type _ RTBasic.nullType,-- used with TypeFault, IncompatibleTypes otherType: Type _ RTBasic.nullType -- used with IncompatibleTypes ] = CODE; -- P U B L I C P R O C E D U R E S -- MOVE BitsForType: PUBLIC PROC[type: Type] RETURNS [bft: LONG CARDINAL, argumentRecord, interfaceRecord: BOOLEAN] = {stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.RefEntry; info: REF BitsForTypeInfo; IF type = nullType THEN RETURN[2*bitsPerWord, FALSE, FALSE]; -- NIL entry _ RTTCache.LookupRef[type, LOOPHOLE[BitsForType]]; info _ NARROW[entry.ref]; IF info # NIL THEN RETURN [info.bft, info.argumentRecord, info.interfaceRecord]; [stb, sei] _ GetTypeSymbols[type]; {ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex = stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM record => {w: LONG CARDINAL = stb.WordsForType[csei]; argumentRecord _ ser.argument; interfaceRecord _ FALSE; IF w > 1 THEN bft _ w * bitsPerWord ELSE bft _ stb.BitsForType[csei]}; definition => {ans: CARDINAL _ 0; proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = {IF NOT stb.seb[isei].constant THEN ans _ MAX[ans, stb.seb[isei].idValue]; RETURN[FALSE]}; [] _ EnumerateCtxIseis[stb, ser.defCtx, proc]; argumentRecord _ FALSE; interfaceRecord _ TRUE; bft _ (ans + 1)*bitsPerWord}; ENDCASE => {w: LONG CARDINAL = stb.WordsForType[csei]; argumentRecord _ FALSE; interfaceRecord _ FALSE; IF w > 1 THEN bft _ w * bitsPerWord ELSE bft _ stb.BitsForType[csei]; IF bft = 0 THEN ERROR Error[reason: typeFault, type: type]}; ReleaseSTB[stb]}; -- end ENABLE UNWIND info _ tvpZone.NEW[BitsForTypeInfo _ [bft, argumentRecord, interfaceRecord]]; [] _ RTTCache.FillRefEntry[entry, info]; }; -- end BitsForType -- These procedures are applicable to all types. -- max for unions -- Could overflow! -- MOVE Size: PUBLIC SAFE PROC[type: Type, length: CARDINAL _ 0--for sequence-containing records--] RETURNS[ans: CARDINAL _ 0 --number of words--] = TRUSTED {stb: SymbolTableBase; uType: Type = UnderType[type]; csei: SymbolConstructorIndex; sei: SymbolIndex; entry: RTTCache.IntEntry _ NIL; int: INT; IF type = nullType THEN RETURN[2]; SELECT type FROM fhType, gfhType => ERROR Error[reason: typeFault, type: type]; ENDCASE; IF length = 0 THEN {entry _ RTTCache.LookupInt[type, Size]; int _ entry.int; IF int >= 0 THEN RETURN [int]}; [stb, sei] _ GetTypeSymbols[type]; {ENABLE UNWIND => ReleaseSTB[stb]; csei _ stb.UnderType[sei]; -- check for argument records and interface records WITH ser: stb.seb[csei] SELECT FROM record => IF ser.argument THEN { FOR isei: SymbolIdIndex _ stb.FirstCtxSe[ser.fieldCtx], stb.NextSe[isei] UNTIL isei = nullSymbolIndex DO ans _ MAX[ans, stb.FnField[isei].offset.wd*bitsPerWord + stb.seb[isei].idInfo] ENDLOOP; ReleaseSTB[stb]; ans _ ans/bitsPerWord + (IF ans MOD bitsPerWord # 0 THEN 1 ELSE 0); IF entry # NIL THEN [] _ RTTCache.FillIntEntry[entry, ans]; RETURN[ans]}; definition => {proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = {IF stb.LinkMode[isei] # manifest THEN ans _ MAX[ans, stb.seb[isei].idValue]; RETURN[FALSE]}; [] _ EnumerateCtxIseis[stb, ser.defCtx, proc]; ReleaseSTB[stb]; ans _ ans + 1; IF entry # NIL THEN [] _ RTTCache.FillIntEntry[entry, ans]; RETURN[ans]}; ENDCASE; -- not argument record or interface record SELECT TypeClass[uType] FROM union, sequence=> ERROR Error[reason: typeFault, type: type]; record, structure => {sType: Type; sClass: Class; [v: sType, c: sClass] _ VariableType[uType]; SELECT sClass FROM sequence=> {sstb: SymbolTableBase; ssei: SymbolIndex; [sstb, ssei] _ GetTypeSymbols[sType]; {ENABLE UNWIND => ReleaseSTB[sstb]; scsei: SymbolConstructorIndex = sstb.UnderType[ssei]; WITH ser: sstb.seb[scsei] SELECT FROM sequence => {bpe: LONG CARDINAL = sstb.BitsPerElement[type: ser.componentType, packed: ser.packed]; ans _ RTCommon.ShortenLongCardinal[(bpe*length+bitsPerWord-1)/bitsPerWord]}; ENDCASE=>ERROR; ReleaseSTB[sstb]}}; ENDCASE}; ENDCASE; ans _ ans + stb.WordsForType[csei]; ReleaseSTB[stb]}; -- end ENABLE UNWIND IF entry # NIL THEN [] _ RTTCache.FillIntEntry[entry, ans]; }; -- end Size -- the Type itself is the color. Record and enumerated types are painted. IsPainted: PUBLIC SAFE PROC[type: Type] RETURNS[ans: BOOLEAN] = TRUSTED { RETURN[SELECT TypeClass[UnderType[type]] FROM enumerated, record => TRUE, ENDCASE => FALSE]}; -- MOVE TypeClass: PUBLIC SAFE PROC[type: Type] RETURNS[ans: Class] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.IntEntry; int: INT; SELECT type FROM fhType => RETURN[localFrame]; nullType => RETURN[nil]; gfhType => RETURN[globalFrame]; unspecType => RETURN[unspecified]; ENDCASE; entry _ RTTCache.LookupInt[type, TypeClass]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; IF stb.seb[sei].seTag = id THEN {ans _ definition; GO TO answer}; IF GetCanonicalType[type] = GetCanonicalType[CODE[ROPE]] OR GetCanonicalType[type] = GetCanonicalType[CODE[Text]] THEN {ans _ rope; GO TO answer}; ans _ (WITH ser: stb.seb[csei] SELECT FROM basic => SelectBasicClass[ser.code], record => (IF ser.painted THEN record ELSE structure), definition => record, real => real, union => union, array => array, opaque => opaque, sequence => sequence, relative => relativePointer, ref => (IF ser.counted OR ser.basing THEN ERROR ELSE pointer), arraydesc => descriptor, long => (WITH rse: stb.seb[stb.UnderType[ser.rangeType] ] SELECT FROM ref => (IF rse.counted THEN (IF rse.list THEN list ELSE WITH t: stb.seb[stb.UnderType[rse.refType]] SELECT FROM opaque => IF stb.seb[t.id].idCtx IN StandardSymbolContextIndex THEN atom ELSE ref ENDCASE => ref) ELSE (IF rse.basing THEN basePointer ELSE longPointer)), basic => (IF rse.code = typeCodeForINT THEN longInteger ELSE ERROR), arraydesc => longDescriptor, subrange => (WITH rrse: stb.seb[stb.UnderType[rse.rangeType] ] SELECT FROM basic => (IF rrse.code = typeCodeForINT AND rse.origin = 0 AND rse.range = LAST[CARDINAL] THEN longCardinal ELSE ERROR), ENDCASE => ERROR), ENDCASE => ERROR), enumerated => enumerated, subrange => (WITH rse: stb.seb[stb.UnderType[ser.rangeType] ] SELECT FROM basic => (IF rse.code = typeCodeForINT AND ser.origin = 0 AND ser.range = LAST[CARDINAL] THEN cardinal ELSE subrange), ENDCASE => subrange), subrange => subrange, transfer => (SELECT ser.mode FROM proc => procedure, port => port, signal => signal, error => error, process => process, program => program, ENDCASE => ERROR), zone => (IF ser.counted THEN countedZone ELSE uncountedZone), mode => type, any => any, ENDCASE => ERROR Error[reason: typeFault, type: type]); ReleaseSTB[stb]; EXITS answer => ReleaseSTB[stb]}; [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]; }; -- end TypeClass -- These procedures have applicability restrictions, noted as comments -- MOVE NComponents: PUBLIC SAFE PROC[type: Type--record, structure--] RETURNS [ans: Index] = TRUSTED { entry: RTTCache.IntEntry; int: INT; IF type = nullType THEN RETURN[0]; entry _ RTTCache.LookupInt[type, NComponents]; int _ entry.int; IF int >= 0 THEN RETURN [int]; {stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM record => ans _ CountComponents[stb, LOOPHOLE[csei]]; definition => {proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = {ans _ ans + 1; RETURN[FALSE]}; ans _ 0; [] _ EnumerateCtxIseis[stb, ser.defCtx, proc]}; ENDCASE => ERROR Error[reason: typeFault, type: type]}; ReleaseSTB[stb]}; [] _ RTTCache.FillIntEntry[entry, ans]; }; VariableType: PUBLIC SAFE PROC[type: Type] RETURNS [v: Type, c: Class] = TRUSTED {type _ UnderType[type]; IF TypeClass[type] # record AND TypeClass[type] # structure THEN RETURN[v: nullType, c: nil]; {nc: Index = NComponents[type]; IF nc = 0 THEN RETURN[v: nullType, c: nil]; v _ UnderType[IndexToType[type, nc]]}; c _ TypeClass[v]; SELECT c FROM union, sequence => RETURN; ENDCASE => RETURN[v: nullType, c: nil]; }; -- This returns the Type of the specified component of -- instances of the type. index starts at 1. -- break up and MOVE IndexToType: PUBLIC SAFE PROC[type: Type--record, structure, union--, index: Index] RETURNS[ans: Type] = TRUSTED { proc1: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = { ans _ IF index = 0 THEN AcquireType[stb, stb.seb[isei].idType] ELSE AcquireType[stb, stb.seb[isei].idInfo]}; proc2: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = { sei: SymbolIndex _ stb.seb[isei].idType; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH cse: stb.seb[csei] SELECT FROM sequence => {recstb: SymbolTableBase; recsei: SymbolIndex; [recstb, recsei] _ GetTypeSymbols[type]; ans _ AcquireSequenceType[stb, sei, recstb, LOOPHOLE[recstb.UnderType[recsei]] ! UNWIND => ReleaseSTB[recstb]]; ReleaseSTB[recstb]}; ref => {IF cse.var THEN sei _ cse.refType; ans _ AcquireType[stb, sei]}; ENDCASE => ans _ AcquireType[stb, sei]; }; entry: RTTCache.RefEntry; map: RTTCache.ComponentMap; class: Class; n: NAT _ 0; type _ UnderType[type]; class _ TypeClass[type]; SELECT class FROM record, structure => n _ NComponents[type]; union => n _ 0; ENDCASE => ERROR Error[reason: typeFault, type: type]; entry _ RTTCache.LookupRef[type, IndexToType]; map _ NARROW[entry.ref, RTTCache.ComponentMap]; IF map # NIL AND index IN [1..map.len] AND map[index-1].validType THEN RETURN [map[index-1].type]; SELECT class FROM record, structure => RecordComponentISEI[type, index, proc2]; union => ComponentISEI[type, index, proc1]; ENDCASE => ERROR Error[reason: typeFault, type: type]; IF n > 0 AND index IN [1..n] THEN {-- put the answer back into the cache IF map = NIL THEN [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]]; [] _ RTTCache.FillTypeComponent[map, index-1, ans]}; }; -- This returns the Status of the specified component of -- instances of the type. index starts at 1. -- MOVE IndexToStatus: PUBLIC PROC[type: Type--record, structure--, index: Index] RETURNS[ans: Status] = { proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {ans _ (IF stb.seb[isei].immutable THEN readOnly ELSE IF stb.seb[isei].constant THEN const ELSE mutable)}; RecordComponentISEI[type, index, proc]}; -- index starts at 1 -- raises typeFault, badName -- break up and MOVE NameToIndex: PUBLIC SAFE PROC [type: Type--record, structure, union, enumerated--, name: ROPE] RETURNS[ans: CARDINAL _ 0] = TRUSTED { enumerated: BOOLEAN _ FALSE; stb: SymbolTableBase; sei: SymbolIndex; class: Class; n: INT _ 0; found: BOOL _ FALSE; entry: RTTCache.RefEntry; map: RTTCache.ComponentMap; proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = {IF enumerated THEN ans _ stb.seb[isei].idValue + 1 ELSE ans _ ans + 1; stop _ Equal[name, AcquireRope[stb, stb.seb[isei].hash]]}; type _ UnderType[type]; class _ TypeClass[type]; SELECT class FROM record, structure => n _ NComponents[type]; enumerated => n _ NValues[type]; ENDCASE; IF n IN [1..256) THEN {entry _ RTTCache.LookupRef[type, IndexToType]; map _ NARROW[entry.ref, RTTCache.ComponentMap]; IF map # NIL THEN {int: INT _ RTTCache.GetComponentForName[map, name].index; IF int >= 0 THEN RETURN [int+1]}}; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM record => found _ EnumerateRecordIseis[stb, LOOPHOLE[csei, SymbolRecordIndex], proc]; definition => found _ EnumerateCtxIseis[stb, ser.defCtx, proc]; union => found _ EnumerateCtxIseis[stb, ser.caseCtx, proc]; enumerated => {enumerated _ TRUE; found _ EnumerateCtxIseis[stb, ser.valueCtx, proc]}; ENDCASE => ERROR Error[reason: typeFault, type: type]; }; ReleaseSTB[stb]; IF NOT found THEN ERROR Error[reason: badName, type: type, msg: name]; IF ans > 0 AND n IN [1..256) THEN {IF map = NIL THEN [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]]; [] _ RTTCache.FillNameComponent[map, ans-1, name]}; }; -- end NameToIndex -- break up and MOVE IndexToName: PUBLIC SAFE PROC[type: Type--record, structure, union, enumerated--, index: CARDINAL] RETURNS[ans: ROPE] = TRUSTED {proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {ans _ AcquireRope[stb, stb.seb[isei].hash]}; n: INT _ 0; class: Class; entry: RTTCache.RefEntry; map: RTTCache.ComponentMap _ NIL; type _ UnderType[type]; class _ TypeClass[type]; SELECT class FROM record, structure => n _ NComponents[type]; enumerated => n _ NValues[type]; ENDCASE; IF n IN [1..256) THEN {entry _ RTTCache.LookupRef[type, IndexToType]; map _ NARROW[entry.ref, RTTCache.ComponentMap]; IF map = NIL THEN [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]]; IF index IN [1..map.len] THEN {comp: RTTCache.ComponentEntry _ RTTCache.GetComponentAtIndex[map, index-1]; IF comp.validName THEN RETURN [comp.name]}; }; SELECT class FROM record, structure => RecordComponentISEI[type, index, proc]; union, enumerated => ComponentISEI[type, index, proc]; ENDCASE => ERROR Error[reason: typeFault, type: type]; IF map # NIL THEN [] _ RTTCache.FillNameComponent[map, index-1, ans]; }; -- MOVE IsPacked: PUBLIC SAFE PROC[type: Type--array, sequence--] RETURNS [ans: BOOLEAN] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM array => ans _ ser.packed; sequence => ans _ ser.packed; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]; }}; -- break up and MOVE IsOverlaid: PUBLIC SAFE PROC [type: Type--union--] RETURNS [ans: BOOLEAN] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; class: Class = TypeClass[UnderType[type]]; IF class = record OR class = structure THEN type _ IndexToType[type, NComponents[type]]; IF class = nil THEN RETURN[FALSE]; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM union => ans _ ser.overlaid; ENDCASE => {ReleaseSTB[stb]; RETURN[FALSE]}; ReleaseSTB[stb]; }}; -- break up and MOVE IsComputed: PUBLIC SAFE PROC [type: Type--union, sequence--] RETURNS [ans: BOOLEAN] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; class: Class = TypeClass[UnderType[type]]; IF class = nil THEN RETURN[FALSE]; IF class = record OR class = structure THEN type _ IndexToType[type, NComponents[type]]; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM union => ans _ NOT ser.controlled; sequence => ans _ NOT ser.controlled; ENDCASE => {ReleaseSTB[stb]; RETURN[FALSE]}; ReleaseSTB[stb]; }}; -- MOVE IsOrdered: PUBLIC SAFE PROC[type: Type] RETURNS [ans: BOOLEAN] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM long => ans _ WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM ref => rse.ordered, enumerated => rse.ordered, basic => rse.ordered, ENDCASE => ERROR Error[reason: typeFault, type: type]; ref => ans _ ser.ordered; enumerated => ans _ ser.ordered; basic => ans _ ser.ordered; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]; }}; -- MOVE IsMachineDependent: PUBLIC SAFE PROC [type: Type--record, structure, union, enumerated, sequence--] RETURNS[ans: BOOLEAN] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM union => ans _ ser.machineDep; definition => ans _ FALSE; enumerated => ans _ ser.machineDep; record => ans _ ser.machineDep; sequence => ans _ ser.machineDep; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]; }}; -- MOVE Domain: PUBLIC SAFE PROC [type: Type--array, sequence, union, transfer, descriptor, longDescriptor, relativePointer--] RETURNS[ans: Type] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, Domain]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM relative => ans _ AcquireType[stb, ser.offsetType]; array => ans _ AcquireType[stb, ser.indexType]; sequence => ans _ AcquireType[stb, stb.seb[ser.tagSei].idType]; union => ans _ AcquireType[stb, stb.seb[ser.tagSei].idType]; transfer => ans _ (IF ser.typeIn = nullSymbolIndex THEN nullType ELSE AcquireType[stb, ser.typeIn]); ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]}; -- end ENABLE UNWIND [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]}; --applicable to array, sequence, procedure, signal, process, address (not atom, rope)-- -- break up and MOVE Range: PUBLIC SAFE PROC[type: Type] RETURNS[ans: Type] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, Range]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; SELECT TypeClass[UnderType[type]] FROM array, sequence, procedure, signal, process, list, ref, pointer, longPointer, descriptor, longDescriptor, relativePointer, basePointer => NULL; ENDCASE => ERROR Error[reason: typeFault, type: type]; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM array => ans _ AcquireType[stb, ser.componentType]; sequence => ans _ AcquireType[stb, ser.componentType]; transfer => ans _ (IF ser.typeOut = nullSymbolIndex THEN nullType ELSE AcquireType[stb, ser.typeOut]); relative => ans _ Range[AcquireType[stb, ser.resultType]]; ref => {IF ser.counted THEN ERROR Error[reason: typeFault, type: type]; ans _ (IF stb.UnderType[ser.refType] = symbolIndexForANY THEN unspecType ELSE AcquireType[stb, ser.refType])}; arraydesc => ans _ AcquireType[stb, ser.describedType]; long => WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM ref => ans _ (IF stb.UnderType[rse.refType] = symbolIndexForANY THEN unspecType ELSE AcquireType[stb, rse.refType]); arraydesc => ans _ AcquireType[stb, rse.describedType]; ENDCASE => ERROR Error[reason: typeFault, type: type]; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]}; -- END ENABLE UNWIND [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]}; -- end Range -- MOVE ReferentStatus: PUBLIC SAFE PROC [type: Type--address--] RETURNS [ans: Status] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, ReferentStatus]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; readOnlyReferent: BOOLEAN _ FALSE; WITH ser: stb.seb[csei] SELECT FROM long => WITH ser1: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM arraydesc => readOnlyReferent _ ser1.readOnly; ref => readOnlyReferent _ ser1.readOnly; ENDCASE => ERROR Error[reason: typeFault, type: type]; ref => readOnlyReferent _ ser.readOnly; relative => WITH ser2: stb.seb[stb.UnderType[ser.resultType]] SELECT FROM long => WITH ser1: stb.seb[stb.UnderType[ser2.rangeType]] SELECT FROM ref => readOnlyReferent _ ser1.readOnly; ENDCASE => ERROR Error[reason: typeFault, type: type]; ref => readOnlyReferent _ ser2.readOnly; ENDCASE => ERROR Error[reason: typeFault, type: type]; arraydesc => readOnlyReferent _ ser.readOnly; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]; ans _ IF readOnlyReferent THEN readOnly ELSE mutable}; -- end ENABLE UNWIND [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]}; -- end ReferentStatus -- break up and MOVE TypeToName: PUBLIC SAFE PROC [type: Type--definition--, moduleName, fileName: REF ROPE _ NIL] RETURNS [ans: ROPE] = TRUSTED { IF type = nullType THEN RETURN[NIL]; IF type = unspecType THEN RETURN ["UNSPECIFIED"]; IF type = fhType THEN RETURN ["SomeFrameHandle"]; IF type = gfhType THEN RETURN["SomeGlobalFrameHandle"]; IF type = listOfRefAnyType THEN RETURN["ListOfREFANY"]; IF type = refAnyType THEN RETURN["REFANY"]; IF type = anyType THEN RETURN["ANY"]; { stb: SymbolTableBase _ NIL; sei: SymbolIndex; class: Class _ TypeClass[type]; IF class = atom THEN RETURN["ATOM"] ELSE IF class = rope THEN RETURN["ROPE"]; IF moduleName # NIL OR fileName # NIL THEN [stb, sei] _ GetOriginalTypeSymbols[type ! Error => CONTINUE]; IF stb = NIL THEN [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; mdi: SymbolModuleIndex _ thisModuleIndex; WITH ser: stb.seb[sei] SELECT FROM id => {ans _ AcquireRope[stb, ser.hash]; IF moduleName # NIL OR fileName # NIL THEN {WITH cer: stb.ctxb[ser.idCtx] SELECT FROM included => mdi _ cer.module; ENDCASE; IF moduleName # NIL THEN moduleName^ _ AcquireRope[stb, stb.mdb[mdi].moduleId]; IF fileName # NIL THEN fileName^ _ AcquireRope[stb, stb.mdb[mdi].fileId]}}; ENDCASE => {csei: SymbolConstructorIndex = stb.UnderType[sei]; IF moduleName # NIL THEN moduleName^ _ STBToModuleName[stb]; WITH ser: stb.seb[csei] SELECT FROM definition => ans _ STBToModuleName[stb]; -- interface type ENDCASE => ans _ NIL}; ReleaseSTB[stb]}}}; -- peels off one layer -- MOVE Ground: PUBLIC SAFE PROC [type: Type--definition, subrange--] RETURNS[ans: Type] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, Ground]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; [stb, sei] _ GetTypeSymbols[type]; {ENABLE UNWIND => ReleaseSTB[stb]; WITH ser: stb.seb[sei] SELECT FROM id => {-- a definition ans _ AcquireType[stb, ser.idInfo]}; ENDCASE => {csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM subrange => { IF TypeClass[type] = cardinal THEN {ReleaseSTB[stb]; GO TO fault}; ans _ AcquireType[stb, ser.rangeType]}; ENDCASE => {ReleaseSTB[stb]; GO TO fault}}; ReleaseSTB[stb]; }; [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]; EXITS fault => ERROR Error[reason: typeFault, type: type]; }; GroundStar: PUBLIC SAFE PROC[type: Type--definition, subrange--] RETURNS[Type] = TRUSTED {entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, GroundStar]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; UNTIL AtGround[type] DO type _ Ground[type] ENDLOOP; [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]]; RETURN[type]}; UnderType: PUBLIC SAFE PROC[type: Type--definition--] RETURNS[Type] = TRUSTED { entry: RTTCache.IntEntry; int: INT; entry _ RTTCache.LookupInt[type, UnderType]; int _ entry.int; IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]}; UNTIL TypeClass[type] # definition DO type _ Ground[type]; ENDLOOP; [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]]; RETURN[type]}; AtGround: PROC[type: Type] RETURNS [BOOLEAN] = { class: Class = TypeClass[type]; RETURN[class # definition AND class # subrange]}; -- break up and MOVE First: PUBLIC SAFE PROC [type: Type--enumerated, subrange, basic--] RETURNS [tv: TypedVariable] = TRUSTED {class: Class = TypeClass[UnderType[type]]; IF class = subrange THEN {stb: SymbolTableBase; sei: SymbolIndex; csei: SymbolConstructorIndex; [stb, sei] _ GetTypeSymbols[type]; csei _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM subrange => {empty: BOOLEAN = ser.empty; ReleaseSTB[stb]; IF empty THEN ERROR Error[reason: rangeFault]}; ENDCASE => {ReleaseSTB[stb]; ERROR}; tv _ New[type]; RETURN}; -- the "0" that's there already is always the right stored representation!! tv _ New[type]; SELECT class FROM enumerated => SetTVFromLC[tv, 0]; cardinal => SetTVFromLC[tv, FIRST[CARDINAL]]; integer => SetTVFromLI[tv, LONG[FIRST[INTEGER]]]; character => SetTVFromLC[tv, LONG[LOOPHOLE[FIRST[CHARACTER], CARDINAL]]]; longInteger => SetTVFromLI[tv, FIRST[LONG INTEGER]]; longCardinal => SetTVFromLC[tv, FIRST[LONG CARDINAL]]; ENDCASE => ERROR Error[reason: typeFault, type: type]; }; -- break up and MOVE Last: PUBLIC SAFE PROC [type: Type--enumerated, subrange, basic--] RETURNS[tv: TypedVariable] = TRUSTED { class: Class = TypeClass[UnderType[type]]; tv _ New[type]; SELECT class FROM enumerated, subrange => { stb: SymbolTableBase; sei: SymbolIndex; i: INTEGER; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM enumerated => i _ LOOPHOLE[ser.nValues - 1, INTEGER]; subrange => {IF ser.empty THEN ERROR Error[reason: rangeFault]; i _ ser.origin + ser.range}; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]; }; IF class = enumerated THEN SetTVFromLC[tv, LONG[LOOPHOLE[i, CARDINAL]]] ELSE SetTVFromLI[tv, LONG[i]]}; cardinal => SetTVFromLC[tv, LAST[CARDINAL]]; integer => SetTVFromLI[tv, LONG[LAST[INTEGER]]]; character => SetTVFromLC[tv, LONG[LOOPHOLE[LAST[CHARACTER], CARDINAL]]]; longInteger => SetTVFromLI[tv, LAST[LONG INTEGER]]; longCardinal => SetTVFromLC[tv, LAST[LONG CARDINAL]]; ENDCASE => ERROR Error[reason: typeFault, type: type]; }; -- MOVE NValues: PUBLIC SAFE PROC[type: Type--enumerated, subrange--] RETURNS [int: INT] = TRUSTED { stb: SymbolTableBase; sei: SymbolIndex; csei: SymbolConstructorIndex; entry: RTTCache.IntEntry; type _ UnderType[type]; entry _ RTTCache.LookupInt[type, NValues]; int _ entry.int; IF int >= 0 THEN RETURN[int]; [stb, sei] _ GetTypeSymbols[type]; {ENABLE UNWIND => ReleaseSTB[stb]; csei _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM enumerated => int _ IF ser.nValues = 0 THEN 200000B ELSE ser.nValues; subrange => int _ IF ser.empty THEN 0 ELSE 1 + ser.range; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]}; [] _ RTTCache.FillIntEntry[entry, int]; }; -- raises typeFault, badIndex -- index range is [1..NValues[type]] Value: PUBLIC SAFE PROC[type: Type--enumerated--, index: CARDINAL] RETURNS[tv: TypedVariable] = TRUSTED { type _ UnderType[type]; IF TypeClass[type] = enumerated THEN {IF index > NValues[type] THEN ERROR Error[reason: badIndex]; tv _ TVForReferent[NewObject[type, 1]]; SetTVFromLC[tv, index-1]} ELSE ERROR Error[reason: typeFault, type: type]}; -- This is exported to RTTypesPrivate, and is imported by RTTypedVariablesImpl -- MOVE ComponentISEI: PUBLIC PROC[type: Type--union, enumerated--, index: CARDINAL, p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]] = { stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; n: CARDINAL _ 0; ctxi: SymbolContextIndex; enumeration: BOOLEAN _ FALSE; looker: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = { n _ n + 1; IF enumeration THEN {IF index-1 = stb.seb[isei].idValue THEN {p[stb, isei]; RETURN[TRUE]} ELSE RETURN[FALSE]} ELSE {IF n = index THEN {p[stb, isei]; RETURN[TRUE]} ELSE RETURN[FALSE]}}; WITH ser: stb.seb[csei] SELECT FROM union => IF index = 0 THEN {p[stb, ser.tagSei]; ReleaseSTB[stb]; RETURN} ELSE ctxi _ ser.caseCtx; enumerated => {enumeration _ TRUE; ctxi _ ser.valueCtx}; ENDCASE => ERROR Error[reason: typeFault, type: type]; IF NOT EnumerateCtxIseis[stb, ctxi, looker] THEN ERROR Error[reason: badIndex]; ReleaseSTB[stb]}; }; -- MOVE RecordComponentISEI: PUBLIC PROC[type: Type--record, structure--, index: Index, p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]] = { stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex _ stb.UnderType[sei]; n: Index _ 0; looker: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = { n _ n + 1; IF n = index THEN {p[stb, isei]; RETURN[TRUE]} ELSE RETURN[FALSE]}; WITH ser: stb.seb[csei] SELECT FROM record => IF NOT EnumerateRecordIseis[stb, LOOPHOLE[csei], looker] THEN ERROR Error[reason: badIndex]; definition => IF NOT EnumerateCtxIseis[stb, ser.defCtx, looker] THEN ERROR Error[reason: badIndex]; ENDCASE => ERROR Error[reason: typeFault, type: type]; ReleaseSTB[stb]}; }; -- ... NOTE and procedures for dealing with code TypedVariables... -- Procedures private to this module -- MOVE CtxEntries: PROC[stb: SymbolTableBase, ctx: SymbolContextIndex] RETURNS[CARDINAL] = { n: CARDINAL _ 0; counter: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = {n _ n + 1; RETURN[FALSE]}; [] _ EnumerateCtxIseis[stb, ctx, counter]; RETURN[n]}; SelectBasicClass: PROC[code: [0..16)] RETURNS[Class] = { SELECT code FROM typeCodeForINT => RETURN[integer]; typeCodeForCHAR => RETURN[character]; ENDCASE => ERROR}; -- MOVE GetOrigin: PUBLIC PROC[type: Type] RETURNS[origin: INTEGER _ 0] = { stb: SymbolTableBase; sei: SymbolIndex; csei: SymbolConstructorIndex; IF Size[type] > 1 THEN RETURN[0]; -- no subranges in long domain [stb, sei] _ GetTypeSymbols[type]; csei _ stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM subrange => origin _ ser.origin ENDCASE; ReleaseSTB[stb]}; END.