Base: TYPE = Symbols.Base;
BitAddress: TYPE = Symbols.BitAddress;
BitCount: TYPE = Symbols.BitCount;
BTIndex:
TYPE = Symbols.BTIndex;
BTNull: BTIndex = Symbols.BTNull;
CSEIndex:
TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
typeANY: CSEIndex = Symbols.typeANY;
typeTYPE: CSEIndex = Symbols.typeTYPE;
CTXIndex:
TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
ExtIndex:
TYPE = SymbolSegment.ExtIndex;
ExtNull: ExtIndex = SymbolSegment.ExtNull;
ExtensionType: TYPE = Symbols.ExtensionType;
FGHeader: TYPE = SymbolSegment.FGHeader;
FGHeaderPtr: TYPE = LONG POINTER TO FGHeader;
FGTEntry: TYPE = SymbolSegment.FGTEntry;
FieldBitCount: TYPE = Symbols.FieldBitCount;
ISEIndex:
TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
HashVector: TYPE = Symbols.HashVector;
HTRecord: TYPE = Symbols.HTRecord;
HVIndex: TYPE = Symbols.HVIndex;
Linkage: TYPE = Symbols.Linkage;
LongString: TYPE = ConvertUnsafe.LS;
MDIndex:
TYPE = Symbols.MDIndex;
MDNull: MDIndex = Symbols.MDNull;
MDRecord: TYPE = Symbols.MDRecord;
Name:
TYPE = Symbols.Name;
nullName: Name = Symbols.nullName;
PackedBitCount: TYPE = Symbols.PackedBitCount;
RecordSEIndex:
TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
RefClass: TYPE = Symbols.RefClass;
SEIndex:
TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
STHeader: TYPE = SymbolSegment.STHeader;
STHeaderPtr: TYPE = LONG POINTER TO STHeader;
SubString: TYPE = ConvertUnsafe.SubString;
TransferMode: TYPE = Symbols.TransferMode;
Type:
TYPE = Symbols.Type;
nullType: Type = Symbols.nullType;
TypeClass: TYPE = Symbols.TypeClass;
WordCount: TYPE = Symbols.WordCount;
WordLength: NAT = Symbols.WordLength;
wordsPerPage: NAT = VM.wordsPerPage;
wordFill: CARDINAL = WordLength-1;
SymbolTableBase: TYPE = SymbolOperations.SymbolTableBase;
SymbolTableBaseRep:
TYPE = SymbolOperations.SymbolTableBaseRep;
Acquire:
PUBLIC PROC
[file: FS.OpenFile, startPage: CARDINAL, pages: CARDINAL]
RETURNS [stb: SymbolTableBase ← NIL] = {
interval: VM.Interval = VM.Allocate[count: pages];
b: LONG POINTER = VM.AddressForPageNumber[interval.page];
tB: SymbolSegment.Base = LOOPHOLE[b];
p: STHeaderPtr = b;
q: FGHeaderPtr;
FS.Read[file, startPage, pages, b]; -- read the contents
VM.MakeReadOnly[interval]; -- don't want anyone messing with our tables
stb ← NEW[SymbolTableBaseRep];
stb.file ← file;
stb.interval ← interval;
stb.hashVec ← b+p.hvBlock.offset;
stb.ht ← DESCRIPTOR[b+p.htBlock.offset, p.htBlock.size/SIZE[Symbols.HTRecord]];
stb.ssb ← b + p.ssBlock.offset;
stb.seb ← tB + p.seBlock.offset;
stb.ctxb ← tB + p.ctxBlock.offset;
stb.mdb ← tB + p.mdBlock.offset;
stb.bb ← tB + p.bodyBlock.offset;
stb.tb ← tB + p.treeBlock.offset;
stb.ltb ← tB + p.litBlock.offset;
stb.extb ← tB + p.extBlock.offset;
stb.mdLimit ← FIRST[Symbols.MDIndex] + p.mdBlock.size;
stb.extLimit ← FIRST[SymbolSegment.ExtIndex] + p.extBlock.size;
stb.mainCtx ← p.outerCtx;
stb.stHandle ← p;
IF p.fgRelPgBase = 0
OR pages <= p.fgRelPgBase
THEN {
No fine-grain table
stb.sourceFile ← NIL;
stb.fgTable ← NIL;
}
ELSE {
There is a fine-grain table
q ← b + p.fgRelPgBase*wordsPerPage;
stb.sourceFile ← LOOPHOLE[@q.sourceFile];
stb.fgTable ←
DESCRIPTOR[
LOOPHOLE[stb.sourceFile, LONG POINTER TO ARRAY OF FGTEntry],
q.length];
};
};
Release:
PUBLIC PROC [stb: SymbolTableBase] = {
interval: VM.Interval = stb.interval;
IF interval #
VM.nullInterval
THEN {
VM.Free[interval];
stb^ ← []; -- ground state
};
};
hash manipulation
FindString:
PUBLIC PROC [stb: SymbolTableBase, s: SubString]
RETURNS [name: Name] = {
ss: SubString;
name ← stb.hashVec[HashValue[stb, s]];
WHILE name # nullName
DO
ss ← SubStringForName[stb, name];
IF ConvertUnsafe.EqualSubStrings[s, ss] THEN EXIT;
name ← stb.ht[name].link;
ENDLOOP;
};
HashValue:
PUBLIC PROC [stb: SymbolTableBase, s: SubString]
RETURNS [HVIndex] = {
CharBits: PROC [CHAR, WORD] RETURNS [WORD] = LOOPHOLE[PrincOpsUtils.BITAND];
Mask: WORD = 337b; -- masks out ASCII case shifts
v:
WORD = CharBits[s.base[s.offset], Mask]*177b
+ CharBits[s.base[s.offset+(s.length-1)], Mask];
RETURN [PrincOpsUtils.BITXOR[v, s.length*17b] MOD stb.hashVec^.LENGTH];
};
SubStringForName:
PUBLIC
PROC
[stb: SymbolTableBase, name: Name] RETURNS[s: SubString] = {
s.base ← stb.ssb;
IF name = nullName
THEN s.offset ← s.length ← 0
ELSE s.length ← stb.ht[name].ssIndex - (s.offset ← stb.ht[name-1].ssIndex);
};
context management
CtxEntries:
PUBLIC PROC
[stb: SymbolTableBase, ctx: CTXIndex] RETURNS [n: CARDINAL𡤀] = {
IF ctx = CTXNull THEN RETURN;
WITH c: stb.ctxb[ctx]
SELECT
FROM
included => IF ~c.reset THEN RETURN;
ENDCASE;
FOR sei: ISEIndex ← FirstCtxSe[stb, ctx], NextSe[stb, sei]
UNTIL sei = ISENull DO n ← n+1;
ENDLOOP;
};
FirstCtxSe:
PUBLIC PROC [stb: SymbolTableBase, ctx: CTXIndex]
RETURNS [ISEIndex] = {
RETURN [IF ctx = CTXNull THEN ISENull ELSE stb.ctxb[ctx].seList];
};
NextSe:
PUBLIC PROC
[stb: SymbolTableBase, sei: ISEIndex] RETURNS [ISEIndex ← ISENull] = {
IF sei # ISENull
THEN {
WITH id: stb.seb[sei]
SELECT
FROM
sequential => RETURN[sei + SERecord.id.sequential.SIZE];
linked => RETURN[id.link];
ENDCASE;
};
};
SearchContext:
PUBLIC PROC
[stb: SymbolTableBase, name: Name, ctx: CTXIndex] RETURNS [ISEIndex ← ISENull] = {
sei, root: ISEIndex;
IF ctx # CTXNull
AND name # nullName
THEN {
sei ← root ← stb.ctxb[ctx].seList;
DO
IF sei = ISENull THEN EXIT;
IF stb.seb[sei].hash = name THEN RETURN [sei];
WITH id: stb.seb[sei]
SELECT
FROM
sequential => sei ← sei + SERecord.id.sequential.SIZE;
linked => IF (sei ← id.link) = root THEN EXIT;
ENDCASE => EXIT;
ENDLOOP;
};
};
SeiForValue:
PUBLIC PROC
[stb: SymbolTableBase, value: CARDINAL, ctx: CTXIndex]
RETURNS [ISEIndex ← ISENull] = {
FOR sei: ISEIndex ← FirstCtxSe[stb, ctx], NextSe[stb, sei]
UNTIL sei = ISENull
DO
IF stb.seb[sei].idValue = value THEN RETURN [sei]
ENDLOOP;
};
module management
FindMdi:
PUBLIC PROC
[stb: SymbolTableBase, stamp: TimeStamp.Stamp] RETURNS [MDIndex ← MDNull] = {
FOR mdi: MDIndex ← MDIndex.
FIRST, mdi + MDRecord.
SIZE
UNTIL mdi = stb.mdLimit
DO
IF stb.mdb[mdi].stamp = stamp THEN RETURN [mdi] ENDLOOP;
};
type manipulation
ArgCtx:
PUBLIC PROC [stb: SymbolTableBase, type: CSEIndex]
RETURNS [CTXIndex] = {
sei: RecordSEIndex = ArgRecord[stb, type];
RETURN [IF sei = RecordSENull THEN CTXNull ELSE stb.seb[sei].fieldCtx];
};
ArgRecord:
PUBLIC PROC
[stb: SymbolTableBase, type: CSEIndex] RETURNS [RecordSEIndex ← RecordSENull] = {
IF type # nullType
THEN {
WITH stb.seb[type]
SELECT
FROM
record => RETURN [LOOPHOLE[type, RecordSEIndex]];
ENDCASE;
};
};
ClusterSe:
PUBLIC PROC [stb: SymbolTableBase, type: Type]
RETURNS [Type] = {
WITH t: stb.seb[type]
SELECT
FROM
id => {
next: Type = t.idInfo;
IF
NOT t.extended
THEN
WITH u: stb.seb[next]
SELECT
FROM
id => IF t.hash = u.hash THEN RETURN[ClusterSe[stb, next]];
ENDCASE;
};
ENDCASE;
RETURN [type];
};
NormalType:
PUBLIC PROC
[stb: SymbolTableBase, type: CSEIndex] RETURNS [nType: CSEIndex] = {
WITH t: stb.seb[type]
SELECT
FROM
subrange => nType ← NormalType[stb, UnderType[stb, t.rangeType]];
long, real => nType ← NormalType[stb, UnderType[stb, t.rangeType]];
ENDCASE => nType ← type;
};
RecordLink:
PUBLIC PROC
[stb: SymbolTableBase, type: RecordSEIndex] RETURNS [RecordSEIndex ← RecordSENull] = {
WITH t: stb.seb[type]
SELECT
FROM
linked => RETURN [LOOPHOLE[UnderType[stb, t.linkType], RecordSEIndex]];
ENDCASE;
};
RecordRoot:
PUBLIC PROC
[stb: SymbolTableBase, type: RecordSEIndex] RETURNS [root: RecordSEIndex] = {
root ← type;
FOR next: RecordSEIndex ← RecordLink[stb, root], RecordLink[stb, next]
WHILE next # RecordSENull DO root ← next ENDLOOP;
};
ReferentType:
PUBLIC PROC
[stb: SymbolTableBase, type: CSEIndex] RETURNS [CSEIndex ← typeANY] = {
sei: CSEIndex = NormalType[stb, type];
WITH t: stb.seb[sei]
SELECT
FROM
ref => RETURN[UnderType[stb, t.refType]];
ENDCASE;
};
TransferTypes:
PUBLIC PROC
[stb: SymbolTableBase, type: Type]
RETURNS [typeIn, typeOut: RecordSEIndex ← RecordSENull] = {
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei]
SELECT
FROM
transfer => {
typeIn ← ArgRecord[stb, t.typeIn];
typeOut ← ArgRecord[stb, t.typeOut];
};
ENDCASE;
};
TypeForm:
PUBLIC PROC [stb: SymbolTableBase, type: Type]
RETURNS [TypeClass ← nil] = {
IF type # nullType THEN RETURN[stb.seb[UnderType[stb, type]].typeTag];
};
TypeLink:
PUBLIC PROC
[stb: SymbolTableBase, type: Type] RETURNS [Type ← nullType] = {
sei: CSEIndex = UnderType[stb, type];
WITH se: stb.seb[sei]
SELECT
FROM
record => WITH se SELECT FROM linked => RETURN [linkType]; ENDCASE;
ENDCASE;
};
TypeRoot:
PUBLIC PROC [stb: SymbolTableBase, type: Type]
RETURNS [root: Type] = {
root ← type;
FOR next: Type ← TypeLink[stb, root], TypeLink[stb, next]
WHILE next # nullType
DO
root ← next;
ENDLOOP;
};
UnderType:
PUBLIC PROC [stb: SymbolTableBase, type: Type]
RETURNS [CSEIndex] = {
sei: Type ← type;
WHILE sei # nullType
DO
WITH se: stb.seb[sei]
SELECT
FROM
id => {IF se.idType # typeTYPE THEN ERROR; sei ← se.idInfo};
ENDCASE => EXIT;
ENDLOOP;
RETURN [LOOPHOLE[sei, CSEIndex]];
};
XferMode:
PUBLIC PROC
[stb: SymbolTableBase, type: Type] RETURNS [TransferMode ← none] = {
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei]
SELECT
FROM
transfer => RETURN [t.mode];
ENDCASE;
};
information returning procedures
Untruncate:
PRIVATE
PROC [n:
CARDINAL]
RETURNS [
LONG
CARDINAL] = {
IF n # 0 THEN RETURN [n];
RETURN [CARDINAL.LAST.LONG+1];
};
BitsForRange:
PUBLIC PROC
[stb: SymbolTableBase, maxValue: CARDINAL] RETURNS [nBits: CARDINAL ← 1] = {
fieldMax: CARDINAL ← 1;
WHILE nBits < WordLength
AND fieldMax < maxValue
DO
nBits ← nBits + 1;
fieldMax ← 2*fieldMax + 1;
ENDLOOP;
};
BitsForType:
PUBLIC PROC [stb: SymbolTableBase, type: Type]
RETURNS [BitCount ← 0] = {
sei: CSEIndex = UnderType[stb, type];
IF sei # CSENull
THEN {
n: BitCount ← 0;
WITH t: stb.seb[sei]
SELECT
FROM
basic => n ← t.length;
enumerated =>
IF NOT t.empty THEN RETURN[BitsForRange[stb, Cardinality[stb, sei]-1]];
record => n ← t.length;
array => {
n ← BitsPerElement[stb, t.componentType, t.packed]*Cardinality[stb, t.indexType];
IF n > WordLength
THEN
n ← ((n + wordFill)/WordLength)*WordLength;
};
opaque => n ← t.length;
relative => n ← BitsForType[stb, t.offsetType];
subrange =>
IF NOT t.empty THEN n ← BitsForRange[stb, Cardinality[stb, sei]-1];
ENDCASE => n ← WordsForType[stb, sei]*WordLength;
RETURN [n];
};
};
PackedSize: ARRAY PackedBitCount OF CARDINAL = [1, 2, 4, 4, 8, 8, 8, 8];
BitsPerElement:
PUBLIC PROC
[stb: SymbolTableBase, type: Type, packed: BOOL] RETURNS [BitCount] = {
nBits: BitCount = BitsForType[stb, type];
RETURN [
IF packed
AND (nBits#0
AND nBits<=PackedBitCount.
LAST)
-- IN PackedBitCount
THEN PackedSize[PackedBitCount[nBits]]
ELSE (nBits+wordFill)/WordLength * WordLength
];
};
Cardinality:
PUBLIC PROC
[stb: SymbolTableBase, type: Type] RETURNS [LONG CARDINAL ← 0] = {
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei]
SELECT
FROM
enumerated =>
compatibility hack
IF NOT t.empty THEN RETURN[Untruncate[t.nValues]];
subrange =>
IF NOT t.empty THEN RETURN[t.range.LONG+1];
basic => IF t.code = Symbols.codeCHAR THEN RETURN[256];
relative => RETURN[Cardinality[stb, t.offsetType]];
ENDCASE;
};
FindExtension:
PUBLIC PROC
[stb: SymbolTableBase, sei: ISEIndex] RETURNS [type: ExtensionType, tree: Tree.Link] = {
OPEN SymbolSegment;
FOR exti: SymbolSegment.ExtIndex ← SymbolSegment.ExtIndex.
FIRST,
exti + SymbolSegment.ExtRecord.SIZE UNTIL exti = stb.extLimit DO
IF stb.extb[exti].sei = sei THEN RETURN [stb.extb[exti].type, stb.extb[exti].tree];
ENDLOOP;
RETURN [none, Tree.Null];
};
FnField:
PUBLIC PROC
[stb: SymbolTableBase, field: ISEIndex]
RETURNS [offset: BitAddress, size: FieldBitCount] = {
word, nW: CARDINAL;
word ← 0;
FOR sei: ISEIndex ← FirstCtxSe[stb, stb.seb[field].idCtx], NextSe[stb, sei]
DO
nW ← CARDINAL[WordsForType[stb, stb.seb[sei].idType]];
IF sei = field THEN EXIT;
word ← word + nW;
ENDLOOP;
RETURN [offset: BitAddress[wd: word, bd: 0], size: nW * WordLength];
};
NameForSe:
PUBLIC PROC
[stb: SymbolTableBase, sei: ISEIndex] RETURNS [Name ← nullName] = {
IF sei # ISENull THEN RETURN[stb.seb[sei].hash];
};
LinkMode:
PUBLIC PROC [stb: SymbolTableBase, sei: ISEIndex]
RETURNS [Linkage] = {
IF stb.seb[sei].idType = typeTYPE
THEN
IF TypeForm[stb, stb.seb[sei].idInfo] = opaque
THEN RETURN[type]
ELSE RETURN[manifest]
ELSE
SELECT XferMode[stb, stb.seb[sei].idType]
FROM
proc, program =>
IF stb.seb[sei].constant
AND
NOT stb.seb[sei].extended
THEN RETURN[manifest]
ELSE RETURN[val];
signal, error =>
IF stb.seb[sei].constant THEN RETURN[manifest] ELSE RETURN[val];
ENDCASE =>
IF stb.seb[sei].constant THEN RETURN[manifest] ELSE RETURN[ref];
};
RecField:
PUBLIC PROC
[stb: SymbolTableBase, field: ISEIndex]
RETURNS [offset: BitAddress, size: FieldBitCount] = {
RETURN [offset: stb.seb[field].idValue, size: stb.seb[field].idInfo];
};
RCType:
PUBLIC PROC [stb: SymbolTableBase, type: CSEIndex]
RETURNS [RefClass] = {
next: Type;
struc: RefClass ← simple;
FOR sei: CSEIndex ← type, UnderType[stb, next]
DO
WITH t: stb.seb[sei]
SELECT
FROM
record =>
SELECT
TRUE
FROM
~t.hints.refField => RETURN [none];
t.hints.unifield => next ← stb.seb[stb.ctxb[t.fieldCtx].seList].idType;
ENDCASE => RETURN [composite];
ref => RETURN [IF t.counted THEN struc ELSE none];
array => {struc ← composite; next ← t.componentType};
relative => next ← t.offsetType;
subrange => next ← t.rangeType;
long => next ← t.rangeType;
union => RETURN [IF t.hints.refField THEN composite ELSE none];
sequence => {struc ← composite; next ← t.componentType};
zone => RETURN [IF t.counted THEN struc ELSE none];
ENDCASE => RETURN [none];
ENDLOOP;
};
VariantField:
PUBLIC PROC
[stb: SymbolTableBase, type: CSEIndex] RETURNS [sei: ISEIndex ← ISENull] = {
WITH t: stb.seb[type]
SELECT
FROM
record =>
FOR sei ← FirstCtxSe[stb, t.fieldCtx], NextSe[stb, sei]
UNTIL sei = ISENull
DO
SELECT TypeForm[stb, stb.seb[sei].idType]
FROM
sequence, union => EXIT;
ENDCASE;
ENDLOOP;
ENDCASE;
};
WordsForType:
PUBLIC PROC
[stb: SymbolTableBase, type: Type] RETURNS [wc: WordCount ← 0] = {
sei: CSEIndex = UnderType[stb, type];
IF sei # CSENull
THEN {
itemsPerWord: ARRAY PackedBitCount OF [0..16] = [16, 8, 4, 4, 2, 2, 2, 2];
WITH t: stb.seb[sei]
SELECT
FROM
mode => wc ← 1; -- fudge for compiler (Pass4.Binding)
basic => wc ← (t.length + wordFill)/WordLength;
enumerated => IF NOT t.empty THEN wc ← 1;
record => wc ← (t.length.LONG + wordFill)/WordLength;
ref => wc ← 1;
array => {
cc: WordCount = Cardinality[stb, t.indexType];
b: BitCount = BitsPerElement[stb, t.componentType, t.packed];
IF b # 0
AND b <= PackedBitCount.
LAST
b IN PackedBitCount
THEN wc ← (cc + (itemsPerWord[b]-1))/itemsPerWord[b]
ELSE wc ← cc * ((b+wordFill)/WordLength);
};
arraydesc => wc ← 2;
transfer => wc ← IF t.mode = port THEN 2 ELSE 1;
relative => wc ← WordsForType[stb, t.offsetType];
opaque => wc ← (t.length.LONG + wordFill)/WordLength;
zone => IF t.mds THEN wc ← 1 ELSE wc ← 2;
subrange => IF NOT t.empty THEN wc ← 1;
long => wc ← WordsForType[stb, t.rangeType] + 1;
real => wc ← 2;
ENDCASE;
};
};
body table management
ParentBti:
PUBLIC PROC [stb: SymbolTableBase, bti: BTIndex]
RETURNS [BTIndex] = {
UNTIL stb.bb[bti].link.which = parent
DO
bti ← stb.bb[bti].link.index;
ENDLOOP;
RETURN [stb.bb[bti].link.index];
};
SiblingBti:
PUBLIC PROC [stb: SymbolTableBase, bti: BTIndex]
RETURNS [BTIndex] = {
RETURN [IF stb.bb[bti].link.which = sibling THEN stb.bb[bti].link.index ELSE BTNull];
};
SonBti:
PUBLIC PROC [stb: SymbolTableBase, bti: BTIndex]
RETURNS [BTIndex] = {
RETURN [stb.bb[bti].firstSon];
};
EnumerateBodies:
PUBLIC PROC
[stb: SymbolTableBase, root: BTIndex, proc: PROC [BTIndex] RETURNS [stop: BOOL]]
RETURNS [bti: BTIndex] = {
prev: BTIndex;
bti ← root;
UNTIL bti = BTNull
DO
IF proc[bti] THEN GO TO Stopped;
IF stb.bb[bti].firstSon # BTNull
THEN bti ← stb.bb[bti].firstSon
ELSE
DO
IF bti = root THEN GO TO Done;
prev ← bti;
bti ← stb.bb[bti].link.index;
IF stb.bb[prev].link.which # parent THEN EXIT;
ENDLOOP;
REPEAT
Stopped => NULL;
Done => bti ← BTNull;
ENDLOOP;
};