-- File [Ivy]<Nelson>Lupine>LupineSymbolTableImpl.mesa.
-- Last edited by BZM on 11-May-82 14:12:53.
-- Last edited by Andrew Birrell October 4, 1982 1:09 pm (changes for 3.4)
-- Last edited by Paul Rovner January 28, 1983 1:37 pm (changes for 4.0)
DIRECTORY
-- Cedar-only symbol table interface (can be easily converted to Mesa):
AMTypes USING [Error],
Rope USING[ ToRefText ],
RTSymbolDefs USING[ SymbolTableBase, SymbolIdIndex ],
RTSymbolOps USING[ EnumerateCtxIseis, NullISEI, NullCtx, ISECtx ],
RTSymbols USING [AcquireSTBFromSGI, ReleaseSTB ],
-- Mesa-compatible interfaces:
BcdDefs USING [FTSelf, SGIndex, SGNull, VersionID],
BcdOps USING [BcdBase, ProcessSegs, SGHandle],
CWF USING [FWF1],
Directory USING [Error, GetProps],
File USING [Capability, nullCapability, PageNumber],
Inline USING [LowHalf],
LongString USING [
AppendChar, AppendLongNumber, AppendNumber,
AppendSubString, EqualSubStrings ],
LupineSymbolTable USING [
ComponentProcedure,
DirectoryProcedure, FullTypeName, GMT,
Index, InterfaceInfo, OpenErrorCode,
ParamPassingMethod, STBase,
String, StringNIL, SymbolHandle, SymbolID,
TransferProcedure, TransferTypes, TypeHandle,
TypeInfo, VariantProcedure, VersionStamp, Words ],
Space USING [
Create, Delete, Handle, LongPointer,
Map, nullHandle, virtualMemory ],
Strings: TYPE Strings USING [SubString, SubStringDescriptor],
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];
LupineSymbolTableImpl: PROGRAM
IMPORTS AMTypes, BcdOps, CWF, Directory, Inline, LongString, Rope, RTSymbolOps,
RTSymbols, Space
EXPORTS LupineSymbolTable
SHARES LupineSymbolTable
= BEGIN OPEN Symbols, ST: LupineSymbolTable;
STBase: TYPE = ST.STBase;
String: TYPE = ST.String;
AllocString: TYPE = STRING ← NIL;
-- Circumvent String = MaxFilenameLength problem.
AllocSubString: TYPE = Strings.SubStringDescriptor ←
[base: NIL, offset: NULL, length: NULL] | NULL;
MaxFilenameLength: INTEGER = 100;
MaxIdentifierLength: INTEGER = 150;
-- Interface file operations.
-- This is root interface symbol table info (from OpenInterface).
rootSTB: STBase ← NIL;
rootFile: File.Capability ← File.nullCapability;
rootSpace: Space.Handle ← Space.nullHandle;
rootBcd: BcdOps.BcdBase ← NIL;
OpenInterface: PUBLIC PROCEDURE [
interfaceFilename: String,
interfaceCapability: File.Capability ] =
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,
mesaSymbolsOK: TRUE
! AMTypes.Error =>
BEGIN
temp: REF TEXT = Rope.ToRefText[msg];
IF reason = noSymbols
THEN ERROR OpenError[LOOPHOLE[temp,String], 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 # Space.nullHandle THEN Space.Delete[rootSpace];
rootSTB ← NIL;
rootFile ← File.nullCapability;
rootSpace ← Space.nullHandle;
rootBcd ← NIL;
END;
GetInterfaceInfo: PUBLIC PROCEDURE [
moduleNameString, fileNameString: String←NIL ]
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;
dummy: AllocString = [MaxFilenameLength];
contents ← []; -- Initialize contents.
[] ← EnumerateContext[
ctxStb: rootSTB, ctx: rootSTB.stHandle.outerCtx, ctxProc: CheckContents];
GetModuleInfo[ rootSTB, OwnMdi,
(moduleName ← moduleNameString), (fileName ← fileNameString)];
moduleVersion ← rootSTB.stHandle.version;
moduleCreateTime ←
Directory.GetProps[rootFile, dummy ! Directory.Error => CONTINUE].createDate;
sourceCreateTime ← LOOPHOLE[rootSTB.stHandle.sourceVersion.time];
END;
VersionStampString: PUBLIC PROCEDURE [stamp: ST.VersionStamp, string: String]
RETURNS [stampString: String] =
-- Be sure to set LupineSymbolTable.MaxVersionStampStringLength correctly.
BEGIN OPEN LongString;
stampString ← string;
stampString.length ← 0;
AppendNumber[stampString, stamp.net, 8]; AppendChar[stampString, '#];
AppendNumber[stampString, stamp.host, 8]; AppendChar[stampString, '#];
AppendLongNumber[stampString, stamp.time, 8];
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←ST.StringNIL] =
--INLINE-- BEGIN
IF moduleName # ST.StringNIL
THEN HtiString[stBase, stBase.mdb[module].moduleId, moduleName];
IF fileName # ST.StringNIL
THEN HtiString[stBase, stBase.mdb[module].fileId, fileName];
END;
LoadVersionError: ERROR = CODE;
LoadUpBcd: PROC [bcdFile: File.Capability]
RETURNS [bcdSpace: Space.Handle←Space.nullHandle, bcd: BcdOps.BcdBase] =
BEGIN
bcdSpaceBase: File.PageNumber ← 1;
pages: CARDINAL;
BEGIN ENABLE UNWIND => IF bcdSpace#Space.nullHandle THEN Space.Delete[bcdSpace];
bcdSpace ← Space.Create[size: 1, parent: Space.virtualMemory];
Space.Map[space: bcdSpace, window: [file: bcdFile, base: bcdSpaceBase]];
bcd ← Space.LongPointer[bcdSpace];
IF bcd.versionIdent # BcdDefs.VersionID THEN ERROR LoadVersionError;
pages ← bcd.nPages;
IF pages > 1 THEN
BEGIN
Space.Delete[bcdSpace];
bcdSpace ← Space.Create[size: pages, parent: Space.virtualMemory];
Space.Map[space: bcdSpace, window: [file: bcdFile, base: bcdSpaceBase]];
bcd ← Space.LongPointer[bcdSpace];
END;
END;
END;
GetOwnSymbolsSGI: PROC [ownBcd: BcdOps.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: AllocString = [MaxIdentifierLength];
fileName: AllocString = [MaxFilenameLength];
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;
GetModuleInfo[itemStb, module, moduleName, fileName];
FOR chr: CARDINAL IN [0..fileName.length) DO
IF fileName[chr] = '. THEN {fileName.length ← chr; EXIT};
ENDLOOP;
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,
mesaSymbolsOK: TRUE
!
AMTypes.Error =>
BEGIN
temp: REF TEXT = Rope.ToRefText[msg];
IF reason = noSymbols THEN ERROR OpenError[LOOPHOLE[temp,String], badFileName];
END ];
END;
-- General operations for types and symbols.
SymbolName: PUBLIC PROCEDURE [symbol: ST.SymbolHandle, nameString: String]
RETURNS [name: String←NULL] =
BEGIN
stb: STBase = symbol.base;
name ← nameString;
IF IsAnonymous[symbol]
THEN name.length ← 0
ELSE IseiString[stb, symbol.symbol, name];
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
IseiSubString[
stb: thisBase,
isei: ISEI[thisType],
iseiSubString: @thisName ];
HtiSubString[
stb: thisBase,
hti: ModuleHtiOfTypeName[thisBase, ISEI[thisType]],
htiSubString: @thisModule ];
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←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-- htiSubString: Strings.SubString] =
INLINE BEGIN -- hti=HTNull is OK; returns null substring.
stb.SubStringForHash[htiSubString, hti];
END;
HtiString: PROCEDURE [stb: STBase, hti: HTIndex,
--RETURNS-- htiString: String] =
BEGIN
desc: Strings.SubStringDescriptor;
sub: Strings.SubString = @desc;
HtiSubString[stb, hti, sub];
htiString.length ← 0;
LongString.AppendSubString[htiString, sub];
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-- iseiSubString: Strings.SubString] =
--INLINE-- BEGIN
HtiSubString[ stb,
(IF isei=ISENull THEN HTNull ELSE stb.seb[isei].hash),
iseiSubString ];
END;
IseiString: PROCEDURE [stb: STBase, isei: ISEIndex,
--RETURNS-- iseiString: String] =
INLINE BEGIN
HtiString[ stb,
(IF isei=ISENull THEN HTNull ELSE stb.seb[isei].hash),
iseiString ];
END;
StringEqualSubString: PROCEDURE [a: String, b: Strings.SubString]
RETURNS [--exactMatch:-- BOOLEAN] =
INLINE BEGIN
RETURN [a.length=b.length AND SlowStringEqualSubString[a,b]];
END;
SlowStringEqualSubString: PROCEDURE [a: String, b: Strings.SubString]
RETURNS [exactMatch: BOOLEAN] =
BEGIN
aSub: AllocSubString ← [base: a, offset: 0, length: a.length];
RETURN[LongString.EqualSubStrings[@aSub,b]];
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"L, "ROPE"L], 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: FALSE, -- SAFE: 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, @candidate];
IF ~StringEqualSubString[type.name, @candidate] THEN RETURN[FALSE];
HtiSubString[
stb: candidateStb,
hti: ModuleHtiOfTypeName[candidateStb, candidateIsei],
htiSubString: @candidate];
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 [0..prefix.length) DO
IF typeName.base[typeName.offset+i] # prefix[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;
typeName: AllocSubString;
IseiSubString[paramStb, paramIsei, @typeName];
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
IseiSubString[component.base, component.symbol, @componentName];
SELECT TRUE FROM
gotFirst => NULL;
StringEqualSubString["first"L, @componentName] =>
{gotFirst ← TRUE;
base ← componentType.base;
first ← componentType.type};
ENDCASE => NULL;
SELECT TRUE FROM
gotRest => NULL;
StringEqualSubString["rest"L, @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 OPEN Strings;
subString: SubStringDescriptor ←
[standardType, 0, standardType.length];
typesISE ← standardStb.SearchContext[
hti: 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] =
--INLINE-- BEGIN
FOR i: CARDINAL IN [0..str.length) DO PutChar[str[i]] ENDLOOP;
END;
PutSubString: PROC [subStr: Strings.SubString] =
--INLINE-- BEGIN
FOR i: CARDINAL IN [subStr.offset..subStr.offset+subStr.length) DO
PutChar[subStr.base[i]];
ENDLOOP;
END;
PutDecimal: PROC [int: LONG INTEGER] =
--INLINE-- {CWF.FWF1[putChar, "%LD", @int]};
PutOctal: PROC [num: LONG CARDINAL, trailingB: BOOLEAN←TRUE] =
--INLINE-- {CWF.FWF1[putChar, "%LB", @num]; IF trailingB THEN PutChar['B]};
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 "L];
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[", "L];
PrintSei[itemStb, itemIsei];
END;
IF machineDep THEN PutString["MACHINE DEPENDENT "L];
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 "L];
-- The LOCK field is printed below, so MONITORED is redundant.
IF machineDep THEN PutString["MACHINE DEPENDENT "L];
PutString[IF painted THEN "RECORD "L ELSE "STRUCT "L];
PrintFieldCtx[stBase, fieldCtx];
END;
END;
ref =>
IF ~list
THEN { -- Normal POINTER or REF.
IF ordered THEN PutString["ORDERED "L];
IF basing THEN PutString["BASE "L];
PutString[IF counted THEN "REF "L ELSE "POINTER"L];
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 "L];
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 "L];
PrintReadonly[readOnly];
[] ← PrintType[firstBase, firstBody, NoSub] };
array =>
BEGIN
IF packed THEN PutString["PACKED "L];
PutString["ARRAY "L];
[] ← PrintType[stBase, indexType, NoSub];
PutString[" OF "L];
[] ← PrintType[stBase, componentType, NoSub];
END;
arraydesc =>
BEGIN
PutString["DESCRIPTOR FOR "L];
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"L];
ENDCASE => ERROR;--?--
END;
-- SAFE: IF safe THEN PutString["SAFE "L];
PrintModeName[mode];
IF typeIn # RecordSENull THEN
BEGIN
PutChar[' ];
ArgRes[typeIn];
END;
IF typeOut # RecordSENull THEN
BEGIN
PutString[" RETURNS "L];
ArgRes[typeOut];
END;
END;
union =>
BEGIN
tagType: SEIndex;
PutString["SELECT "L];
IF ~controlled THEN
IF overlaid THEN PutString["OVERLAID "L]
ELSE PutString["COMPUTED "L]
ELSE BEGIN PrintSei[stBase, tagSei]; PutString[": "L] END;
tagType ← seb[tagSei].idType;
IF seb[tagSei].public # defaultPublic THEN
PutString[
IF defaultPublic THEN "PRIVATE "L ELSE "PUBLIC "L];
WITH seb[tagType] SELECT FROM
id => [] ← PrintType[stBase, tagType, NoSub];
cons => PutChar['*];
ENDCASE;
PutString[" FROM "L];
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[", "L];
PrintSei[stBase, isei];
PutString[" => "L];
varRec ← seb[isei].idInfo;
PrintFieldCtx[stBase, seb[varRec].fieldCtx];
ENDLOOP;
PutString[" ENDCASE"L];
END;
END;
sequence =>
BEGIN
IF packed THEN PutString["PACKED "L];
PutString["SEQUENCE "L];
IF controlled
THEN {PrintSei[stBase, tagSei]; PutString[": "L]}
ELSE PutString["COMPUTED "L];
[] ← PrintType[stBase, SymType[stBase,tagSei], NoSub];
PutString[" OF "L];
[] ← PrintType[stBase, componentType, NoSub];
END;
relative =>
BEGIN
IF baseType # SENull
THEN [] ← PrintType[stBase, baseType, NoSub, printReadonly];
PutString[" RELATIVE "L];
[] ← 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[".."L];
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 "L];
[] ← PrintType[stBase, rangeType, NoSub, printReadonly];
END;
real => PutString["REAL"L];
opaque =>
BEGIN
PutString["TYPE"L];
IF lengthKnown THEN {
PutString[" ["L]; PrintValue[length]; PutString["]"L]; };
END;
zone => --Not totally corrrect for MdsZone:--
PutString[IF ~counted THEN "UNCOUNTED ZONE"L ELSE "ZONE"L];
any => PutString["ANY"L];
ENDCASE => PutString["--!!!Unknown Type!!!--"L];
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 "L ELSE "PRIVATE "L];
END;
IF seb[sei].idType = typeTYPE
THEN BEGIN
typeSei ← seb[sei].idInfo;
PutString["TYPE = "L];
[] ← 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[" = "L];
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[", "L];
IF ~IsAnonymous[[itemStb, itemIsei]]
THEN {PrintSei[itemStb, itemIsei]; PutString[": "L] };
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"L, "PORT"L, "SIGNAL"L, "ERROR"L,
"PROCESS"L, "PROGRAM"L, "NONE"L];
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[Inline.LowHalf[val]]}
ELSE {PutOctal[num: 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 ["L]; PrintValue[val]; PutChar[']];
END;
PrintHti: PROCEDURE [stb: STBase, hti: Symbols.HTIndex] =
BEGIN
subStr: AllocSubString;
IF hti = HTNull THEN ERROR;
HtiSubString[stb, hti, @subStr];
PutSubString[@subStr];
END;
PrintSei: PROCEDURE [stb: STBase, sei: Symbols.ISEIndex] =
BEGIN
subStr: AllocSubString;
IF sei = ISENull THEN ERROR;
IseiSubString[stb, sei, @subStr];
PutSubString[@subStr];
END;
-- Module Initialization
END. -- LupineSymbolTableImpl.