SymbolOpsImpl.mesa
Copyright Ó 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved.
Satterthwaite, June 18, 1986 10:28:58 am PDT
Russ Atkinson (RRA) January 20, 1989 5:02:37 pm PST
JKF October 13, 1988 12:49:08 pm PDT
Willie-s, September 24, 1991 4:52 pm PDT
DIRECTORY
Alloc USING [Handle, Index, Notifier, AddNotify, Bounds, DropNotify, Top, Units],
Basics USING [BITRSHIFT, LowHalf],
ConvertUnsafe,
Literals USING [Base],
MimZones USING [permZone],
MobDefs USING [VersionStamp],
OSMiscOps USING [WordAnd, WordXor],
SymbolOps USING [BodyVisitor, DecodeBti, PackedSize],
Symbols USING [Base, BitAddress, BitCount, bodyType, BTIndex, BTNull, codeCHAR, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, CTXRecord, ctxType, ExtensionType, HashVector, HTIndex, HTNull, HTRecord, htType, HVIndex, ISEIndex, ISENull, lG, Linkage, lL, lZ, MDFirst, MDIndex, MDNull, MDRecord, mdType, Name, nullName, nullType, RecordSEIndex, RecordSENull, RefClass, SEPointer, SERecord, seTag, seType, ssType, TransferMode, Type, typeANY, TypeClass, typeTYPE, UNSPEC],
SymbolSegment USING [Base, ExtFirst, ExtIndex, ExtRecord, extType, ltType, stType, treeType],
SymbolTable USING [],
SymbolTablePrivate USING [SymbolTableBaseRep],
Table USING [IndexRep],
Target: TYPE MachineParms USING [PackedBitCount, bitsPerAU, bitsPerWord, logBitsPerAU],
Tree USING [Base, Link, Map, Null],
UnsafeStorage USING [GetSystemUZone];
SymbolOpsImpl: PROGRAM
IMPORTS Alloc, Basics, ConvertUnsafe, MimZones, OSMiscOps, SymbolOps, UnsafeStorage
EXPORTS SymbolOps, SymbolTable = {
OPEN Symbols;
BodyVisitor: TYPE = SymbolOps.BodyVisitor;
STB: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
SubString: TYPE = ConvertUnsafe.SubString;
UNSPEC: TYPE = Symbols.UNSPEC;
bitsPerUnit: NAT = BITS[WORD];
charsPerUnit: NAT = BITS[UNIT]/BITS[CHAR];
charsPerWord: NAT = BITS[WORD]/BITS[CHAR];
loopholes for Symbols.UNSPEC
Card: PROC [value: Symbols.UNSPEC] RETURNS [CARD] = INLINE {
RETURN [LOOPHOLE[value]];
};
TypeInfo: PROC [info: Symbols.UNSPEC] RETURNS [Type] = INLINE {
RETURN [LOOPHOLE[info]];
};
hash manipulation
FindString: PUBLIC PROC [stb: STB, s: SubString] RETURNS [name: Name] = {
name ¬ stb.hashVec[HashValue[stb, s]];
WHILE name # nullName DO
ss: SubString ¬ SubStringForName[stb, name];
IF s.EqualSubStrings[ss] THEN EXIT;
name ¬ stb.htb[name].link;
ENDLOOP;
};
HashValue: PUBLIC PROC [stb: STB, s: SubString] RETURNS [HVIndex] = {
Mask: WORD = 337b; -- masks out ASCII case shifts
len: WORD ¬ s.length;
lm: WORD ¬ s.length-1;
first: WORD ¬ OSMiscOps.WordAnd[s.base[s.offset].ORD, Mask];
last: WORD ¬ OSMiscOps.WordAnd[s.base[s.offset+len-1].ORD, Mask];
RETURN [OSMiscOps.WordXor[first*200b - first + last, len*20b-len]
MOD stb.hashVec­.LENGTH];
};
SubStringForName: PUBLIC PROC
[stb: STB, name: Name] RETURNS [s: ConvertUnsafe.SubString] = {
s.base ¬ stb.ssb;
IF name = nullName
THEN s.offset ¬ s.length ¬ 0
ELSE s.length ¬ stb.htb[name].ssIndex - (s.offset ¬ stb.htb[name-HTRecord.SIZE].ssIndex+1);
};
context management
CtxLevel: PUBLIC PROC [stb: STB, ctx: CTXIndex] RETURNS [ContextLevel] = {
RETURN [IF ctx = CTXNull THEN lZ ELSE stb.ctxb[ctx].level];
};
CtxEntries: PUBLIC PROC [stb: STB, ctx: CTXIndex] RETURNS [n: CARDINAL ¬ 0] = {
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: STB, ctx: CTXIndex] RETURNS [ISEIndex] = {
RETURN [IF ctx = CTXNull THEN ISENull ELSE stb.ctxb[ctx].seList];
};
NextSe: PUBLIC PROC [stb: STB, sei: ISEIndex] RETURNS [ISEIndex] = {
IF sei # ISENull THEN
WITH id: stb.seb[sei] SELECT FROM
sequential => RETURN [sei + SERecord.id.sequential.SIZE];
linked => RETURN [id.link];
ENDCASE;
RETURN [ISENull];
};
SearchContext: PUBLIC PROC [stb: STB, name: Name, ctx: CTXIndex] RETURNS [ISEIndex] = {
IF ctx # CTXNull AND name # nullName THEN {
root: ISEIndex ¬ stb.ctxb[ctx].seList;
sei: ISEIndex ¬ root;
WHILE sei # ISENull DO
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;
};
RETURN [ISENull];
};
SeiForValue: PUBLIC PROC [stb: STB, value: UNSPEC, ctx: CTXIndex] RETURNS [ISEIndex] = {
FOR sei: ISEIndex ¬ FirstCtxSe[stb, ctx], NextSe[stb, sei] UNTIL sei = ISENull DO
IF stb.seb[sei].idValue = value THEN RETURN [sei];
ENDLOOP;
RETURN [ISENull];
};
module management
FindMdi: PUBLIC PROC [stb: STB, stamp: MobDefs.VersionStamp] RETURNS [MDIndex] = {
FOR mdi: MDIndex ¬ MDFirst, mdi + MDRecord.SIZE UNTIL mdi = stb.mdLimit DO
IF stb.mdb[mdi].stamp = stamp THEN RETURN [mdi];
ENDLOOP;
RETURN [MDNull];
};
type manipulation
ArgCtx: PUBLIC PROC [stb: STB, type: CSEIndex] RETURNS [CTXIndex] = {
sei: RecordSEIndex = ArgRecord[stb, type];
RETURN [IF sei = RecordSENull THEN CTXNull ELSE stb.seb[sei].fieldCtx];
};
ArgRecord: PUBLIC PROC [stb: STB, type: CSEIndex] RETURNS [RecordSEIndex] = {
IF type # nullType THEN
WITH stb.seb[type] SELECT FROM
record => RETURN [LOOPHOLE[type, RecordSEIndex]];
ENDCASE;
RETURN [RecordSENull];
};
ClusterSe: PUBLIC PROC [stb: STB, type: Type] RETURNS [Type] = {
DO
WITH t: stb.seb[type] SELECT FROM
id => {
next: Type = TypeInfo[t.idInfo];
IF NOT t.extended THEN
WITH u: stb.seb[next] SELECT FROM
id => IF t.hash = u.hash THEN {type ¬ next; LOOP};
ENDCASE;
};
ENDCASE;
RETURN [type];
ENDLOOP;
};
EqTypes: PUBLIC PROC [stb: STB, type1, type2: Type] RETURNS [BOOL] = {
IF type1 # type2 THEN {
ut1: CSEIndex = UnderType[stb, type1];
ut2: CSEIndex = UnderType[stb, type2];
IF ut1 # ut2 THEN {
WITH se1: stb.seb[ut1] SELECT FROM
record =>
WITH se2: stb.seb[ut2] SELECT FROM
record => {
Is this good enough?
IF se1.fieldCtx = se2.fieldCtx THEN
IF se1.painted = se2.painted THEN RETURN [TRUE];
};
ENDCASE;
ENDCASE;
RETURN [FALSE];
};
};
RETURN [TRUE];
};
NormalType: PUBLIC PROC [stb: STB, type: Type] RETURNS [CSEIndex] = {
WHILE type # nullType DO
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei] SELECT FROM
subrange => type ¬ t.rangeType;
ENDCASE => RETURN [sei];
ENDLOOP;
RETURN [CSENull];
};
RecordLink: PUBLIC PROC [stb: STB, type: RecordSEIndex] RETURNS [RecordSEIndex] = {
WITH t: stb.seb[type] SELECT FROM
linked => RETURN [LOOPHOLE[UnderType[stb, t.linkType], RecordSEIndex]];
ENDCASE;
RETURN [RecordSENull];
};
RecordRoot: PUBLIC PROC [stb: STB, type: RecordSEIndex] RETURNS [root: RecordSEIndex] = {
root ¬ type;
DO
next: RecordSEIndex ¬ RecordLink[stb, root];
IF next = RecordSENull THEN RETURN [root];
root ¬ next;
ENDLOOP;
};
ReferentType: PUBLIC PROC [stb: STB, type: Type] RETURNS [Type] = {
sei: CSEIndex = NormalType[stb, type];
WITH t: stb.seb[sei] SELECT FROM
ref => RETURN [t.refType];
ENDCASE => RETURN [typeANY];
};
TransferTypes: PUBLIC PROC
[stb: STB, type: Type] RETURNS [typeIn, typeOut: RecordSEIndex] = {
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei] SELECT FROM
transfer => RETURN [typeIn: ArgRecord[stb, t.typeIn], typeOut: ArgRecord[stb, t.typeOut]];
ENDCASE;
RETURN [RecordSENull, RecordSENull];
};
TypeForm: PUBLIC PROC [stb: STB, type: Type] RETURNS [TypeClass] = {
RETURN [IF type = nullType THEN $nil ELSE stb.seb[UnderType[stb, type]].typeTag];
};
TypeLink: PUBLIC PROC [stb: STB, type: Type] RETURNS [Type] = {
sei: CSEIndex = UnderType[stb, type];
WITH se: stb.seb[sei] SELECT FROM
record => WITH se SELECT FROM linked => RETURN [linkType]; ENDCASE;
ENDCASE;
RETURN [nullType];
};
TypeRoot: PUBLIC PROC [stb: STB, type: Type] RETURNS [root: Type] = {
root ¬ type;
DO
next: Type ¬ TypeLink[stb, root];
IF next = nullType THEN RETURN [root];
root ¬ next;
ENDLOOP;
};
UnderType: PUBLIC PROC [stb: STB, type: Type] RETURNS [CSEIndex] = {
sei: Type ¬ type;
WHILE sei # nullType DO
sep: SEPointer = @stb.seb[sei];
IF LOOPHOLE[sei, Table.IndexRep].tag # seTag THEN ERROR;
This happens if a truly nasty sei is used
WITH se: sep­ SELECT FROM
id => {IF se.idType # typeTYPE THEN ERROR; sei ¬ TypeInfo[se.idInfo]};
cons => EXIT;
ENDCASE => ERROR;
ENDLOOP;
RETURN [LOOPHOLE[sei, CSEIndex]];
};
XferMode: PUBLIC PROC [stb: STB, type: Type] RETURNS [TransferMode] = {
sei: CSEIndex = UnderType[stb, type];
RETURN [WITH t: stb.seb[sei] SELECT FROM transfer => t.mode, ENDCASE => $none];
};
information returning procedures
bitsPerAU: CARDINAL = Target.bitsPerAU;
bitsPerWord: CARDINAL = Target.bitsPerWord;
unitFill: CARDINAL = bitsPerAU-1;
AUsForType: PUBLIC PROC [stb: STB, type: Type] RETURNS [CARD] = {
Gives a conservative estimate
RETURN [Basics.BITRSHIFT[BitsForType[stb, type]+unitFill, Target.logBitsPerAU]];
};
BitsForType: PUBLIC PROC [stb: STB, type: Type] RETURNS [b: BitCount ¬ 0] = {
Gives a conservative estimate
DO
sei: CSEIndex = UnderType[stb, type];
IF sei = CSENull THEN RETURN [0];
WITH t: stb.seb[sei] SELECT FROM
mode => {b ¬ bitsPerWord; EXIT};
basic => {b ¬ t.length; EXIT};
signed => {b ¬ t.length; EXIT};
unsigned => {b ¬ t.length; EXIT};
real => {b ¬ t.length; EXIT};
enumerated => {IF NOT t.empty THEN b ¬ BitsForRange[Cardinality[stb, sei]-1]; EXIT};
record => {b ¬ t.length; EXIT};
ref => {b ¬ t.length; EXIT};
array => {
b ¬ BitsPerElement[stb, t.componentType, t.packed]*Cardinality[stb, t.indexType];
IF b > bitsPerAU THEN b ¬ ((b + unitFill)/bitsPerAU)*bitsPerAU;
EXIT;
};
arraydesc => {b ¬ t.length; EXIT};
transfer => {b ¬ t.length; EXIT};
relative => type ¬ t.offsetType;
opaque => {b ¬ t.length; EXIT};
zone => {b ¬ t.length; EXIT};
subrange => {
IF NOT t.empty THEN b ¬ BitsForRange[Cardinality[stb, sei]-1];
EXIT;
};
ENDCASE => RETURN [0];
ENDLOOP;
};
BitsPerElement: PUBLIC PROC [stb: STB, type: Type, packed: BOOL] RETURNS [BitCount] = {
nBits: BitCount ¬ BitsForType[stb, type];
mod: NAT ¬ Basics.LowHalf[nBits] MOD bitsPerWord;
IF packed AND (nBits#0 AND nBits<=Target.PackedBitCount.LAST) THEN
RETURN [SymbolOps.PackedSize[nBits]];
IF mod # 0 THEN nBits ¬ nBits + (bitsPerWord-mod);
RETURN [nBits];
};
Cardinality: PUBLIC PROC [stb: STB, type: Type] RETURNS [CARD] = {
DO
sei: CSEIndex = UnderType[stb, type];
WITH t: stb.seb[sei] SELECT FROM
enumerated => IF NOT t.empty THEN RETURN [t.range+1];
subrange => IF NOT t.empty THEN RETURN [t.range+1];
basic => IF t.code = codeCHAR THEN RETURN [256];
relative => {type ¬ t.offsetType; LOOP};
ENDCASE;
RETURN [0];
ENDLOOP;
};
FindExtension: PUBLIC PROC
[stb: STB, sei: ISEIndex] RETURNS [type: ExtensionType, tree: Tree.Link] = {
FOR exti: SymbolSegment.ExtIndex
¬ SymbolSegment.ExtFirst, 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: STB, field: ISEIndex] RETURNS [offset: BitAddress ¬ [0], size: BitCount ¬ 0] = {
FOR sei: ISEIndex ¬ FirstCtxSe[stb, stb.seb[field].idCtx], NextSe[stb, sei] DO
Note: must round up to word boundary for function fields
size ¬ BitsForType[stb, stb.seb[sei].idType] + (bitsPerWord-1);
size ¬ size - (Basics.LowHalf[size] MOD bitsPerWord);
IF sei = field THEN EXIT;
offset ¬ [offset + size];
ENDLOOP;
};
NameForSe: PUBLIC PROC [stb: STB, sei: ISEIndex] RETURNS [Name] = {
RETURN [IF sei = ISENull THEN nullName ELSE stb.seb[sei].hash];
};
LinkMode: PUBLIC PROC [stb: STB, sei: ISEIndex] RETURNS [Linkage] = {
IF stb.seb[sei].idType = typeTYPE
THEN {
IF TypeForm[stb, TypeInfo[stb.seb[sei].idInfo]] = $opaque THEN RETURN [$type];
}
ELSE
SELECT XferMode[stb, stb.seb[sei].idType] FROM
$proc, $program =>
IF NOT stb.seb[sei].constant OR stb.seb[sei].extended THEN RETURN [$val];
$signal, $error => IF NOT stb.seb[sei].constant THEN RETURN [$val];
ENDCASE => IF NOT stb.seb[sei].constant THEN RETURN [$ref];
RETURN [$manifest];
};
RecField: PUBLIC PROC
[stb: STB, field: ISEIndex] RETURNS [offset: BitAddress, size: BitCount] = {
RETURN [offset: [bd: Card[stb.seb[field].idValue]], size: Card[stb.seb[field].idInfo]];
};
RCType: PUBLIC PROC [stb: STB, type: Type] RETURNS [RefClass] = {
tv: Type ¬ type;
struc: RefClass ¬ $simple;
DO
sei: CSEIndex = UnderType[stb, tv];
WITH t: stb.seb[sei] SELECT FROM
record =>
SELECT TRUE FROM
~t.hints.refField => RETURN [$none];
t.hints.unifield => {tv ¬ stb.seb[stb.ctxb[t.fieldCtx].seList].idType; LOOP};
ENDCASE => RETURN [$composite];
ref => IF t.counted THEN RETURN [struc];
array => {struc ¬ $composite; tv ¬ t.componentType; LOOP};
relative => {tv ¬ t.offsetType; LOOP};
subrange => {tv ¬ t.rangeType; LOOP};
union => IF t.hints.refField THEN RETURN [$composite];
sequence => {struc ¬ $composite; tv ¬ t.componentType; LOOP};
zone => IF t.counted THEN RETURN [struc];
ENDCASE;
RETURN [$none];
ENDLOOP;
};
VariantField: PUBLIC PROC [stb: STB, type: CSEIndex] RETURNS [sei: ISEIndex] = {
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 => sei ¬ ISENull;
};
body table management
ParentBti: PUBLIC PROC [stb: STB, bti: BTIndex] RETURNS [BTIndex] = {
WHILE bti # BTNull DO
next: BTIndex ¬ stb.bb[bti].link.index;
IF stb.bb[bti].link.which = $parent THEN RETURN [next];
bti ¬ next;
ENDLOOP;
RETURN [BTNull];
};
SiblingBti: PUBLIC PROC [stb: STB, bti: BTIndex] RETURNS [BTIndex] = {
IF stb.bb[bti].link.which = $sibling
THEN RETURN [stb.bb[bti].link.index]
ELSE RETURN [BTNull];
};
SonBti: PUBLIC PROC [stb: STB, bti: BTIndex] RETURNS [BTIndex] = {
RETURN [stb.bb[bti].firstSon];
};
EnumerateBodies: PUBLIC PROC
[stb: STB, root: BTIndex, proc: SymbolOps.BodyVisitor] RETURNS [bti: BTIndex] = {
bti ¬ root;
UNTIL bti = BTNull DO
IF proc[bti] THEN RETURN;
IF stb.bb[bti].firstSon # BTNull
THEN bti ¬ stb.bb[bti].firstSon
ELSE
DO
prev: BTIndex ¬ bti;
IF bti = root THEN RETURN [BTNull];
bti ¬ stb.bb[bti].link.index;
IF stb.bb[prev].link.which # $parent THEN EXIT;
ENDLOOP;
ENDLOOP;
};
utilities not requiring a symbol table
BitsForRange: PUBLIC PROC [maxValue: CARD] RETURNS [nBits: BitCount ¬ 1] = {
fieldMax: CARD ¬ 1;
WHILE nBits < bitsPerWord AND fieldMax < maxValue DO
nBits ¬ nBits + 1;
fieldMax ¬ 2*fieldMax + 1;
ENDLOOP
};
From SymbolPackExt (only useful for own symbols)
own: PUBLIC STB ¬ NIL;
table: Alloc.Handle;
initialized: BOOL ¬ FALSE;
ssUnits: Alloc.Index;
hashVec: LONG POINTER TO HashVector;
htb: Symbols.Base;  -- hash table
ssb: LONG STRING;  -- id string
seb: Symbols.Base;  -- se table
ctxb: Symbols.Base;  -- context table
mdb: Symbols.Base;  -- module directory base
bb: Symbols.Base;  -- body table
extb: SymbolSegment.Base; -- extension table
UpdateBases: Alloc.Notifier = {
called whenever the main symbol table is repacked
own.hashVec ¬ hashVec;
own.htb ¬ htb ¬ base[htType];
own.ssb ¬ ssb ¬ LOOPHOLE[base[ssType], ConvertUnsafe.LS];
own.seb ¬ seb ¬ base[seType];
own.ctxb ¬ ctxb ¬ base[ctxType];
own.mdb ¬ mdb ¬ base[mdType];
own.bb ¬ bb ¬ base[bodyType];
own.tb ¬ base[SymbolSegment.treeType];
own.ltb ¬ base[SymbolSegment.ltType];
own.stb ¬ base[SymbolSegment.stType];
own.extb ¬ extb ¬ base[SymbolSegment.extType];
IF own.notifier # NIL THEN own.notifier[own];
};
Initialize: PUBLIC PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = {
called to set up the compiler's symbol table
IF initialized THEN Finalize[];
IF own = NIL THEN own ¬ MimZones.permZone.NEW[SymbolTableBaseRep];
hashVec­ ¬ ALL[HTNull];
own.notifier ¬ NIL;
own.mdLimit ¬ MDFirst;
own.extLimit ¬ SymbolSegment.ExtFirst;
own.mainCtx ¬ CTXNull;
own.stHandle ¬ NIL;
own.sourceFile ¬ NIL;
table ¬ ownTable;
table.AddNotify[UpdateBases];
ssUnits ¬ table.Units[ssType, TEXT[0].SIZE] + TEXT[0].SIZE;
ssb­ ¬ StringBody[length: 0, maxlength: 0, text:];
IF AllocateHash[] # nullName THEN ERROR;
IF MakeNonCtxSe[SERecord.cons.nil.SIZE] # CSENull THEN ERROR;
seb[CSENull] ¬ SERecord[mark3: FALSE, mark4: FALSE, body: cons[
align: none, typeInfo: nil[]]];
IF MakeNonCtxSe[SERecord.cons.mode.SIZE] # typeTYPE THEN ERROR;
seb[typeTYPE] ¬ SERecord[mark3: TRUE, mark4: TRUE, body: cons[
align: none, typeInfo: mode[]]];
IF table.Units[ctxType, CTXRecord.nil.SIZE] # CTXNull THEN ERROR;
ctxb[CTXNull] ¬ CTXRecord[varUpdated: FALSE, seList: ISENull, level: lZ, extension: nil[]];
initialized ¬ TRUE;
};
Reset: PUBLIC PROC = {
nC: CARDINAL = (table.Bounds[ssType].size - TEXT[0].SIZE)*charsPerWord;
desc: SubString;
hvi: HVIndex;
htLimit: HTIndex = table.Top[htType];
ssUnits ¬ table.Top[ssType];
ssb­ ¬ StringBody[length: htb[htLimit-HTRecord.SIZE].ssIndex, maxlength: nC, text:];
hashVec­ ¬ ALL[HTNull];
FOR hti: HTIndex ¬ HTNull+HTRecord.SIZE, hti+HTRecord.SIZE UNTIL hti = htLimit DO
desc ¬ SubStringForName[own, hti];
hvi ¬ HashValue[own, desc];
htb[hti].link ¬ hashVec[hvi];
hashVec[hvi] ¬ hti;
htb[hti].anyInternal ¬ htb[hti].anyPublic ¬ FALSE;
ENDLOOP;
own.mdLimit ¬ table.Top[mdType];
own.extLimit ¬ table.Top[SymbolSegment.extType];
};
Finalize: PUBLIC PROC = {
table.DropNotify[UpdateBases];
table ¬ NIL;
initialized ¬ FALSE;
};
hash entry creation
EnterString: PUBLIC PROC [s: SubString] RETURNS [name: Name] = {
hvi: HVIndex = HashValue[own, s];
desc: SubString;
offset, nLen: CARDINAL;
length: [0..255];
ssi: Alloc.Index;
FOR name ¬ hashVec[hvi], htb[name].link UNTIL name = nullName DO
desc ¬ SubStringForName[own, name];
IF ConvertUnsafe.EqualSubStrings[s, desc] THEN RETURN [name];
ENDLOOP;
offset ¬ ssb.length;
length ¬ s.length;
nLen ¬ ssb.length+length+1;
IF nLen > ssb.maxlength THEN {
Need to expand the string.
nUnits: CARDINAL = StringBody[nLen].SIZE - StringBody[ssb.length].SIZE;
nChars: CARDINAL = nUnits*charsPerUnit;
IF (ssi ¬ table.Units[ssType, nUnits]) # ssUnits THEN ERROR;
ssUnits ¬ ssUnits + nUnits;
ssb­ ¬ StringBody[length: offset, maxlength: ssb.maxlength + nChars, text:];
};
ssb[ssb.length] ¬ VAL[length];
ssb.length ¬ ssb.length + 1;
ConvertUnsafe.AppendSubString[to: ssb, from: s];
name ¬ AllocateHash[];
htb[name].link ¬ hashVec[hvi];
hashVec[hvi] ¬ name;
};
AllocateHash: PROC RETURNS [HTIndex] = {
hti: HTIndex = table.Units[htType, HTRecord.SIZE];
htb[hti] ¬ HTRecord[
anyInternal: FALSE, anyPublic: FALSE,
link: HTNull,
ssIndex: ssb.length];
RETURN [hti];
};
HashBlock: PUBLIC PROC RETURNS [LONG POINTER TO HashVector] = {
RETURN [hashVec];
};
lexical level accounting
StaticNestError: PUBLIC SIGNAL = CODE;
NextLevel: PUBLIC PROC [cl: ContextLevel] RETURNS [nl: ContextLevel] = {
IF cl+1 < ContextLevel.LAST THEN nl ¬ cl+1 ELSE {SIGNAL StaticNestError; nl ¬ cl};
};
BlockLevel: PUBLIC PROC [cl: ContextLevel] RETURNS [nl: ContextLevel] = {
RETURN [IF cl = lG THEN lL ELSE cl];
};
context table manipulation
ctxLevelSplit: NAT = (ContextLevel.LAST+1)/2;
Circular: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {
RETURN [WITH c: ctxb[ctx] SELECT FROM included => ~c.reset, ENDCASE=> FALSE];
};
NewCtx: PUBLIC PROC [level: ContextLevel] RETURNS [ctx: CTXIndex] = {
makes a non-include context entry
ctx ¬ table.Units[ctxType, CTXRecord.simple.SIZE];
ctxb[ctx] ¬ [
level: level,
varUpdated: FALSE,
seList: ISENull,
extension: simple[]];
};
SetMainCtx: PUBLIC PROC [ctx: CTXIndex] = {
own.mainCtx ¬ ctx;
};
SetCtxLevel: PUBLIC PROC [ctx: CTXIndex, level: ContextLevel] = {
ctxb[ctx].level ¬ level;
};
ResetCtxList: PUBLIC PROC [ctx: CTXIndex] = {
change the list for ctx to a proper chain
sei: ISEIndex = ctxb[ctx].seList;
IF sei # ISENull THEN {ctxb[ctx].seList ¬ NextSe[own, sei]; SetSeLink[sei, ISENull]};
};
FirstVisibleSe: PUBLIC PROC [ctx: CTXIndex] RETURNS [sei: ISEIndex] = {
sei ¬ ctxb[ctx].seList;
WHILE sei # ISENull AND seb[sei].idCtx # ctx DO sei ¬ NextSe[own, sei] ENDLOOP;
};
NextVisibleSe: PUBLIC PROC [sei: ISEIndex] RETURNS [next: ISEIndex] = {
next ¬ sei;
IF next # ISENull THEN DO
next ¬ NextSe[own, next];
IF next = ISENull OR seb[next].idCtx = seb[sei].idCtx THEN EXIT;
ENDLOOP;
};
VisibleCtxEntries: PUBLIC PROC [ctx: CTXIndex] RETURNS [n: CARDINAL ¬ 0] = {
IF ctx = CTXNull OR Circular[ctx] THEN RETURN;
FOR sei: ISEIndex ¬ FirstCtxSe[own, ctx], NextSe[own, sei] UNTIL sei = ISENull DO
IF seb[sei].idCtx = ctx THEN n ¬ n+1;
ENDLOOP;
};
CtxVariant: PUBLIC PROC [ctx: CTXIndex] RETURNS [ISEIndex] = {
FOR sei: ISEIndex ¬ FirstCtxSe[own, ctx], NextSe[own, sei] UNTIL sei = ISENull DO
IF TypeForm[own, seb[sei].idType] = union THEN RETURN [sei];
ENDLOOP;
RETURN [ISENull];
};
semantic entry creation
MakeSeChain: PUBLIC PROC
[ctx: CTXIndex, n: CARDINAL, linked: BOOL] RETURNS [ISEIndex] = {
IF n # 0 THEN {
seChain: ISEIndex = table.Units[seType,
(n-1)*SERecord.id.sequential.SIZE +
(IF linked THEN SERecord.id.linked.SIZE ELSE SERecord.id.terminal.SIZE)];
sei: ISEIndex ¬ seChain;
THROUGH [1..n) DO
seb[sei] ¬ [mark3: FALSE, mark4: FALSE, body:
id[idCtx: ctx, hash: nullName, ctxLink: sequential[]]];
sei ¬ sei + SERecord.id.sequential.SIZE;
ENDLOOP;
IF linked
THEN
seb[sei] ¬ [mark3: FALSE, mark4: FALSE, body:
id[idCtx: ctx, hash: nullName, ctxLink: linked[ISENull]]]
ELSE
seb[sei] ¬ [mark3: FALSE, mark4: FALSE, body:
id[idCtx: ctx, hash: nullName, ctxLink: terminal[]]];
RETURN [seChain];
};
RETURN [ISENull];
};
MakeCtxSe: PUBLIC PROC [name: Name, ctx: CTXIndex] RETURNS [ISEIndex] = {
next: ISEIndex ¬ ISENull;
sei: ISEIndex = table.Units[seType, SERecord.id.linked.SIZE];
SELECT TRUE FROM
(ctx = CTXNull) => {};
Circular[ctx] => {
pSei: ISEIndex = ctxb[ctx].seList;
IF pSei = ISENull
THEN next ¬ sei
ELSE {next ¬ NextSe[own, pSei]; SetSeLink[pSei, sei]};
ctxb[ctx].seList ¬ sei;
};
ENDCASE => {
pSei: ISEIndex ¬ ctxb[ctx].seList;
IF pSei = ISENull
THEN ctxb[ctx].seList ¬ sei
ELSE {
UNTIL (next ¬ NextSe[own, pSei]) = ISENull DO pSei ¬ next ENDLOOP;
SetSeLink[pSei, sei];
};
};
seb[sei] ¬ [mark3: FALSE, mark4: FALSE, body:
id[idCtx: ctx, hash: name, ctxLink: linked[link: next]]];
RETURN [sei];
};
NameClash: PUBLIC SIGNAL [name: Name] = CODE;
FillCtxSe: PUBLIC PROC [sei: ISEIndex, name: Name, public: BOOL] = {
ctx: CTXIndex = seb[sei].idCtx;
seb[sei].hash ¬ name;
IF name # nullName THEN {
IF htb[name].anyInternal AND ctx # CTXNull THEN
FOR pSei: ISEIndex ¬ FirstCtxSe[own, ctx], NextSe[own, pSei] UNTIL pSei = sei DO
IF seb[pSei].hash = name THEN {SIGNAL NameClash[name]; EXIT};
ENDLOOP;
htb[name].anyInternal ¬ TRUE;
IF public THEN htb[name].anyPublic ¬ TRUE;
};
};
EnterExtension: PUBLIC PROC [sei: ISEIndex, type: ExtensionType, tree: Tree.Link] = {
OPEN SymbolSegment;
exti: ExtIndex;
extLimit: ExtIndex = own.extLimit;
FOR exti ¬ ExtFirst, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
IF extb[exti].sei = sei THEN GO TO Update;
REPEAT
Update => extb[exti] ¬ ExtRecord[sei:sei, type:type, tree:tree];
FINISHED =>
IF tree # Tree.Null THEN {
exti ¬ table.Units[extType, ExtRecord.SIZE];
own.extLimit ¬ own.extLimit + ExtRecord.SIZE;
extb[exti] ¬ ExtRecord[sei:sei, type:type, tree:tree]};
ENDLOOP;
seb[sei].extended ¬ TRUE;
};
SetSeLink: PUBLIC PROC [sei, next: ISEIndex] = {
WITH seb[sei] SELECT FROM linked => link ¬ next; ENDCASE => ERROR;
};
MakeNonCtxSe: PUBLIC PROC [size: CARDINAL] RETURNS [CSEIndex] = {
sei: CSEIndex = table.Units[seType, size];
seb[sei] ¬ [mark3: FALSE, mark4: FALSE, body: cons[align: unknown, typeInfo: ]];
RETURN [sei];
};
copying within current table
CopyBasicType: PUBLIC PROC [type: CSEIndex] RETURNS [copy: CSEIndex] = {
WITH master: seb[type] SELECT FROM
basic => {
copy ¬ MakeNonCtxSe[SERecord.cons.basic.SIZE];
seb[copy] ¬ SERecord[
mark3: master.mark3, mark4: master.mark4,
body: cons[align: master.align, typeInfo: basic[
code: master.code, ordered: master.ordered, length: master.length]]];
};
ENDCASE => copy ¬ typeANY;
};
CopyXferType: PUBLIC PROC
[type: CSEIndex, mapper: Tree.Map] RETURNS [copy: CSEIndex] = {
WITH master: seb[type] SELECT FROM
transfer => {
copy ¬ MakeNonCtxSe[SERecord.cons.transfer.SIZE];
seb[copy] ¬ SERecord[
mark3: master.mark3, mark4: master.mark4,
body: cons[align: master.align, typeInfo: transfer[
mode: master.mode, safe: master.safe,
typeIn: CopyArgs[master.typeIn, NIL],
typeOut: CopyArgs[master.typeOut, mapper]]]]};
ENDCASE => copy ¬ typeANY;
};
CopyArgSe: PUBLIC PROC [copy, master: ISEIndex] = {
CopyArg[copy, master, NIL];
};
CopyArgs: PROC [args: CSEIndex, mapper: Tree.Map] RETURNS [copy: CSEIndex] = {
IF args = CSENull
THEN copy ¬ CSENull
ELSE
WITH t: seb[args] SELECT FROM
record => {
ctx1: CTXIndex = t.fieldCtx;
ctx2: CTXIndex = NewCtx[CtxLevel[own, ctx1]];
seChain: ISEIndex = MakeSeChain[ctx2, CtxEntries[own, ctx1], FALSE];
sei1: ISEIndex ¬ ctxb[ctx1].seList;
sei2: ISEIndex ¬ ctxb[ctx2].seList ¬ seChain;
UNTIL sei1 = ISENull DO
CopyArg[sei2, sei1, mapper];
sei1 ¬ NextSe[own, sei1]; sei2 ¬ NextSe[own, sei2];
ENDLOOP;
copy ¬ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
seb[copy] ¬ SERecord[mark3: t.mark3, mark4: t.mark4, body: cons[
align: t.align,
typeInfo: record[
spare: t.spare,
machineDep: FALSE,
packed: FALSE,
list: FALSE,
monitored: FALSE,
painted: FALSE,
argument: TRUE,
bitOrder: t.bitOrder,
grain: t.grain,
hints: t.hints,
fieldCtx: ctx2,
length: t.length,
linkPart: notLinked[]]]];
};
any => {
copy ¬ MakeNonCtxSe[SERecord.cons.any.SIZE];
seb[copy] ¬ SERecord[mark3: t.mark3, mark4: t.mark4,
body: cons[align: t.align, typeInfo: any[]]];
};
ENDCASE => ERROR;
};
CopyArg: PROC [copy, master: ISEIndex, mapper: Tree.Map] = {
seb[copy].hash ¬ seb[master].hash;
seb[copy].public ¬ seb[master].public;
seb[copy].immutable ¬ seb[master].immutable;
seb[copy].constant ¬ seb[master].constant;
seb[copy].idType ¬ seb[master].idType;
seb[copy].idInfo ¬ seb[master].idInfo;
seb[copy].idValue ¬ seb[master].idValue;
seb[copy].linkSpace ¬ FALSE;
seb[copy].mark3 ¬ seb[master].mark3; seb[copy].mark4 ¬ seb[master].mark4;
IF mapper # NIL AND seb[master].extended
THEN {
type: ExtensionType;
t: Tree.Link;
[type, t] ¬ FindExtension[own, master];
EnterExtension[copy, type, mapper[t]];
}
ELSE seb[copy].extended ¬ FALSE;
};
body table utilities
LinkBti: PUBLIC PROC [bti, parent: BTIndex] = {
prev: BTIndex;
IF parent # BTNull THEN
IF (prev ¬ bb[parent].firstSon) = BTNull
THEN bb[parent].firstSon ¬ bti
ELSE {
UNTIL bb[prev].link.which = parent DO prev ¬ bb[prev].link.index ENDLOOP;
bb[prev].link ¬ [which: sibling, index: bti];
};
bb[bti].link ¬ [which:parent, index:parent];
};
DelinkBti: PUBLIC PROC [bti: BTIndex] = {
prev, next: BTIndex;
parent: BTIndex = ParentBti[own, bti];
IF parent # BTNull THEN {
prev ¬ bb[parent].firstSon;
IF prev = bti
THEN
bb[parent].firstSon ¬
IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index
ELSE {
UNTIL (next ¬ bb[prev].link.index) = bti DO prev ¬ next ENDLOOP;
bb[prev].link ¬ bb[next].link;
};
};
bb[bti].link ¬ [which: parent, index: BTNull];
};
attribute extraction
ConstantId: PUBLIC PROC [sei: ISEIndex] RETURNS [BOOL] = {
IF seb[sei].constant THEN
SELECT XferMode[own, seb[sei].idType] FROM
proc, signal, error, program =>
RETURN [seb[sei].mark4 AND SymbolOps.DecodeBti[seb[sei].idInfo] = BTNull];
ENDCASE => RETURN [TRUE];
RETURN [FALSE];
};
START HERE
hashVec ¬ UnsafeStorage.GetSystemUZone[].NEW[HashVector ¬ ALL[HTNull]];
}.
Russ Atkinson (RRA) July 31, 1987 6:28:05 pm PDT
changed CopyArgs to copy bitOrder & grain fields