<> <> <> <> <> <> <> DIRECTORY AMTypes USING [Error], Basics USING [LowHalf], BasicTime USING [FromNSTime], BcdDefs USING [BcdBase, FTSelf, SGIndex, SGHandle, SGNull, VersionID], BcdOps USING [ProcessSegs], ConvertUnsafe USING [SubString, SubStringToRope], FS USING [Error, GetInfo, nullOpenFile, OpenFile, Read, WordsForPages], IO USING [PutFR], LupineSymbolTable USING [ ComponentProcedure, DirectoryProcedure, FullTypeName, GMT, Index, InterfaceInfo, IsAnonymous, OpenErrorCode, ParamPassingMethod, STBase, String, StringNIL, SymbolHandle, SymbolType, TransferProcedure, TransferTypes, TypeHandle, TypeInfo, VariantProcedure, VersionStamp, Words ], Rope USING[ Fetch, Find, Length, Substr ], RTSymbolDefs USING[ SymbolTableBase, SymbolIdIndex ], RTSymbolOps USING[ EnumerateCtxIseis, NullISEI, NullCtx, ISECtx ], RTSymbols USING [AcquireSTBFromSGI, ReleaseSTB ], Symbols USING [ Base, BodyRecord, BTIndex, codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex, CTXRecord, HTIndex, HTNull, ISEIndex, ISENull, lZ, MDIndex, OwnMdi, RecordSEIndex, RecordSENull, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE, WordLength ], SymbolTable USING [Base], Table USING [Base, Limit], VM USING [Allocate, Free, Interval, nullInterval, AddressForPageNumber, PagesForWords]; LupineSymbolTableImpl: PROGRAM IMPORTS AMTypes, Basics, BasicTime, BcdOps, ConvertUnsafe, FS, IO, LupineSymbolTable, Rope, RTSymbolOps, RTSymbols, VM EXPORTS LupineSymbolTable SHARES LupineSymbolTable = BEGIN OPEN Symbols, ST: LupineSymbolTable; STBase: TYPE = ST.STBase; String: TYPE = ST.String; AllocSubString: TYPE = ConvertUnsafe.SubString _ [base: NIL, offset: NULL, length: NULL] | NULL;  <> <> rootSTB: STBase _ NIL; rootFile: FS.OpenFile _ FS.nullOpenFile; rootSpace: VM.Interval _ VM.nullInterval; rootBcd: BcdDefs.BcdBase _ NIL; qualifyOpenNames: BOOL_FALSE; -- IF TRUE, fully qualify names even if from open interface OpenInterface: PUBLIC PROCEDURE [ interfaceFilename: String, interfaceCapability: FS.OpenFile ] = BEGIN ENABLE UNWIND => CloseInterface[]; symbols: BcdDefs.SGIndex; rootFile _ interfaceCapability; qualifyOpenNames _FALSE; [rootSpace, rootBcd] _ LoadUpBcd[ interfaceCapability ! LoadVersionError => ERROR OpenError[interfaceFilename, badFileVersion] ]; IF (symbols _ GetOwnSymbolsSGI[rootBcd]) = BcdDefs.SGNull THEN ERROR OpenError[interfaceFilename, badFileFormat]; rootSTB _ NARROW [RTSymbols.AcquireSTBFromSGI[ bcd: rootBcd, sgi: symbols ! AMTypes.Error => BEGIN IF reason = noSymbols THEN ERROR OpenError[msg, badFileName] ; END ], RTSymbolDefs.SymbolTableBase.x].e; IF ~rootBcd.definitions THEN ERROR OpenError[interfaceFilename, notInterfaceModule]; InitializeBuiltinTypes[standardStb: rootSTB]; END; OpenError: PUBLIC ERROR [fileOrModuleName: String, why: ST.OpenErrorCode] = CODE; CloseInterface: PUBLIC PROCEDURE = BEGIN IF rootSTB # NIL THEN RTSymbols.ReleaseSTB[[x[rootSTB]]]; IF rootSpace # VM.nullInterval THEN VM.Free[rootSpace]; rootSTB _ NIL; rootFile _ FS.nullOpenFile; rootSpace _ VM.nullInterval; rootBcd _ NIL; END; GetInterfaceInfo: PUBLIC PROCEDURE RETURNS [ contents: ST.InterfaceInfo, moduleName, fileName: String, moduleVersion: ST.VersionStamp, moduleCreateTime, sourceCreateTime: ST.GMT ] = BEGIN CheckContents: ContextProcedure = BEGIN SELECT itemStb.TypeForm[SymType[itemStb,itemIsei]] FROM transfer => contents.transfers[XferModeToTransferType[ itemStb.XferMode[SymType[itemStb,itemIsei]]] ] _ TRUE; opaque => contents.types _ TRUE; ENDCASE => IF ~itemStb.seb[itemIsei].constant THEN contents.variables _ TRUE; END; contents _ []; -- Initialize contents. [] _ EnumerateContext[ ctxStb: rootSTB, ctx: rootSTB.stHandle.outerCtx, ctxProc: CheckContents]; [moduleName, fileName] _ GetModuleInfo[ rootSTB, OwnMdi]; moduleVersion _ rootSTB.stHandle.version; moduleCreateTime _ FS.GetInfo[rootFile ! FS.Error => CONTINUE].created; sourceCreateTime _ BasicTime.FromNSTime[rootSTB.stHandle.sourceVersion.time]; END; QualifyOpenNames: PUBLIC PROCEDURE[qualify: BOOL] RETURNS [oldQualify: BOOL ] = { oldQualify _ qualifyOpenNames; qualifyOpenNames _ qualify; }; VersionStampString: PUBLIC PROCEDURE [stamp: ST.VersionStamp] RETURNS [stampString: String] = <> BEGIN stampString _ IO.PutFR["%b#%b#%b", [integer[stamp.net]], [integer[stamp.host]], [cardinal[stamp.time]] ]; END; XferModeToTransferType: PACKED ARRAY TransferMode OF ST.TransferTypes = [ proc: Procedure, error: Error, signal: Signal, port: Port, program: Program, process: Process, none: Other ]; GetModuleInfo: PROCEDURE [ stBase: STBase, module: MDIndex] RETURNS[moduleName, fileName: String] = --INLINE-- BEGIN moduleName _ HtiString[stBase, stBase.mdb[module].moduleId]; fileName _ HtiString[stBase, stBase.mdb[module].fileId]; END; LoadVersionError: ERROR = CODE; LoadUpBcd: PROC [bcdFile: FS.OpenFile] RETURNS [bcdSpace: VM.Interval_VM.nullInterval, bcd: BcdDefs.BcdBase] = BEGIN bcdSpaceBase: INT = 0; pages: CARDINAL; BEGIN ENABLE UNWIND => IF bcdSpace#VM.nullInterval THEN VM.Free[bcdSpace]; bcdSpace _ VM.Allocate[VM.PagesForWords[FS.WordsForPages[1]]]; bcd _ VM.AddressForPageNumber[bcdSpace.page]; FS.Read[file: bcdFile, from: bcdSpaceBase, nPages: 1, to: bcd]; IF bcd.versionIdent # BcdDefs.VersionID THEN ERROR LoadVersionError; pages _ bcd.nPages; IF pages > 1 THEN BEGIN VM.Free[bcdSpace]; bcdSpace _ VM.Allocate[VM.PagesForWords[FS.WordsForPages[pages]]]; bcd _ VM.AddressForPageNumber[bcdSpace.page]; FS.Read[file: bcdFile, from: bcdSpaceBase, nPages: pages, to: bcd]; END; END; END; GetOwnSymbolsSGI: PROC [ownBcd: BcdDefs.BcdBase] RETURNS [ownSGI: BcdDefs.SGIndex] = BEGIN OPEN BcdOps, BcdDefs; CheckSeg: PROC [sgh: SGHandle, sgi: SGIndex] RETURNS [--stop:-- BOOLEAN] = {RETURN[sgh.class=symbols AND sgh.file=FTSelf]}; ownSGI _ ProcessSegs[bcd: ownBcd, proc: CheckSeg].sgi; END;  <> EnumerateDirectory: PUBLIC PROCEDURE [proc: ST.DirectoryProcedure] RETURNS [stopped: BOOLEAN_FALSE] = BEGIN DoDirItem: ContextProcedure = BEGIN OPEN itemStb; moduleName: String; fileName: String; imported: BOOLEAN; defContext: CTXIndex; module: MDIndex; WITH seb[UnderType[seb[itemIsei].idType]] SELECT FROM definition => defContext _ defCtx; transfer => defContext _ bb[LOOPHOLE[seb[itemIsei].idInfo, BTIndex]].localCtx; ENDCASE => ERROR; WITH ctx: ctxb[defContext] SELECT FROM simple => {module _ OwnMdi; imported _ FALSE}; included => {module _ ctx.module; imported _ FALSE}; imported => {module _ ctxb[ctx.includeLink].module; imported_TRUE}; ENDCASE => ERROR; [moduleName, fileName] _ GetModuleInfo[itemStb, module]; { index: INT = fileName.Find["."]; IF index >= 0 THEN fileName _ fileName.Substr[start: 0, len: index] }; RETURN[stop: proc[moduleName: moduleName, fileName: fileName, imported: imported, directoryIndex: itemIndex].stop]; END; stopped _ EnumerateContext[ ctxStb: rootSTB, ctx: rootSTB.stHandle.directoryCtx, ctxProc: DoDirItem]; END; EnumerateTransfers: PUBLIC PROCEDURE [ proc: ST.TransferProcedure, all, procs, signals, errors: BOOLEAN _ FALSE ] RETURNS [stopped: BOOLEAN_FALSE] = BEGIN index: ST.Index _ 0; <> <> DoTransfer: ContextProcedure = BEGIN InlineOrMachineCode: PROCEDURE [transfer: ISEIndex] RETURNS [BOOLEAN] = INLINE {RETURN[itemStb.seb[transfer].constant]}; topType: SEIndex = SymType[itemStb, itemIsei]; type: CSEIndex = itemStb.UnderType[topType]; WITH xfer: itemStb.seb[type] SELECT FROM transfer => SELECT xfer.mode FROM proc => IF (all OR procs) AND ~InlineOrMachineCode[itemIsei] THEN stop _ proc[ transfer: [itemStb, itemIsei], transferType: [itemStb, topType], kind: Procedure, argumentRecordType: [itemStb, xfer.typeIn], resultRecordType: [itemStb, xfer.typeOut], transferIndex: (index _ index+1) ]; error => IF all OR errors THEN stop _ proc[ transfer: [itemStb, itemIsei], transferType: [itemStb, topType], kind: Error, argumentRecordType: [itemStb, xfer.typeIn], resultRecordType: [itemStb, xfer.typeOut], transferIndex: (index _ index+1) ]; signal => IF all OR signals THEN stop _ proc[ transfer: [itemStb, itemIsei], transferType: [itemStb, topType], kind: Signal, argumentRecordType: [itemStb, xfer.typeIn], resultRecordType: [itemStb, xfer.typeOut], transferIndex: (index _ index+1) ]; ENDCASE => IF all THEN stop _ proc[ transfer: [itemStb, itemIsei], transferType: [itemStb, topType], kind: XferModeToTransferType[xfer.mode], argumentRecordType: [itemStb, xfer.typeIn], resultRecordType: [itemStb, xfer.typeOut], transferIndex: (index _ index+1) ]; ENDCASE => NULL; END; stopped _ EnumerateContext[ ctxStb: rootSTB, ctx: rootSTB.stHandle.outerCtx, ctxProc: DoTransfer]; END; EnumerateRecord: PUBLIC PROCEDURE [ recordType: ST.TypeHandle, proc: ST.ComponentProcedure] RETURNS [stopped: BOOLEAN_FALSE] = BEGIN recStb: STBase = recordType.base; IF recordType.type = SENull THEN RETURN; WITH rec: recStb.seb[recStb.UnderType[recordType.type]] SELECT FROM record => BEGIN DoComponent: ContextProcedure = BEGIN RETURN[ stop: proc[ component: [itemStb, itemIsei], componentType: [itemStb, SymType[itemStb, itemIsei]], componentIndex: itemIndex ].stop ]; END; stopped _ EnumerateContext[ ctxStb: recStb, ctx: rec.fieldCtx, ctxProc: DoComponent] END; ENDCASE => ERROR; END; EnumerateVariants: PUBLIC PROCEDURE [ variantPartType: ST.TypeHandle, proc: ST.VariantProcedure] RETURNS [stopped: BOOLEAN_FALSE] = BEGIN varStb: STBase = variantPartType.base; IF variantPartType.type = SENull THEN ERROR; WITH var: varStb.seb[varStb.UnderType[variantPartType.type]] SELECT FROM union => BEGIN DoVariant: ContextProcedure = BEGIN RETURN[ stop: proc[ variantTag: [itemStb, itemIsei], variantNumber: itemStb.seb[itemIsei].idValue, variantRecordType: [itemStb, itemStb.seb[itemIsei].idInfo], variantIndex: itemIndex ].stop ]; END; stopped _ EnumerateContext[ ctxStb: varStb, ctx: var.caseCtx, ctxProc: DoVariant]; END; ENDCASE => ERROR; END; ContextProcedure: TYPE = PROCEDURE [ itemStb: SymbolTable.Base, itemIsei: ISEIndex, itemIndex: ST.Index] RETURNS [stop: BOOLEAN_FALSE]; EnumerateContext: PROCEDURE [ ctxStb: STBase, ctx: CTXIndex, ctxProc: ContextProcedure ] RETURNS [stopped: BOOLEAN_FALSE] = BEGIN item: ST.Index _ 0; SkipRecordPackingInfo: PROCEDURE [stb: RTSymbolDefs.SymbolTableBase, isei: RTSymbolDefs.SymbolIdIndex] RETURNS [--stop:-- BOOLEAN] = BEGIN RETURN[IF item=0 AND NOT RTSymbolOps.NullISEI[isei] AND RTSymbolOps.NullCtx[RTSymbolOps.ISECtx[stb, isei]] THEN FALSE ELSE ctxProc[itemStb: NARROW[stb, RTSymbolDefs.SymbolTableBase.x].e, itemIsei: NARROW[isei, RTSymbolDefs.SymbolIdIndex.x].e, itemIndex: (item_item+1) ].stop ]; END; stopped _ RTSymbolOps.EnumerateCtxIseis[ stb: [x[ctxStb]], ctx: [x[ctx]], proc: SkipRecordPackingInfo ! AMTypes.Error => BEGIN IF reason = noSymbols THEN ERROR OpenError[msg, badFileName]; END ]; END;  <> SymType: PROCEDURE [stb: STBase, isei: ISEIndex] RETURNS [SEIndex] = INLINE BEGIN RETURN[ IF stb.seb[isei].idType = SENull THEN ERROR ELSE stb.seb[isei].idType]; END; SearchTypeDefinition: PUBLIC PROCEDURE [ rootDef: ST.TypeHandle, candidateDefs: LONG DESCRIPTOR FOR READONLY ARRAY OF ST.FullTypeName ] RETURNS [indexOfMatch: INTEGER _ -1 --No match--] = BEGIN thisBase: STBase = rootDef.base; thisType: SEIndex _ rootDef.type; thisName, thisModule: AllocSubString; DO WITH sei: thisBase.seb[thisType] SELECT FROM id => BEGIN thisName _ IseiSubString[ stb: thisBase, isei: ISEI[thisType] ]; thisModule _ HtiSubString[ stb: thisBase, hti: ModuleHtiOfTypeName[thisBase, ISEI[thisType]]]; FOR type: INTEGER IN [0..LENGTH[candidateDefs]) DO IF StringEqualSubString[candidateDefs[type].name, thisName] AND StringEqualSubString[candidateDefs[type].module, thisModule] THEN RETURN[type]; REPEAT FINISHED => thisType _ sei.idInfo; ENDLOOP; END; cons => WITH csei: sei SELECT FROM long => thisType _ csei.rangeType; ENDCASE => RETURN; ENDCASE => ERROR; ENDLOOP; END; Size: PUBLIC PROCEDURE [type: ST.TypeHandle] RETURNS [size: ST.Words] = BEGIN RETURN[type.base.WordsForType[type.type]]; END; ComputeArraySize: PUBLIC PROCEDURE [ index, elements: ST.TypeHandle, packed: BOOLEAN ] RETURNS [--size:-- ST.Words] = BEGIN <> <> <> bits: LONG CARDINAL; cardinality: ST.Words = WITH indexInfo: GetTypeInfo[type: index] SELECT FROM Basic => indexInfo.cardinality, ENDCASE => ERROR; RETURN[ IF (bits_elements.base.BitsPerElement[elements.type, packed]) < WordLength THEN (cardinality+(WordLength/bits-1)) / (WordLength/bits) ELSE cardinality * ((bits+WordLength-1)/WordLength) ]; END; ModuleHtiOfTypeName: PROCEDURE [stBase: STBase, typeName: ISEIndex] RETURNS [--moduleHti:-- HTIndex] = --INLINE-- BEGIN RETURN[stBase.mdb[ModuleOfTypeName[stBase, typeName]].moduleId] END; ModuleOfTypeName: PROCEDURE [stBase: STBase, typeName: ISEIndex] RETURNS [module: MDIndex] = BEGIN typeNameCtx: CTXRecord = stBase.ctxb[stBase.seb[typeName].idCtx]; WITH ctx: typeNameCtx SELECT FROM simple => module _ OwnMdi; included => module _ ctx.module; imported => module _ stBase.ctxb[ctx.includeLink].module; ENDCASE => ERROR; END; HtiSubString: PROCEDURE [stb: STBase, hti: HTIndex] RETURNS[ConvertUnsafe.SubString] = INLINE BEGIN -- hti=HTNull is OK; returns null substring. RETURN[stb.SubStringForName[hti]]; END; HtiString: PROCEDURE [stb: STBase, hti: HTIndex] RETURNS[String] = BEGIN RETURN[ConvertUnsafe.SubStringToRope[HtiSubString[stb, hti]]] END; ISEI: PROCEDURE [sei: SEIndex] RETURNS [--isei:-- ISEIndex] = <> <> <> <> INLINE BEGIN RETURN[LOOPHOLE[sei]] END; IseiSubString: PROCEDURE [stb: STBase, isei: ISEIndex] RETURNS[ConvertUnsafe.SubString] = --INLINE-- BEGIN RETURN[HtiSubString[stb, (IF isei=ISENull THEN HTNull ELSE stb.seb[isei].hash)] ]; END; StringEqualSubString: PROCEDURE [a: String, b: ConvertUnsafe.SubString] RETURNS [--exactMatch:-- BOOLEAN] = INLINE BEGIN RETURN [a.Length[]=b.length AND SlowStringEqualSubString[a,b]]; END; SlowStringEqualSubString: PROCEDURE [a: String, b: ConvertUnsafe.SubString] RETURNS [exactMatch: BOOLEAN] = BEGIN IF a.Length[] # b.length THEN RETURN[FALSE]; FOR i: CARDINAL IN [0..b.length) DO IF a.Fetch[i] # b.base[b.offset+i] THEN RETURN[FALSE] ENDLOOP; RETURN[TRUE] END;  <> GetTypeInfo: PUBLIC PROC [type: ST.TypeHandle] RETURNS [info: ST.TypeInfo_[]] = BEGIN OPEN ST; typeStb: STBase = type.base; typeSei: SEIndex = type.type; IF typeSei = SENull THEN RETURN[[self: type, info: Null[]]]; WITH typeSer: typeStb.seb[typeSei] SELECT FROM id => SELECT TRUE FROM typeSer.idType # typeTYPE => ERROR; typeSer.idCtx = StandardTypeContext => SELECT typeSei FROM UNSPECIFIEDIndex => RETURN[ [self: type, info: Basic[ kind: Unspecified, origin: FIRST[WORD], cardinality: (LONG[LAST[WORD]]-FIRST[WORD]+1) ]] ]; INTEGERIndex => RETURN[ [self: type, info: Basic[ kind: Integer, origin: FIRST[INTEGER], cardinality: (LONG[LAST[INTEGER]]-FIRST[INTEGER]+1) ]] ]; CARDINALIndex => RETURN[ [self: type, info: Basic[ kind: Cardinal, origin: FIRST[CARDINAL], cardinality: (LONG[LAST[CARDINAL]]-FIRST[CARDINAL]+1) ]] ]; NATIndex => RETURN[ [self: type, info: Basic[ kind: Nat, origin: FIRST[NAT], cardinality: (LONG[LAST[NAT]]-FIRST[NAT]+1) ]] ]; REALIndex => RETURN[ [self: type, info: Basic[ kind: Real, origin: 0, cardinality: 0 ]] ]; WORDIndex => RETURN[ [self: type, info: Basic[ kind: Word, origin: FIRST[WORD], cardinality: (LONG[LAST[WORD]]-FIRST[WORD]+1) ]] ]; CHARACTERIndex => RETURN[ [self: type, info: Basic[ kind: Character, origin: LOOPHOLE[FIRST[CHARACTER], INTEGER], cardinality: LONG[ LOOPHOLE[LAST[CHARACTER], INTEGER] - LOOPHOLE[FIRST[CHARACTER], INTEGER] + 1 ] ]] ]; BOOLEANIndex => RETURN[ [self: type, info: Basic[ kind: Boolean, origin: LOOPHOLE[FIRST[BOOLEAN], INTEGER], cardinality: 2 ]] ]; TEXTIndex => RETURN[[self: type, info: Text[]]]; STRINGIndex => RETURN[[self: type, info: String[]]]; StringBodyIndex => RETURN[[self: type, info: StringBody[]]]; ATOMIndex => RETURN[[self: type, info: Atom[], readonly: FALSE]]; MONITORLOCKIndex, CONDITIONIndex => RETURN[[self: type, info: Other[]]]; MDSZoneIndex => RETURN[ [self: type, info: Zone[allocation: Uncounted, mdsZone: TRUE]] ]; ENDCASE => <> <> <> BEGIN synonymInfo: TypeInfo _ GetTypeInfo[[typeStb, typeSer.idInfo]]; synonymInfo.self _ type; RETURN[ SELECT synonymInfo.type FROM Basic, String, StringBody, Text, Atom, Rope, Any => synonymInfo, ENDCASE => [self: type, info: Other[]] ]; END; IsType[["Rope", "ROPE"], typeStb, ISEI[typeSei]] => RETURN[[self: type, info: Rope[], readonly: FALSE]]; ENDCASE => BEGIN method: ParamPassingMethod=GetParamMethod[typeStb, ISEI[typeSei]]; symInfo: TypeInfo _ GetTypeInfo[[typeStb, typeSer.idInfo]]; symInfo.self _ type; IF method # standard THEN symInfo.passingMethod _ method; RETURN[symInfo]; END; cons => WITH typeCser: typeSer SELECT FROM basic, real => ERROR; -- Should have been in StandardTypeContext. definition => RETURN[[self: type, info: Definition[]]]; subrange => RETURN[ [self: type, info: Basic[ kind: Subrange, origin: typeCser.origin, cardinality: IF typeCser.empty THEN 0 ELSE typeCser.range+1]] ]; enumerated => RETURN[ [self: type, info: Basic[ kind: Enumeration, origin: 0, cardinality: typeCser.nValues]] ]; transfer => RETURN[ [self: type, info: Transfer[ kind: XferModeToTransferType[typeCser.mode], safe: typeCser.safe, argumentType: TypeHandle[typeStb, typeCser.typeIn], resultType: TypeHandle[typeStb, typeCser.typeOut]]] ]; record => BEGIN variantType: TypeClass _ record; GetVariantType: ComponentProcedure = BEGIN variantType _ componentType.base.TypeForm[componentType.type]; RETURN[ stop: SELECT variantType FROM union, sequence => TRUE, ENDCASE => FALSE]; END; -- GetVariantType. IF typeCser.hints.variant THEN [] _ EnumerateRecord[type, GetVariantType]; RETURN[ [self: type, info: Record[ painted: typeCser.painted, paramRecord: typeCser.argument, monitored: typeCser.monitored, uniField: typeCser.hints.unifield, hasVariants: variantType=union, hasSequences: variantType=sequence]] ]; END; union => IF typeCser.controlled THEN SELECT typeStb.seb[SymType[typeStb, typeCser.tagSei]].seTag FROM id => RETURN[ [self: type, info: VariantPart[ tag: Named[ name: SymbolHandle[typeStb, typeCser.tagSei], type: ST.SymbolType[[typeStb, typeCser.tagSei]]]]] ]; cons => RETURN[ [self: type, info: VariantPart[ tag: Star[ name: SymbolHandle[typeStb, typeCser.tagSei]]]] ]; ENDCASE => ERROR ELSE RETURN[ [self: type, info: VariantPart[tag: Computed[]]] ]; ref => SELECT TRUE FROM ~typeCser.counted => RETURN[ [self: type, info: Pointer[ referentType: TypeHandle[typeStb,typeCser.refType]], readonly: typeCser.readOnly] ]; typeCser.list => { base: STBase; first, rest: SEIndex; [base, first, rest] _ ListTypes[typeStb, typeSei]; RETURN[ [self: type, info: List[ firstType: TypeHandle[base, first], restType: TypeHandle[base, rest]], readonly: typeCser.readOnly] ] }; typeCser.counted => RETURN[ [self: type, info: Ref[ referentType: TypeHandle[typeStb,typeCser.refType]], readonly: typeCser.readOnly] ]; ENDCASE => ERROR; relative => RETURN[ [self: type, info: RelativePtr[ baseType: TypeHandle[typeStb, typeCser.baseType], offsetType: TypeHandle[typeStb, typeCser.offsetType], resultType: TypeHandle[typeStb, typeCser.resultType]]] ]; array => RETURN[ [self: type, info: Array[ packed: typeCser.packed, indexType: TypeHandle[typeStb, typeCser.indexType], elementType: TypeHandle[typeStb, typeCser.componentType]]] ]; arraydesc => BEGIN arrayInfo: TypeInfo _ GetTypeInfo[[typeStb, typeCser.describedType]]; WITH array: arrayInfo SELECT FROM Array => RETURN[ [self: type, info: Descriptor[ packed: array.packed, indexType: array.indexType, elementType: array.elementType], readonly: typeCser.readOnly] ]; ENDCASE => ERROR; END; sequence => IF typeCser.controlled THEN RETURN [ [self: type, info: Sequence[ packed: typeCser.packed, indexType: ST.SymbolType[[typeStb, typeCser.tagSei]], elementType: TypeHandle[typeStb, typeCser.componentType], tagName: Named[ name: SymbolHandle[typeStb, typeCser.tagSei]]]] ] ELSE RETURN [ [self: type, info: Sequence[ packed: typeCser.packed, indexType: ST.SymbolType[[typeStb, typeCser.tagSei]], elementType: TypeHandle[typeStb, typeCser.componentType], tagName: Computed[]]] ]; long => BEGIN shortInfo: TypeInfo _ GetTypeInfo[[typeStb, typeCser.rangeType]]; shortInfo.self _ type; shortInfo.long _ SELECT shortInfo.type FROM Ref, List, Zone => FALSE, ENDCASE => TRUE; RETURN[shortInfo]; END; zone => RETURN[ [self: type, info: Zone[ allocation: IF typeCser.counted THEN Counted ELSE Uncounted, mdsZone: typeCser.mds ]] ]; opaque => RETURN[ [self: type, info: Opaque[lengthKnown: typeCser.lengthKnown]] ]; any => RETURN[[self: type, info: Any[]]]; ENDCASE => RETURN[[self: type, info: Other[]]]; ENDCASE => ERROR; END; IsType: PROCEDURE [ type: ST.FullTypeName, candidateStb: STBase, candidateIsei: ISEIndex ] RETURNS [--yes:-- BOOLEAN] = BEGIN <> candidate: AllocSubString _ IseiSubString[candidateStb, candidateIsei]; IF ~StringEqualSubString[type.name, candidate] THEN RETURN[FALSE]; candidate _ HtiSubString[ stb: candidateStb, hti: ModuleHtiOfTypeName[candidateStb, candidateIsei]]; RETURN[StringEqualSubString[type.module, candidate]]; END; GetParamMethod: PROC [paramStb: STBase, paramIsei: ISEIndex] RETURNS [method: ST.ParamPassingMethod] = BEGIN Check: PROC [prefix: STRING] RETURNS [--isMatch:-- BOOLEAN] = BEGIN IF prefix.length >= typeName.length THEN RETURN[FALSE]; FOR i: CARDINAL IN NAT[0..prefix.length) DO IF typeName.base[typeName.offset+i] # prefix[i] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; END; typeName: AllocSubString = IseiSubString[paramStb, paramIsei]; RETURN[ SELECT TRUE FROM Check["VAR"L], Check["VALUERESULT"L] => var, Check["VALUE"L] => value, Check["RESULT"L] => result, Check["HANDLE"L] => handle, ENDCASE => standard]; END; ListTypes: PROC [listStb: STBase, listSei: --Ref--SEIndex] RETURNS [base: STBase, first, rest: SEIndex_SENull] = BEGIN componentName: AllocSubString; gotFirst, gotRest: BOOLEAN _ FALSE; CheckFirstRest: ST.ComponentProcedure = BEGIN componentName _ IseiSubString[component.base, component.symbol]; SELECT TRUE FROM gotFirst => NULL; StringEqualSubString["first", componentName] => {gotFirst _ TRUE; base _ componentType.base; first _ componentType.type}; ENDCASE => NULL; SELECT TRUE FROM gotRest => NULL; StringEqualSubString["rest", componentName] => {gotRest _ TRUE; rest _ componentType.type}; ENDCASE => NULL; RETURN[stop: gotFirst AND gotRest]; END; -- CheckFirstRest. listCsei: CSEIndex = listStb.UnderType[listSei]; WITH listRef: listStb.seb[listCsei] SELECT FROM ref => { IF ~listRef.list OR ~listRef.counted THEN ERROR; IF ~EnumerateRecord[ recordType: [listStb, listRef.refType], proc: CheckFirstRest ].stopped THEN ERROR }; ENDCASE => ERROR; END; UNSPECIFIEDIndex, INTEGERIndex, CARDINALIndex, NATIndex, REALIndex, WORDIndex, CHARACTERIndex, BOOLEANIndex, TEXTIndex, STRINGIndex, StringBodyIndex, ATOMIndex, MONITORLOCKIndex, CONDITIONIndex, MDSZoneIndex: ISEIndex _ ISENull; StandardTypeContext: CTXIndex = LOOPHOLE[2]; InitializeBuiltinTypes: PROCEDURE [standardStb: STBase] = BEGIN GetTypeISEIndex: PROC [standardType: STRING, system: {Mesa, Cedar}_Mesa] RETURNS [typesISE: ISEIndex] = BEGIN subString: ConvertUnsafe.SubString = [standardType, 0, standardType.length]; typesISE _ standardStb.SearchContext[ name: standardStb.FindString[subString], ctx: StandardTypeContext ]; IF typesISE=ISENull AND system=Mesa THEN ERROR; END; UNSPECIFIEDIndex _ GetTypeISEIndex["UNSPECIFIED"L]; INTEGERIndex _ GetTypeISEIndex["INTEGER"L]; CARDINALIndex _ GetTypeISEIndex["CARDINAL"L]; NATIndex _ GetTypeISEIndex["NAT"L, Cedar]; REALIndex _ GetTypeISEIndex["REAL"L]; WORDIndex _ GetTypeISEIndex["WORD"L]; CHARACTERIndex _ GetTypeISEIndex["CHARACTER"L]; BOOLEANIndex _ GetTypeISEIndex["BOOLEAN"L]; TEXTIndex _ GetTypeISEIndex["TEXT"L]; STRINGIndex _ GetTypeISEIndex["STRING"L]; StringBodyIndex _ GetTypeISEIndex["StringBody"L]; ATOMIndex _ GetTypeISEIndex["ATOM"L, Cedar]; MONITORLOCKIndex _ GetTypeISEIndex["MONITORLOCK"L]; CONDITIONIndex _ GetTypeISEIndex["CONDITION"L]; MDSZoneIndex _ GetTypeISEIndex["MDSZone"L]; END;  <> <Lister>ListPub.mesa.>> PutTypeName: PUBLIC PROCEDURE [ putProc: PROC[CHARACTER], type: ST.TypeHandle, includeReadonly: BOOLEAN_TRUE, rootInterfaceOpenName: String_ST.StringNIL, extraFirstArg: String _ NIL ] = BEGIN ENABLE UNWIND => putChar _ NIL; putChar _ putProc; rootInterfaceQualifier _ rootInterfaceOpenName; [] _ PrintType[ stBase: type.base, tsei: type.type, printReadonly: includeReadonly, dosub: NoSub, extraFirstArg: extraFirstArg ]; <> <> END; <> putChar: PROCEDURE [CHARACTER] _ NIL; -- Set by PutTypeName. PutChar: PROC [chr: CHARACTER] = INLINE {putChar[chr]}; PutString: PROC [str: String] = BEGIN FOR i: INT IN [0..str.Length[]) DO PutChar[str.Fetch[i]] ENDLOOP; END; PutSubString: PROC [subStr: ConvertUnsafe.SubString] = BEGIN FOR i: CARDINAL IN [subStr.offset..subStr.offset+subStr.length) DO PutChar[subStr.base[i]]; ENDLOOP; END; PutDecimal: PROC [n: LONG INTEGER] = BEGIN radix: CARDINAL = 10; radixPower: LONG CARDINAL _ 1; lwb: LONG CARDINAL ; IF n < 0 THEN { PutChar['-]; n _ -n }; lwb _ n/radix; WHILE radixPower <= lwb DO radixPower _ radixPower*radix ENDLOOP; WHILE radixPower > 0 DO x: CARDINAL = n/radixPower; PutChar['0+x]; n _ n - x*radixPower; radixPower _ radixPower/radix; ENDLOOP; END; PutOctal: PROC [n: LONG CARDINAL, trailingB: BOOLEAN_TRUE] = BEGIN radix: CARDINAL = 8; radixPower: LONG CARDINAL _ 1; lwb: LONG CARDINAL _ n/radix; WHILE radixPower <= lwb DO radixPower _ radixPower*radix ENDLOOP; WHILE radixPower > 0 DO x: CARDINAL = n/radixPower; PutChar['0+x]; n _ n - x*radixPower; radixPower _ radixPower/radix; ENDLOOP; IF trailingB THEN PutChar['B]; END; PrintType: PROCEDURE [ stBase: STBase, tsei: SEIndex, dosub: PROCEDURE [vf: ValFormat], printReadonly: BOOLEAN_TRUE, extraFirstArg: String _ NIL ] RETURNS [vf: ValFormat _ [none[]] ] = BEGIN OPEN Symbols, stBase; -- This damn OPEN was here when I arrived! PrintReadonly: PROC [wantReadonly: BOOLEAN] = BEGIN <> IF wantReadonly AND printReadonly THEN PutString["READONLY "]; IF ~printReadonly THEN printReadonly _ TRUE; END; WITH t: seb[tsei] SELECT FROM id => BEGIN printBase: BOOLEAN _ TRUE; ifInteger: BOOLEAN _ FALSE; bsei: SEIndex _ tsei; csei: CSEIndex; DO csei _ UnderType[bsei]; WITH c: seb[csei] SELECT FROM basic => SELECT c.code FROM codeINT => BEGIN printBase _ ifInteger; vf _ [num[]] END; codeCHAR => vf _ [char[]]; ENDCASE; subrange => {bsei _ c.rangeType; ifInteger _ TRUE; LOOP}; enumerated => {printBase _ TRUE; vf _ [enum[stBase, LOOPHOLE[csei]]]}; ENDCASE; EXIT; ENDLOOP; SELECT TRUE FROM ~printReadonly AND GetTypeInfo[type: [stBase, csei]].readonly => [] _ PrintType[stBase, csei, dosub, FALSE]; printBase OR dosub = NoSub => BEGIN PrintModuleQualifier[stBase, tsei]; WITH seb[csei] SELECT FROM record => BEGIN <> < Dress[red][short].>> <> <> <> < {PutChar[' ]; PrintSei[stBase, ISEI[tsei]]};>> <> <> PrintBoundVariants: PROC [recordType: ISEIndex] = BEGIN parent: SEIndex; IF (parent _ TypeLink[recordType]) = SENull THEN PrintSei[stBase, recordType] ELSE BEGIN WITH seb[parent] SELECT FROM id => PrintBoundVariants[ISEI[parent]]; cons => [] _ PrintType[stBase, parent, dosub]; ENDCASE => ERROR; PutChar['[]; PrintSei[stBase, recordType]; PutChar[']]; END; END; -- PrintBoundVariants. PrintBoundVariants[ISEI[tsei]]; END; ENDCASE => PrintSei[stBase, ISEI[tsei]]; END; ENDCASE => NULL; dosub[vf]; END; cons => WITH t SELECT FROM < Should see the ID first.>> enumerated => BEGIN PrintEnumItem: ContextProcedure = BEGIN IF itemIndex > 1 THEN PutString[", "]; PrintSei[itemStb, itemIsei]; END; IF machineDep THEN PutString["MACHINE DEPENDENT "]; PutChar['{]; [] _ EnumerateContext[ ctxStb: stBase, ctx: valueCtx, ctxProc: PrintEnumItem]; PutChar['}]; END; record => BEGIN IF ctxb[fieldCtx].level # lZ THEN BEGIN fctx: CTXIndex = fieldCtx; bti: BTIndex _ FIRST[BTIndex]; btlimit: BTIndex = bti + stHandle.bodyBlock.size; PutString["FRAME ["]; UNTIL bti = btlimit DO WITH entry: bb[bti] SELECT FROM Callable => BEGIN IF entry.localCtx = fctx THEN BEGIN PrintSei[stBase, entry.id]; PutChar[']]; EXIT END; bti _ bti + (WITH entry SELECT FROM Inner => SIZE[Inner Callable BodyRecord], ENDCASE => SIZE[Outer Callable BodyRecord]); END; ENDCASE => bti _ bti + SIZE[Other BodyRecord]; ENDLOOP; END ELSE BEGIN <> <> IF machineDep THEN PutString["MACHINE DEPENDENT "]; PutString[IF painted THEN "RECORD " ELSE "STRUCT "]; PrintFieldCtx[stBase, fieldCtx]; END; END; ref => IF ~list THEN { -- Normal POINTER or REF. IF ordered THEN PutString["ORDERED "]; IF basing THEN PutString["BASE "]; PutString[IF counted THEN "REF " ELSE "POINTER"]; IF dosub # NoSub THEN {PutChar[' ]; dosub[[num[]]]}; IF ~readOnly THEN WITH seb[UnderType[refType]] SELECT FROM basic => IF code = Symbols.codeANY THEN GO TO noprint; ENDCASE; IF ~counted THEN PutString[" TO "]; PrintReadonly[readOnly]; [] _ PrintType[stBase, refType, NoSub]; EXITS noprint => NULL } ELSE { -- LIST OF something. firstBase: STBase; firstBody: SEIndex; [base: firstBase, first: firstBody] _ ListTypes[stBase, tsei]; PutString["LIST OF "]; PrintReadonly[readOnly]; [] _ PrintType[firstBase, firstBody, NoSub] }; array => BEGIN IF packed THEN PutString["PACKED "]; PutString["ARRAY "]; [] _ PrintType[stBase, indexType, NoSub]; PutString[" OF "]; [] _ PrintType[stBase, componentType, NoSub]; END; arraydesc => BEGIN PutString["DESCRIPTOR FOR "]; PrintReadonly[readOnly]; [] _ PrintType[stBase, describedType, NoSub]; END; transfer => BEGIN ArgRes: PROC[type: CSEIndex, extraFirstArg: String] = BEGIN WITH argRes: seb[type] SELECT FROM record => PrintFieldCtx[stBase, argRes.fieldCtx, extraFirstArg]; any => PutString["ANY"]; ENDCASE => ERROR;--?-- END; IF safe THEN PutString["SAFE "]; PrintModeName[mode]; IF typeIn # RecordSENull THEN BEGIN PutChar[' ]; ArgRes[typeIn, extraFirstArg]; END ELSE IF extraFirstArg # NIL THEN { PutChar['[]; PutString[extraFirstArg]; PutChar[']]; }; IF typeOut # RecordSENull THEN BEGIN PutString[" RETURNS "]; ArgRes[typeOut, NIL]; END; END; union => BEGIN tagType: SEIndex; PutString["SELECT "]; IF ~controlled THEN IF overlaid THEN PutString["OVERLAID "] ELSE PutString["COMPUTED "] ELSE BEGIN PrintSei[stBase, tagSei]; PutString[": "] END; tagType _ seb[tagSei].idType; IF seb[tagSei].public # defaultPublic THEN PutString[ IF defaultPublic THEN "PRIVATE " ELSE "PUBLIC "]; WITH seb[tagType] SELECT FROM id => [] _ PrintType[stBase, tagType, NoSub]; cons => PutChar['*]; ENDCASE; PutString[" FROM "]; BEGIN isei: ISEIndex; first: BOOLEAN _ TRUE; varRec: RecordSEIndex; FOR isei _ FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei=ISENull DO IF first THEN first _ FALSE ELSE PutString[", "]; PrintSei[stBase, isei]; PutString[" => "]; varRec _ seb[isei].idInfo; PrintFieldCtx[stBase, seb[varRec].fieldCtx]; ENDLOOP; PutString[" ENDCASE"]; END; END; sequence => BEGIN IF packed THEN PutString["PACKED "]; PutString["SEQUENCE "]; IF controlled THEN {PrintSei[stBase, tagSei]; PutString[": "]} ELSE PutString["COMPUTED "]; [] _ PrintType[stBase, SymType[stBase,tagSei], NoSub]; PutString[" OF "]; [] _ PrintType[stBase, componentType, NoSub]; END; relative => BEGIN IF baseType # SENull THEN [] _ PrintType[stBase, baseType, NoSub, printReadonly]; PutString[" RELATIVE "]; [] _ PrintType[stBase, offsetType, dosub, printReadonly]; END; subrange => BEGIN <> <> <> org: LONG INTEGER _ origin; size: LONG CARDINAL _ range; upperBound: LONG INTEGER = org + size; doit: PROCEDURE [pvf: ValFormat] = BEGIN PutChar['[]; PrintTypedVal[org, pvf, TRUE]; PutString[".."]; IF empty THEN {PrintTypedVal[org, pvf, TRUE]; PutChar[')]} ELSE { PrintTypedVal[ upperBound, pvf, upperBound < INTEGER[0]]; PutChar[']] }; END; vf _ PrintType[stBase, rangeType, doit]; END; long => BEGIN range: CSEIndex = stBase.UnderType[rangeType]; refOrList: BOOLEAN = WITH refType: stBase.seb[range] SELECT FROM ref => refType.counted OR refType.list, ENDCASE => FALSE; IF ~refOrList THEN PutString["LONG "]; [] _ PrintType[stBase, rangeType, NoSub, printReadonly]; END; real => PutString["REAL"]; opaque => BEGIN PutString["TYPE"]; IF lengthKnown THEN { PutString[" ["]; PrintValue[length]; PutString["]"]; }; END; zone => --Not totally corrrect for MdsZone:-- PutString[IF ~counted THEN "UNCOUNTED ZONE" ELSE "ZONE"]; any => PutString["ANY"]; ENDCASE => PutString["--!!!Unknown Type!!!--"]; ENDCASE; END; -- PrintType. rootInterfaceQualifier: String; -- Set by PutTypeName. PrintModuleQualifier: PROCEDURE [stBase: STBase, typeSei: SEIndex] = --INLINE-- BEGIN WITH type: stBase.seb[typeSei] SELECT FROM id => BEGIN module: MDIndex; IF type.idCtx = StandardTypeContext THEN RETURN; module _ ModuleOfTypeName[stBase, ISEI[typeSei]]; IF ~qualifyOpenNames AND module = OwnMdi THEN {IF rootInterfaceQualifier=NIL OR rootInterfaceQualifier.Length[]=0 THEN RETURN ELSE PutString[rootInterfaceQualifier] } ELSE PrintHti[stBase, stBase.mdb[module].moduleId]; PutChar['.]; END; ENDCASE => NULL; END; defaultPublic: BOOLEAN _ TRUE; PrintSymbolType: PRIVATE PROCEDURE [stb: STBase, sei: ISEIndex] = BEGIN OPEN stb; savePublic: BOOLEAN _ defaultPublic; typeSei: SEIndex; IF seb[sei].public # defaultPublic THEN BEGIN defaultPublic _ seb[sei].public; PutString[IF defaultPublic THEN "PUBLIC " ELSE "PRIVATE "]; END; IF seb[sei].idType = typeTYPE THEN BEGIN typeSei _ seb[sei].idInfo; PutString["TYPE = "]; [] _ PrintType[tsei: typeSei, dosub: NoSub, stBase: stb]; END ELSE BEGIN vf: ValFormat; typeSei _ seb[sei].idType; vf _ PrintType[tsei: typeSei, dosub: NoSub, stBase: stb]; IF seb[sei].constant AND vf.tag # none THEN BEGIN PutString[" = "]; PrintTypedVal[LONG[seb[sei].idValue], vf]; END; END; defaultPublic _ savePublic; END; PrintFieldCtx: PROCEDURE [stBase: STBase, ctx: CTXIndex, extraFirstArg: String _ NIL] = BEGIN forceComma: BOOL _ FALSE; PrintFieldItem: ContextProcedure = BEGIN IF itemIndex > 1 OR forceComma THEN PutString[", "]; IF ~ST.IsAnonymous[[itemStb, itemIsei]] THEN {PrintSei[itemStb, itemIsei]; PutString[": "] }; PrintSymbolType[itemStb, itemIsei]; END; PutChar['[]; IF extraFirstArg # NIL THEN {PutString[extraFirstArg]; forceComma _ TRUE}; [] _ EnumerateContext[ctxStb: stBase, ctx: ctx, ctxProc: PrintFieldItem]; PutChar[']]; END; PrintModeName: PROCEDURE [mode: TransferMode] = BEGIN ModePrintName: PACKED ARRAY TransferMode OF String = ["PROCEDURE", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM", "NONE"]; PutString[ModePrintName[mode]] END; ValFormat: TYPE = RECORD [ SELECT tag: * FROM none => NULL, num => NULL, char => NULL, enum => [stBase: STBase, esei: EnumeratedSEIndex], ENDCASE]; PrintTypedVal: PROCEDURE [ val: LONG UNSPECIFIED, vf: ValFormat, integer: BOOLEAN_FALSE] = BEGIN WITH vf SELECT FROM num => PrintValue[val, integer]; enum => PrintEnum[val, stBase, esei]; char => IF val IN [' ..'~] THEN {PutChar['']; PutChar[VAL[Basics.LowHalf[val]]]} ELSE {PutOctal[n: val, trailingB: FALSE]; PutChar['C]}; ENDCASE; END; PrintValue: PROCEDURE [value: LONG UNSPECIFIED, integer: BOOLEAN _ FALSE] = BEGIN IF integer OR LOOPHOLE[value,LONG CARDINAL] < LOOPHOLE[LAST[LONG INTEGER],LONG CARDINAL] THEN PutDecimal[LOOPHOLE[value, LONG INTEGER]] ELSE PutOctal[LOOPHOLE[value, LONG CARDINAL]]; END; NoSub: PROCEDURE [vf: ValFormat] = BEGIN NULL END; EnumeratedSEIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO enumerated cons SERecord; PrintEnum: PROCEDURE [ val: LONG UNSPECIFIED, stBase: STBase, esei: EnumeratedSEIndex] = BEGIN OPEN Symbols, stb: stBase; sei: ISEIndex; FOR sei _ stb.FirstCtxSe[stb.seb[esei].valueCtx], stb.NextSe[sei] WHILE sei # ISENull DO IF stb.seb[sei].idValue = val THEN {PrintSei[stBase, sei]; RETURN}; ENDLOOP; PutString["LOOPHOLE ["]; PrintValue[val]; PutChar[']]; END; PrintHti: PROCEDURE [stb: STBase, hti: Symbols.HTIndex] = BEGIN IF hti = HTNull THEN ERROR; PutSubString[HtiSubString[stb, hti]]; END; PrintSei: PROCEDURE [stb: STBase, sei: Symbols.ISEIndex] = BEGIN IF sei = ISENull THEN ERROR; PutSubString[IseiSubString[stb, sei]]; END; <> END. -- LupineSymbolTableImpl.