SymbolPackExt.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 13, 1986 4:17:19 pm PDT
Rovner, September 19, 1983 10:29 pm
Levin, September 22, 1983 10:58 am
Russ Atkinson (RRA) January 31, 1985 1:23:07 pm PST
DIRECTORY
Alloc: TYPE USING [Handle, Index, Notifier, AddNotify, Bounds, DropNotify, Top, Words],
ConvertUnsafe: TYPE USING [AppendSubString, EqualSubStrings, LS, SubString],
Host: TYPE MachineParms USING [bitsPerChar, bitsPerWord],
Symbols: TYPE USING [Base, ExtensionType, HashVector, HVIndex, HTRecord, HTIndex, Name, SERecord, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CTXRecord, MDIndex, BTIndex, nullName, HTNull, ISENull, CSENull, CTXNull, MDFirst, BTNull, lG, lL, lZ, typeANY, typeTYPE, htType, ssType, seType, ctxType, mdType, bodyType],
SymbolOps: TYPE USING [CtxEntries, CtxLevel, FindExtension, FirstCtxSe, HashValue, NextSe, ParentBti, SubStringForName, TypeForm, XferMode, DecodeBti],
SymbolPack: TYPE,
SymbolSegment: TYPE USING [Base, ExtIndex, ExtRecord, ExtFirst, extType, ltType, stType, treeType],
Tree: TYPE USING [Base, Link, Map, Null],
UnsafeStorage: TYPE USING [GetSystemUZone];
SymbolPackExt: PROGRAM
IMPORTS Alloc, ConvertUnsafe, SymbolOps, own: SymbolPack, UnsafeStorage
EXPORTS SymbolOps = {
OPEN SymbolOps, Symbols;
charsPerWord: NAT = Host.bitsPerWord/Host.bitsPerChar;
SubString: TYPE = ConvertUnsafe.SubString;
variables for building the symbol string
ssw: Alloc.Index;
tables defining the current symbol table
table: Alloc.Handle;
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];
own.notifier[own]};
initialized: BOOL ← FALSE;
Initialize: PUBLIC PROC[ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = {
called to set up the compiler's symbol table
IF initialized THEN Finalize[];
hashVec^ ← ALL[HTNull];
own.notifier ← own.NullNotifier;
own.mdLimit ← MDFirst;
own.extLimit ← SymbolSegment.ExtFirst;
own.mainCtx ← CTXNull; own.stHandle ← NIL; own.sourceFile ← NIL;
table ← ownTable; table.AddNotify[UpdateBases];
ssw ← table.Words[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[nil[]]];
IF MakeNonCtxSe[SERecord.cons.mode.SIZE] # typeTYPE THEN ERROR;
seb[typeTYPE] ← SERecord[mark3: TRUE, mark4: TRUE, body: cons[mode[]]];
IF table.Words[ctxType, CTXRecord.nil.SIZE] # CTXNull THEN ERROR;
ctxb[CTXNull] ← CTXRecord[FALSE, ISENull, lZ, 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];
ssw ← 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[hti]; hvi ← HashValue[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[s];
desc: SubString;
offset, length, nw: CARDINAL;
ssi: Alloc.Index;
FOR name ← hashVec[hvi], htb[name].link UNTIL name = nullName DO
desc ← SubStringForName[name];
IF ConvertUnsafe.EqualSubStrings[s, desc] THEN RETURN[name];
ENDLOOP;
offset ← ssb.length; length ← s.length;
nw ← (offset+length+(charsPerWord-1) - ssb.maxlength)/charsPerWord;
IF nw # 0 THEN {
IF (ssi ← table.Words[ssType, nw]) # ssw THEN ERROR;
ssw ← ssw + nw;
ssb^ ← StringBody[length: offset, maxlength: ssb.maxlength + nw*charsPerWord, text:]};
ConvertUnsafe.AppendSubString[to: ssb, from: s];
name ← AllocateHash[]; htb[name].link ← hashVec[hvi]; hashVec[hvi] ← name;
RETURN};
AllocateHash: PROC RETURNS[HTIndex] = {
hti: HTIndex = table.Words[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};
RETURN};
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.Words[ctxType, CTXRecord.simple.SIZE];
ctxb[ctx] ← [
level: level,
varUpdated: FALSE,
seList: ISENull,
extension: simple[]];
RETURN};
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[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[sei] ENDLOOP;
RETURN};
NextVisibleSe: PUBLIC PROC[sei: ISEIndex] RETURNS[next: ISEIndex] = {
IF (next ← sei) # ISENull THEN
UNTIL (next ← NextSe[next]) = ISENull OR seb[next].idCtx = seb[sei].idCtx DO
NULL ENDLOOP;
RETURN};
VisibleCtxEntries: PUBLIC PROC[ctx: CTXIndex] RETURNS[n: CARDINAL ← 0] = {
IF ctx = CTXNull OR Circular[ctx] THEN RETURN;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF seb[sei].idCtx = ctx THEN n ← n+1 ENDLOOP;
RETURN};
CtxVariant: PUBLIC PROC[ctx: CTXIndex] RETURNS[sei: ISEIndex] = {
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF TypeForm[seb[sei].idType] = union THEN RETURN ENDLOOP;
RETURN[ISENull]};
semantic entry creation
MakeSeChain: PUBLIC PROC[ctx: CTXIndex, n: CARDINAL, linked: BOOL]
RETURNS[seChain: ISEIndex] = {
sei: ISEIndex;
IF n = 0 THEN RETURN[ISENull];
seChain ← table.Words[seType,
(n-1)*SERecord.id.sequential.SIZE +
(IF linked THEN SERecord.id.linked.SIZE ELSE SERecord.id.terminal.SIZE)];
sei ← seChain;
THROUGH [1..n) DO
seb[sei] ← [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,sequential[]]];
sei ← sei + SERecord.id.sequential.SIZE;
ENDLOOP;
IF linked THEN
seb[sei] ← [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,linked[ISENull]]]
ELSE seb[sei] ← [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,terminal[]]];
RETURN};
MakeCtxSe: PUBLIC PROC[name: Name, ctx: CTXIndex] RETURNS[sei: ISEIndex] = {
next, pSei: ISEIndex;
sei ← table.Words[seType, SERecord.id.linked.SIZE];
SELECT TRUE FROM
(ctx = CTXNull) => next ← ISENull;
Circular[ctx] => {
pSei ← ctxb[ctx].seList;
IF pSei = ISENull THEN next ← sei
ELSE {next ← NextSe[pSei]; SetSeLink[pSei, sei]};
ctxb[ctx].seList ← sei};
ENDCASE => {
pSei ← ctxb[ctx].seList;
IF pSei = ISENull THEN {next ← ISENull; ctxb[ctx].seList ← sei}
ELSE {
UNTIL (next ← NextSe[pSei]) = ISENull DO pSei ← next ENDLOOP;
SetSeLink[pSei, sei]}};
seb[sei] ← [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,name,,linked[link: next]]];
RETURN};
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[ctx], NextSe[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.Words[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[sei: CSEIndex] = {
sei ← table.Words[seType, size];
seb[sei] ← [mark3: FALSE, mark4: FALSE, body: cons[typeInfo: ]];
RETURN};
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[basic[
code: master.code, ordered: master.ordered,
length: master.length]]]}
ENDCASE => copy ← typeANY;
RETURN};
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[transfer[
mode: master.mode, safe: master.safe,
typeIn: CopyArgs[master.typeIn, NIL],
typeOut: CopyArgs[master.typeOut, mapper]]]]};
ENDCASE => copy ← typeANY;
RETURN};
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[ctx1]];
seChain: ISEIndex = MakeSeChain[ctx2, CtxEntries[ctx1], FALSE];
sei1: ISEIndex ← ctxb[ctx1].seList;
sei2: ISEIndex ← ctxb[ctx2].seList ← seChain;
UNTIL sei1 = ISENull DO
CopyArg[sei2, sei1, mapper];
sei1 ← NextSe[sei1]; sei2 ← NextSe[sei2];
ENDLOOP;
copy ← MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
seb[copy] ← SERecord[mark3: t.mark3, mark4: t.mark4,
body: cons[
record[
machineDep: FALSE,
painted: t.painted, argument: TRUE,
hints: t.hints,
fieldCtx: ctx2,
length: t.length,
monitored: FALSE,
linkPart: notLinked[]]]]};
any => {
copy ← MakeNonCtxSe[SERecord.cons.any.SIZE];
seb[copy] ← SERecord[mark3: t.mark3, mark4: t.mark4,
body: cons[any[]]]};
ENDCASE => ERROR;
RETURN};
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[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[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] = {
RETURN[IF ~seb[sei].constant
THEN FALSE
ELSE
SELECT XferMode[seb[sei].idType] FROM
proc, signal, error, program =>
seb[sei].mark4 AND SymbolOps.DecodeBti[seb[sei].idInfo] = BTNull,
ENDCASE => TRUE]
};
START HERE
hashVec ← UnsafeStorage.GetSystemUZone[].NEW[HashVector ← ALL[HTNull]];
}.