DIRECTORY
ConvertUnsafe: TYPE USING [LS, SubString, EqualSubStrings],
PrincOpsUtils: TYPE USING [BITAND, BITXOR],
FS: TYPE USING [OpenFile, Read],
SymbolOperations: TYPE,
Symbols: TYPE,
SymbolSegment: TYPE,
TimeStamp: TYPE USING [Stamp],
Tree: TYPE USING [Link, Null],
VM: TYPE USING [Interval, nullInterval, wordsPerPage, AddressForPageNumber, Allocate, Free, MakeReadOnly];
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;
file.Read[startPage, pages, b]; -- read the contents
interval.MakeReadOnly[]; -- 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 s.EqualSubStrings[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] = {
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
RETURN[IF TypeForm[stb, stb.seb[sei].idInfo] = opaque THEN $type ELSE $manifest]
ELSE
SELECT XferMode[stb, stb.seb[sei].idType]
FROM
proc, program =>
RETURN[
IF stb.seb[sei].constant
AND
NOT stb.seb[sei].extended
THEN $manifest
ELSE $val];
signal, error =>
RETURN[IF stb.seb[sei].constant THEN $manifest ELSE $val];
ENDCASE =>
RETURN[IF stb.seb[sei].constant THEN $manifest ELSE $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
THEN
b IN PackedBitCount
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 => wc ← (IF t.mds THEN 1 ELSE 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;
};