SymbolPackExt.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, February 17, 1983 4:14 pm
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 USING [Handle, Index, Notifier, AddNotify, Bounds, DropNotify, Top, Words],
ConvertUnsafe USING [AppendSubString, EqualSubStrings, LS, SubString],
Symbols USING [Base, ExtensionType, HashVector, HVIndex, HTRecord, HTIndex, Name, SERecord, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CTXRecord, MDIndex, BTIndex, nullName, HTNull, ISENull, CSENull, CTXNull, BTNull, ByteLength, lG, lL, lZ, typeANY, typeTYPE, WordLength, htType, ssType, seType, ctxType, mdType, bodyType],
SymbolOps USING [CtxEntries, FindExtension, FirstCtxSe, HashValue, NextSe, ParentBti, SubStringForName, TypeForm, XferMode],
SymbolPack,
SymbolSegment USING [Base, ExtIndex, ExtRecord, extType, ltType, treeType],
Tree USING [Base, Link, Map, Null],
UnsafeStorage USING [GetSystemUZone];
SymbolPackExt:
PROGRAM
IMPORTS Alloc, ConvertUnsafe, SymbolOps, own: SymbolPack, UnsafeStorage
EXPORTS SymbolOps = {
OPEN SymbolOps, Symbols;
charsPerWord: NAT = Symbols.WordLength/Symbols.ByteLength;
SubString: TYPE = ConvertUnsafe.SubString;
variables for building the symbol string
table: Alloc.Handle;
hashVec: LONG POINTER TO HashVector;
ht: LONG DESCRIPTOR FOR ARRAY Name OF HTRecord;
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;
htb ← base[htType];
own.ssb ← ssb ← LOOPHOLE[base[ssType], ConvertUnsafe.LS];
own.ht ← ht ← DESCRIPTOR[htb, ht.LENGTH];
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.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 ← MDIndex.FIRST;
own.extLimit ← SymbolSegment.ExtIndex.FIRST;
own.mainCtx ← CTXNull; own.stHandle ← NIL; own.sourceFile ← NIL;
ht ← 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, 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.Bounds[htType].size/HTRecord.SIZE;
ssw ← table.Top[ssType];
ssb^ ← StringBody[length: ht[htLimit-1].ssIndex, maxlength: nC, text:];
own.ht ← ht ← DESCRIPTOR[htb, htLimit];
hashVec^ ← ALL[HTNull];
FOR hti: HTIndex
IN (HTNull .. htLimit)
DO
desc ← SubStringForName[hti]; hvi ← HashValue[desc];
ht[hti].link ← hashVec[hvi]; hashVec[hvi] ← hti;
ht[hti].anyInternal ← ht[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], ht[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[]; ht[name].link ← hashVec[hvi]; hashVec[hvi] ← name;
RETURN;
};
AllocateHash:
PROC
RETURNS [HTIndex] = {
hti: HTIndex = ht.LENGTH;
[] ← table.Words[htType, HTRecord.SIZE];
own.ht ← ht ← DESCRIPTOR[htb, ht.LENGTH+1];
ht[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
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] ← [
rePainted: FALSE, varUpdated: FALSE,
seList: ISENull,
level: level,
extension: simple[ctxNew: CTXNull]];
RETURN};
SetMainCtx: PUBLIC PROC [ctx: CTXIndex] = {own.mainCtx ← ctx};
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};
ContextVariant:
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 ht[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;
ht[name].anyInternal ← TRUE;
IF public THEN ht[name].anyPublic ← TRUE}};
EnterExtension:
PUBLIC PROC [sei: ISEIndex, type: ExtensionType, tree: Tree.Link] = {
OPEN SymbolSegment;
exti: ExtIndex;
extLimit: ExtIndex = own.extLimit;
FOR exti ← ExtIndex.
FIRST, 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[ctxb[ctx1].level];
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 seb[sei].idInfo = BTNull,
ENDCASE => TRUE]};