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;
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;
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] =
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;
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
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;
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 =>
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: 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
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;
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 ];
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 ;
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
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
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, 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
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 ~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;
Module Initialization
END. -- LupineSymbolTableImpl.