File [Ivy]<Nelson>Lupine>LupineSymbolTableImpl.mesa.
Last edited by BZM on 11-May-82 14:12:53.
Last edited by Andrew Birrell October 24, 1983 4:50 pm (changes for 3.4)
Last edited by Paul Rovner January 28, 1983 1:37 pm (changes for 4.0)
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, OpenErrorCode,
ParamPassingMethod, STBase,
String, StringNIL, SymbolHandle, SymbolID,
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 [
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, 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;
Interface file operations.
This is root interface symbol table info (from OpenInterface).
rootSTB: STBase ← NIL;
rootFile: FS.OpenFile ← FS.nullOpenFile;
rootSpace: VM.Interval ← VM.nullInterval;
rootBcd: BcdDefs.BcdBase ← NIL;
OpenInterface: PUBLIC PROCEDURE [
interfaceFilename: String,
interfaceCapability: FS.OpenFile ] =
BEGIN
ENABLE UNWIND => CloseInterface[];
symbols: BcdDefs.SGIndex;
rootFile ← interfaceCapability;
[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;
VersionStampString: PUBLIC PROCEDURE [stamp: ST.VersionStamp]
RETURNS [stampString: String] =
Be sure to set LupineSymbolTable.MaxVersionStampStringLength correctly.
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;
Enumeration routines that generate an interface's contents.
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;
The ContextProcedure's itemIndex is invalid here
because this enumeration is of the ST's outer context.
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;
General operations for types and symbols.
SymbolName: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
RETURNS [String] =
BEGIN
stb: STBase = symbol.base;
IF IsAnonymous[symbol]
THEN RETURN[NIL]
ELSE RETURN[IseiString[stb, symbol.symbol]]
END;
IsAnonymous: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
RETURNS [yes: BOOLEAN] =
{RETURN[symbol.base.seb[symbol.symbol].hash = HTNull]};
SymbolType: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
RETURNS [type: ST.TypeHandle] = {
RETURN[ST.TypeHandle[symbol.base, SymType[symbol.base, symbol.symbol]]]};
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;
SymbolUniqueID: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
RETURNS [uniqueID: ST.SymbolID] = {
RETURN[LOOPHOLE[@symbol.base.seb[symbol.symbol]]]};
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
This array size code is from from SymbolPack.WordsForType.
It's been changed to work properly for CARDINAL, INTEGER, etc.,
index types, for which the compiler's Cardinality is zero!
bits: LONG CARDINAL;
cardinality: ST.Words = WITH indexInfo: GetTypeInfo[type: index] SELECT FROM
Basic => indexInfo.cardinality,
ENDCASE => ERROR;
RETURN[
IF (bits𡤎lements.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] =
In many discriminating SELECT statements, an SEIndex
is properly known to be an ISEIndex, but Mesa cannot infer this
because both are relative pointers. This procedure captures
the coercion.
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;
IseiString: PROCEDURE [stb: STBase, isei: ISEIndex]
RETURNS[ String] =
INLINE BEGIN
RETURN[HtiString[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;
Detailed operations for types.
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 =>
This code automatically handles INT, CHAR, BOOL
and other synonyms. It could cause unforeseeable
problems with future builtin types. Beware.
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: 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: 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: 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
Checks to see if the candidate type ID = FullTypeName.
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;
Type printing routines. The output must be compilable.
Most of these routines are derived from <Mesa>Lister>ListPub.mesa.
PutTypeName: PUBLIC PROCEDURE [
putProc: PROC[CHARACTER],
type: ST.TypeHandle,
includeReadonly: BOOLEAN←TRUE,
rootInterfaceOpenName: String←ST.StringNIL ] =
BEGIN ENABLE UNWIND => putChar ← NIL;
putChar ← putProc;
rootInterfaceQualifier ← rootInterfaceOpenName;
[] ← PrintType[
stBase: type.base,
tsei: type.type,
printReadonly: includeReadonly,
dosub: NoSub ];
putChar ← NIL;
rootInterfaceQualifier ← NIL;
END;
These global routines are used by PrintType and friends (below).
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 ← n/radix;
IF n < 0 THEN { PutChar['-]; n ← -n };
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 ]
RETURNS [vf: ValFormat ← [none[]] ] =
BEGIN OPEN Symbols, stBase; -- This damn OPEN was here when I arrived!
PrintReadonly: PROC [wantReadonly: BOOLEAN] =
BEGIN
Exclude only the top-level appearance of READONLY in a type expression.
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
This prints variant records in the Cedar style.
For example: short red Dress => Dress[red][short].
Old variant record code:
UNTIL (tsei ← TypeLink[tsei]) = SENull DO
WITH seb[tsei] SELECT FROM
id => {PutChar[' ]; PrintSei[stBase, ISEI[tsei]]};
ENDCASE;
ENDLOOP;
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
basic => 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 monitored THEN PutString["MONITORED "];
The LOCK field is printed below, so MONITORED is redundant.
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] =
BEGIN
WITH argRes: seb[type] SELECT FROM
record => PrintFieldCtx[stBase, argRes.fieldCtx];
any => PutString["ANY"];
ENDCASE => ERROR;--?--
END;
IF safe THEN PutString["SAFE "];
PrintModeName[mode];
IF typeIn # RecordSENull THEN
BEGIN
PutChar[' ];
ArgRes[typeIn];
END;
IF typeOut # RecordSENull THEN
BEGIN
PutString[" RETURNS "];
ArgRes[typeOut];
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
This has changes to (TRY) do intervals with negative endpoints
such as (3..-1]) correctly.
It still has problems for values not contained in LONG INTEGERs.
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 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] =
BEGIN
PrintFieldItem: ContextProcedure =
BEGIN
IF itemIndex > 1 THEN PutString[", "];
IF ~IsAnonymous[[itemStb, itemIsei]]
THEN {PrintSei[itemStb, itemIsei]; PutString[": "] };
PrintSymbolType[itemStb, itemIsei];
END;
PutChar['[];
[] ← 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;
Module Initialization
END. -- LupineSymbolTableImpl.