DIRECTORY
Alloc: TYPE USING [AddNotify, Bounds, DropNotify, Notifier, Words],
ComData: TYPE USING [bodyIndex, defBodyLimit, idLOCK, importCtx, interface, mainCtx, moduleCtx, monitored, nBodies, nInnerBodies, nSigCodes, table, textIndex],
CompilerUtil: TYPE USING [],
Log: TYPE USING [Error, ErrorHti],
SourceMap: TYPE USING [Loc, Down],
Symbols: TYPE USING [Base, BodyInfo, BodyLink, BodyRecord, bodyType, BTIndex, BTNull, CBTIndex, CBTNull, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lG, lL, lZ, Name, nullName, nullType, RecordSEIndex, RecordSENull, RootBti, SERecord, seType, TransferMode, Type, typeANY, typeTYPE],
SymbolOps: TYPE USING [BlockLevel, FillCtxSe, FirstCtxSe, NewCtx, MakeNonCtxSe, MakeSeChain, NameClash, NextLevel, NextSe, SetMainCtx, StaticNestError],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, NullIndex, Scan, treeType],
TreeOps: TYPE USING [FreeNode, GetInfo, GetNode, ListHead, ListLength, NthSon, OpName, PutInfo, ScanList, UpdateList];

Pass2: PROGRAM
IMPORTS Alloc, Log, SourceMap, SymbolOps, TreeOps, dataPtr: ComData
EXPORTS CompilerUtil = {
OPEN TreeOps, SymbolOps, Symbols;

tb: Tree.Base;	-- tree base (private copy)
seb: Symbols.Base;	-- se table base (private copy)
ctxb: Symbols.Base;	-- context table base (private copy)
bb: Symbols.Base;	-- body table base (private copy)

Notify: Alloc.Notifier = {
tb _ base[Tree.treeType];
seb _ base[seType];  ctxb _ base[ctxType];  bb _ base[bodyType]};

ContextInfo: TYPE = RECORD[
ctx: CTXIndex,
staticLevel: ContextLevel,
seChain: ISEIndex];

current: ContextInfo;

NewContext: PROC[level: ContextLevel, entries: NAT, unique: BOOL] = {
OPEN c: current;
c.staticLevel _ level;
IF entries = 0 AND ~unique THEN {c.ctx _ CTXNull; c.seChain _ ISENull}
ELSE {
c.ctx _ NewCtx[level];
ctxb[c.ctx].seList _ c.seChain _ MakeSeChain[c.ctx, entries, level=lG]}
};



P2Unit: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
node: Tree.Index;
(dataPtr.table).AddNotify[Notify];  anySei _ CSENull;
node _ GetNode[t];
BEGIN
ENABLE {	-- default error reporting
NameClash => {Log.ErrorHti[duplicateId, name]; RESUME};
StaticNestError => {Log.Error[staticNesting]; RESUME}};
dataPtr.textIndex _ tb[node].info;
dataPtr.bodyIndex _ CBTNull;
dataPtr.nBodies _ dataPtr.nInnerBodies _ dataPtr.nSigCodes _ 0;
btLink _ [which:parent, index:BTNull];
NewContext[
level: lZ,
entries: ListLength[tb[node].son[1]] + CountIds[tb[node].son[6]],
unique: FALSE];
dataPtr.moduleCtx _ current.ctx;
ScanList[tb[node].son[1], IdItem];
ImportList[tb[node].son[2]];
dataPtr.monitored _ tb[node].son[5] # Tree.Null;
lockLambda _ Lambda[tb[node].son[5], lL];
MainBody[tb[node].son[6]];
dataPtr.defBodyLimit _ (dataPtr.table).Bounds[bodyType].size;
END;
(dataPtr.table).DropNotify[Notify];
RETURN[t]};

ImportList: PROC[t: Tree.Link] = {
saved: ContextInfo = current;
NewContext[lG, ListLength[t], FALSE];
dataPtr.importCtx _ current.ctx;
ScanList[t, IdItem];
current _ saved};

MainBody: PROC[t: Tree.Link] = INLINE {
dataPtr.interface _ (OpName[NthSon[t, 2]] = definitionTC);
DeclList[t];
BodyList[RootBti]};



lockLambda: Tree.Index;

Lambda: PROC[item: Tree.Link, level: ContextLevel] RETURNS[node: Tree.Index] = {
node _ GetNode[item];
IF node # Tree.NullIndex THEN {
saved: ContextInfo = current;
NewContext[level, CountIds[tb[node].son[1]], FALSE];
tb[node].info _ current.ctx;
DeclList[tb[node].son[1]];  Exp[tb[node].son[2]];
current _ saved};
RETURN};

ImplicitLock: PROC = {
sei: ISEIndex = current.seChain;
tb[lockLambda].son[2] _ Ids[
list: tb[lockLambda].son[2],
public: tb[lockLambda].attr2,
link: Tree.NullIndex];
seb[sei].idType _ dataPtr.idLOCK; seb[sei].idInfo _ 1; seb[sei].mark3 _ TRUE};



btLink: BodyLink;

AllocateBody: PROC[node: Tree.Index, id: ISEIndex] RETURNS[bti: CBTIndex] = {
SELECT NextLevel[current.staticLevel] FROM
lG, lL => {
bti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Outer.SIZE];
bb[bti] _ [,,,,,,, Callable[,,,,,,,,,,Outer[]]]};
ENDCASE => {
bti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Inner.SIZE];
bb[bti] _ [,,,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]]};
bb[bti].firstSon _ BTNull;
bb[bti].sourceIndex _ dataPtr.textIndex.Down;
bb[bti].info _ [Internal[bodyTree:node, thread:Tree.NullIndex, frameSize: ]];
bb[bti].id _ id;
bb[bti].entry _ bb[bti].internal _ FALSE;
bb[bti].ioType _ typeANY;
bb[bti].noXfers _ FALSE;
bb[bti].hints _ [safe:FALSE, argUpdated:TRUE, nameSafe:FALSE, noStrings:FALSE];
LinkBody[bti];  RETURN};

LinkBody: PROC[bti: BTIndex] = {
IF btLink.which = parent THEN {
bb[bti].link _ btLink;
IF btLink.index # BTNull THEN bb[btLink.index].firstSon _ bti
ELSE IF bti # RootBti THEN ERROR}
ELSE {
bb[bti].link _ bb[btLink.index].link;
bb[btLink.index].link _ [which:sibling, index: bti]}
};

SetEntryAttr: PROC[t: Tree.Link, attr: Tree.NodeName] = {
IF OpName[t] # body OR ~dataPtr.monitored THEN Log.Error[misplacedEntry]
ELSE {	-- see AllocateBody
bti: CBTIndex = GetInfo[t];
SELECT attr FROM
entry => bb[bti].entry _ TRUE;
internal => bb[bti].internal _ TRUE;
ENDCASE}
};


BodyList: PROC[firstBti: BTIndex] = {
FOR bti: BTIndex _ firstBti, bb[bti].link.index UNTIL bti = BTNull DO
WITH bb[bti] SELECT FROM
Callable => Body[LOOPHOLE[bti, CBTIndex]];
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
ENDLOOP
};

Body: PROC[bti: CBTIndex] = {
node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
level: ContextLevel;
nLocks: [0..1];
oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
oldBtLink: BodyLink = btLink;
saved: ContextInfo = current;
dataPtr.bodyIndex _ bti;
btLink _ [which:parent, index:bti];
level _ NextLevel[saved.staticLevel ! StaticNestError => {RESUME}];
nLocks _ IF level = lG AND dataPtr.monitored AND tb[lockLambda].attr1
THEN 1
ELSE 0;
NewContext[
level: level,
entries: nLocks + CountIds[tb[node].son[2]],
unique: level = lG];
bb[bti].localCtx _ current.ctx;  bb[bti].level _ BlockLevel[level];
bb[bti].monitored _ nLocks # 0;  bb[bti].inline _ tb[node].attr3;
bb[bti].type _ IF current.ctx = CTXNull OR bb[bti].inline
THEN RecordSENull
ELSE BodyType[current.ctx, bb[bti].monitored];
IF level = lG THEN {
IF bti # RootBti THEN ERROR;
dataPtr.mainCtx _ current.ctx;  SetMainCtx[current.ctx]};
ExpList[tb[node].son[1]];
IF nLocks # 0 THEN ImplicitLock[];
DeclList[tb[node].son[2]];
StmtList[tb[node].son[3]];
BodyList[bb[bti].firstSon];
current _ saved;  dataPtr.bodyIndex _ oldBodyIndex;  btLink _ oldBtLink};


NewScope: PROC[node: Tree.Index, decls: Tree.Link] RETURNS[bti: BTIndex] = {
level: ContextLevel = BlockLevel[current.staticLevel];
NewContext[level:level, entries:CountIds[decls], unique:FALSE];
bti _ (dataPtr.table).Words[bodyType, BodyRecord.Other.SIZE];
bb[bti] _ [
link: ,
firstSon: BTNull,
type: IF bb[dataPtr.bodyIndex].inline
THEN RecordSENull ELSE BodyType[current.ctx, FALSE],
localCtx: current.ctx, level: level,
sourceIndex: tb[node].info,
info: [Internal[bodyTree:node, thread:Tree.NullIndex, frameSize: ]],
extension: Other[relOffset: ]];
LinkBody[bti];  btLink _ [which:parent, index:bti];
DeclList[decls]};


BodyType: PROC[ctx: CTXIndex, monitored: BOOL] RETURNS[rSei: RecordSEIndex] = {
rSei _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
seb[rSei].typeInfo _ record[
machineDep: FALSE, painted: TRUE, argument: FALSE,
hints: [
unifield: FALSE, variant: FALSE,
assignable: FALSE, comparable: FALSE, privateFields: TRUE,
refField: FALSE, default: FALSE, voidable: FALSE],
length: 0,
fieldCtx: ctx,
monitored: monitored,
linkPart: notLinked[]];
RETURN};


CodeBody: PROC[node: Tree.Index] = {
InlineOp: Tree.Scan = {ExpList[t]};
ScanList[tb[node].son[1], InlineOp]};



DeclList: PROC[t: Tree.Link, linkId: Type_nullType] = {

DeclItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex _ tb[node].info;
tb[node].son[1] _ Ids[
list: tb[node].son[1],
type: (tb[node].name = typedecl),
public: tb[node].attr2,
link: node];
tb[node].attr2 _ tb[node].attr3 _ FALSE;
SELECT tb[node].name FROM
typedecl => {
TypeExp[t:tb[node].son[2], typeId:FirstId[tb[node].son[1]], linkId:linkId];
ExpList[tb[node].son[3]]};
decl => {
TypeExp[t:tb[node].son[2], linkId:linkId];
tb[node].son[3] _ InitialValue[
tb[node].son[3], 
IF tb[node].attr1 THEN FirstId[tb[node].son[1]] ELSE ISENull]};
ENDCASE => Log.Error[unimplemented];
dataPtr.textIndex _ saveIndex};

ScanList[t, DeclItem]};

CountIds: PROC[declList: Tree.Link] RETURNS[n: NAT_0] = {
NIds: Tree.Scan = {n _ n + ListLength[NthSon[t, 1]]};
ScanList[declList, NIds];  RETURN};


InitialValue: PROC[t: Tree.Link, id: ISEIndex] RETURNS[v: Tree.Link] = {
v _ t;	-- the default
IF t # Tree.Null THEN
WITH t SELECT FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name FROM
body => {
bti: CBTIndex = AllocateBody[node, id];
tb[node].info _ bti;
IF ~tb[node].attr3 THEN {
dataPtr.nBodies _ dataPtr.nBodies+1;
IF current.staticLevel >= lL THEN
dataPtr.nInnerBodies _ dataPtr.nInnerBodies + 1};
btLink _ [which:sibling, index:bti]};
entry, internal => {
v _ InitialValue[tb[node].son[1], id];
SetEntryAttr[v, tb[node].name];
tb[node].son[1] _ Tree.Null;  FreeNode[node]};
signalinit => {
tb[node].info _ dataPtr.nSigCodes;
dataPtr.nSigCodes _ dataPtr.nSigCodes+1};
inline => CodeBody[node];
ENDCASE => ExpList[t]};
ENDCASE => ExpList[t]
};


IdItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex _ tb[node].info;
tb[node].son[1] _ Ids[list: tb[node].son[1], public: FALSE, link: node];
dataPtr.textIndex _ saveIndex};



Ids: PROC [
list: Tree.Link,
public: BOOL,
type: BOOL _ FALSE,
link: Tree.Index]
RETURNS[Tree.Link] = {

Id: Tree.Map = {
WITH t SELECT FROM
hash, symbol => {
name: Name = (WITH t SELECT FROM
hash => index,
symbol => seb[index].hash,
ENDCASE => ERROR);
sei: ISEIndex = current.seChain;
current.seChain _ NextSe[current.seChain];
FillCtxSe[sei, name, public];
seb[sei].idType _ IF type THEN typeTYPE ELSE typeANY;
seb[sei].public _ public;
seb[sei].immutable _ seb[sei].constant _ FALSE;
seb[sei].idValue _ link;  seb[sei].idInfo _ 0;
seb[sei].extended _ seb[sei].linkSpace _ FALSE;
v _ [symbol[index: sei]]};
subtree => {
node: Tree.Index = index;
tb[node].son[1] _ Id[tb[node].son[1]];  Position[tb[node].son[2]];
v _ t};
ENDCASE => ERROR;
RETURN};

RETURN[UpdateList[list, Id]]};


FirstId: PROC[t: Tree.Link] RETURNS[ISEIndex] = {
head: Tree.Link = ListHead[t];
RETURN[WITH head SELECT FROM
symbol => index,
subtree => FirstId[tb[index].son[1]],
ENDCASE => ERROR]
};



TypeExp: PROC[t: Tree.Link, typeId, linkId: Type_nullType] = {
sei: CSEIndex;
WITH t SELECT FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name FROM

enumeratedTC => {
sei _ MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
seb[sei].typeInfo _ enumerated[
ordered: TRUE, sparse: FALSE,
machineDep: tb[node].attr2,
unpainted: ~(tb[node].attr2 OR dataPtr.interface),
valueCtx: Enumeration[node], empty: , nValues: ];
AssignValues[sei, IF typeId # nullType THEN typeId ELSE sei]};

recordTC, monitoredTC => {
tCtx: CTXIndex;
nFields: NAT;
sei _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
[tCtx, nFields] _ FieldList[
t: tb[node].son[1],
level: lZ,
typeId: IF typeId # nullType THEN typeId ELSE sei];
seb[sei].typeInfo _ record[
machineDep: tb[node].attr1,
painted: tb[node].attr1 OR (dataPtr.interface AND tb[node].attr3),
argument: FALSE,
hints: [
unifield: nFields = 1 AND ~tb[node].attr2,
variant: tb[node].attr2,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: tCtx,
monitored: tb[node].name = monitoredTC,
linkPart: notLinked[]];
IF tb[node].name = monitoredTC AND tb[node].attr1 THEN Log.Error[attrClash]};

variantTC => {
sei _ MakeNonCtxSe[SERecord.cons.record.linked.SIZE];
seb[sei].typeInfo _ record[
machineDep: tb[node].attr1,
painted: tb[node].attr3,
argument: FALSE,
hints: [
unifield: FALSE,
variant: tb[node].attr2,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: FieldList[t:tb[node].son[1], level:lZ, typeId:typeId].ctx,
monitored: FALSE,
linkPart: linked[linkId]]};

refTC, listTC, pointerTC, varTC => {
sei _ MakeNonCtxSe[SERecord.cons.ref.SIZE];
seb[sei].typeInfo _ ref[
counted: tb[node].name = refTC OR tb[node].name = listTC,
var: tb[node].name = varTC,
ordered: tb[node].attr1,
basing: tb[node].attr2,
list: tb[node].name = listTC,
readOnly: tb[node].attr3,
refType: ];
TypeExp[tb[node].son[1]]};

arrayTC => {
sei _ MakeNonCtxSe[SERecord.cons.array.SIZE];
seb[sei].typeInfo _ array[
packed: tb[node].attr3,
indexType: ,
componentType: ];
OptTypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

arraydescTC => {
sei _ MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];
seb[sei].typeInfo _ arraydesc[
readOnly: tb[node].attr3, var: FALSE, describedType: ];
TypeExp[tb[node].son[1]]};

procTC, processTC, portTC, signalTC, errorTC, programTC => {
modeMap: ARRAY Tree.NodeName[procTC..programTC] OF TransferMode = [
procTC: proc, processTC: process, portTC: port,
signalTC: signal, errorTC: error, programTC: program];
sei _ MakeNonCtxSe[SERecord.cons.transfer.SIZE];
seb[sei].typeInfo _ transfer[
mode: modeMap[tb[node].name], safe: tb[node].attr3,
typeIn:  ArgList[tb[node].son[1]],
typeOut: ArgList[tb[node].son[2]]]};

anyTC => sei _ TypeAny[];

definitionTC => { 
sei _ MakeNonCtxSe[SERecord.cons.definition.SIZE];
seb[sei].typeInfo _ definition[nDummyGfi: [q: 0, r: 1], named: FALSE, defCtx: ]};

unionTC => sei _ Union[node, linkId];
sequenceTC => sei _ Sequence[node];

relativeTC => {
sei _ MakeNonCtxSe[SERecord.cons.relative.SIZE];
seb[sei].typeInfo _ relative[baseType: , offsetType: , resultType: ];
TypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

subrangeTC => {
sei _ MakeNonCtxSe[SERecord.cons.subrange.SIZE];
seb[sei].typeInfo _ subrange[
filled: FALSE,  empty: FALSE,
rangeType: ,
origin: , range: ];
TypeExp[tb[node].son[1]];  Exp[tb[node].son[2]]};

longTC => {
sei _ MakeNonCtxSe[SERecord.cons.long.SIZE];
seb[sei].typeInfo _ long[rangeType: ];
TypeExp[tb[node].son[1]]};

opaqueTC => {
sei _ MakeNonCtxSe[SERecord.cons.opaque.SIZE];
seb[sei].typeInfo _ opaque[
lengthKnown: tb[node].son[1] # Tree.Null,
length: 0,
id: WITH seb[typeId] SELECT FROM
id => LOOPHOLE[typeId],
ENDCASE => ISENull];
Exp[tb[node].son[1]]};

zoneTC => {
sei _ MakeNonCtxSe[SERecord.cons.zone.SIZE];
seb[sei].typeInfo _ zone[counted: ~tb[node].attr1, mds: tb[node].attr2]};

paintTC => {
sei _ CSENull;
TypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

implicitTC, linkTC, frameTC => sei _ CSENull;
dot, discrimTC => {TypeExp[tb[node].son[1]]; sei _ CSENull};

apply => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]; sei _ CSENull};

ENDCASE => {sei _ CSENull; Log.Error[nonTypeCons]};

tb[node].info _ sei};
ENDCASE => NULL
};

OptTypeExp: PROC[t: Tree.Link] = {IF t # Tree.Null THEN TypeExp[t]};


Enumeration: PROC[node: Tree.Index] RETURNS[ctx: CTXIndex] = {
saved: ContextInfo = current;
NewContext[lZ, ListLength[tb[node].son[1]], TRUE];  ctx _ current.ctx;
tb[node].son[1] _ Ids[
list: tb[node].son[1],
public: tb[node].attr1,
link: Tree.NullIndex];
current _ saved;  RETURN};

AssignValues: PROC[type: CSEIndex, valueType: Type] = {
WITH t: seb[type] SELECT FROM
enumerated => {
i: CARDINAL _ 0;
FOR sei: ISEIndex _ FirstCtxSe[t.valueCtx], NextSe[sei] UNTIL sei = ISENull DO
seb[sei].idType _ valueType;  seb[sei].idInfo _ 0;
seb[sei].idValue _ i;  i _ i+1;
seb[sei].immutable _ seb[sei].constant _ TRUE;
seb[sei].mark3 _ seb[sei].mark4 _ TRUE;
ENDLOOP;
t.empty _ (i=0);  t.nValues _ i};
ENDCASE => ERROR
};


FieldList: PROC[t: Tree.Link, level: ContextLevel, typeId: Type] 
RETURNS [ctx: CTXIndex, nFields: NAT] = {
saved: ContextInfo = current;
nFields _ CountIds[t];
NewContext[level, nFields, TRUE];  ctx _ current.ctx; 
DeclList[t, typeId];
current _ saved;  RETURN};

ArgList: PROC[t: Tree.Link] RETURNS [sei: CSEIndex] = {
IF t = Tree.Null THEN sei _ RecordSENull
ELSE IF OpName[t] = anyTC THEN sei _ TypeAny[]
ELSE {
tCtx: CTXIndex;
nFields: NAT;
sei _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
[tCtx, nFields] _ FieldList[t, lZ, sei];
seb[sei].typeInfo _ record[
machineDep: FALSE,
painted: FALSE,
argument: TRUE,
hints: [
unifield: nFields = 1,
variant: FALSE,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: tCtx,
monitored: FALSE,
linkPart: notLinked[]]};
RETURN};


anySei: CSEIndex;

TypeAny: PROC RETURNS [CSEIndex] = {
IF anySei = CSENull THEN {
anySei _ MakeNonCtxSe[SERecord.cons.any.SIZE];
seb[anySei] _ [mark3: TRUE, mark4: TRUE, body: cons[any[]]]};
RETURN[anySei]};


TagField: PROC[t: Tree.Link, MakeTagType: PROC RETURNS[CSEIndex]]
RETURNS [tagId: ISEIndex] = {
saved: ContextInfo = current;
node: Tree.Index;
current.ctx _ CTXNull;  current.seChain _ MakeSeChain[CTXNull, 1, FALSE];
DeclList[t];
node _ GetNode[t];
tagId _ FirstId[tb[node].son[1]];
IF OpName[tb[node].son[2]] = implicitTC THEN {
subNode: Tree.Index = GetNode[tb[node].son[2]];
IF MakeTagType # NIL THEN tb[subNode].info _ MakeTagType[]
ELSE {Log.Error[attrClash]; tb[subNode].info _ typeANY}};
current _ saved;  RETURN};

Union: PROC[node: Tree.Index, linkId: Type] RETURNS[sei: CSEIndex] = {
saved: ContextInfo = current;

MakeTagType: PROC RETURNS [type: CSEIndex] = {
saved: ContextInfo = current;

CollectTags: Tree.Scan = {
node: Tree.Index = GetNode[t];
tb[node].son[1] _ Ids[
list: tb[node].son[1],
public: tb[node].attr2,
link: Tree.NullIndex
! NameClash => {RESUME}]
};

NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
type _ MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
seb[type].typeInfo _ enumerated[
ordered: FALSE, sparse: FALSE,
machineDep: FALSE,
unpainted: ~dataPtr.interface,
valueCtx: current.ctx, empty: , nValues: ];
ScanList[tb[node].son[2], CollectTags];
AssignValues[type, type];
current _ saved;  RETURN};

tagId: ISEIndex = TagField[tb[node].son[1], MakeTagType];
NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
DeclList[tb[node].son[2], linkId
! NameClash => {Log.ErrorHti[duplicateTag, name]; RESUME}];
sei _ MakeNonCtxSe[SERecord.cons.union.SIZE];
seb[sei].typeInfo _ union[
caseCtx: current.ctx,
machineDep: tb[node].attr1,
overlaid: tb[node].attr2,
controlled: seb[tagId].hash # nullName,
tagSei: tagId,
hints: [
equalLengths: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE]];
current _ saved;  RETURN};

Sequence: PROC[node: Tree.Index] RETURNS[sei: CSEIndex] = {
tagId: ISEIndex = TagField[tb[node].son[1], NIL];
IF tb[node].attr2 THEN Log.Error[attrClash];
TypeExp[tb[node].son[2]];
sei _ MakeNonCtxSe[SERecord.cons.sequence.SIZE];
seb[sei].typeInfo _ sequence[
packed: tb[node].attr3,
controlled: seb[tagId].hash # nullName,
machineDep: tb[node].attr1,
tagSei: tagId,
componentType: ];
RETURN};



Stmt: PROC[stmt: Tree.Link] = {
node: Tree.Index;
saveIndex: SourceMap.Loc = dataPtr.textIndex;
IF stmt = Tree.Null THEN RETURN;
WITH stmt SELECT FROM
subtree => {
node _ index;
dataPtr.textIndex _ tb[node].info;
SELECT tb[node].name FROM
assign => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
extract => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
apply => {
Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
block => Block[node];
if => {
Exp[tb[node].son[1]]; StmtList[tb[node].son[2]]; StmtList[tb[node].son[3]]};
case => {
Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Stmt]; Stmt[tb[node].son[3]]};
bind => {
Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
SelectionList[tb[node].son[3], Stmt];
Stmt[tb[node].son[4]]};
do => DoStmt[node];
return, resume => ExpList[tb[node].son[1]];
label => {StmtList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
goto, exit, loop, reject, continue, retry, syserror, stop, null => NULL;
free => {
Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
signal, error, xerror, start, restart,
join, wait, notify, broadcast, dst, lst, lste, lstf =>
Exp[tb[node].son[1]];
open => {ExpList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
enable => {CatchPhrase[tb[node].son[1]]; StmtList[tb[node].son[2]]};
checked => Stmt[tb[node].son[1]];
list => ScanList[stmt, Stmt];
item => Stmt[tb[node].son[2]];
ENDCASE => Log.Error[unimplemented]};
ENDCASE => NULL;
dataPtr.textIndex _ saveIndex};

StmtList: PROC[list: Tree.Link] = Stmt;

Block: PROC[node: Tree.Index] = {
saved: ContextInfo = current;
bti: BTIndex = NewScope[node, tb[node].son[1]];
tb[node].info _ bti;
StmtList[tb[node].son[2]];
BodyList[bb[bti].firstSon];
current _ saved;  btLink _ [which:sibling, index:bti]};

SelectionList: PROC[t: Tree.Link, selection: Tree.Scan] = {

Item: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex _ tb[node].info;
IF OpName[tb[node].son[1]] # decl THEN {
ExpList[tb[node].son[1]]; selection[tb[node].son[2]]}
ELSE {
saved: ContextInfo = current;
bti: BTIndex = NewScope[node, tb[node].son[1]];
tb[node].name _ ditem;  tb[node].info _ bti;  tb[node].attr3 _ FALSE;
selection[tb[node].son[2]];
current _ saved;  btLink _ [which:sibling, index:bti]};
dataPtr.textIndex _ saveIndex};

ScanList[t, Item]};

DoStmt: PROC[node: Tree.Index] = {
OPEN tb[node];
saved: ContextInfo = current;
forTree: Tree.Link = tb[node].son[1];
bti: BTIndex _ BTNull;
IF forTree # Tree.Null THEN {
subTree: Tree.Link = NthSon[forTree, 1];
IF OpName[subTree] # decl THEN Exp[subTree]
ELSE bti _ NewScope[node, subTree];
PutInfo[forTree, bti];
SELECT OpName[forTree] FROM
forseq => {Exp[NthSon[forTree, 2]]; Exp[NthSon[forTree, 3]]};
upthru, downthru => Range[NthSon[forTree, 2]];
ENDCASE => ERROR};
Exp[tb[node].son[2]];
ExpList[tb[node].son[3]];
StmtList[tb[node].son[4]]; StmtList[tb[node].son[5]]; StmtList[tb[node].son[6]];
current _ saved;
IF bti # BTNull THEN btLink _ [which:sibling, index:bti]};

CatchPhrase: PROC[t: Tree.Link] = {
node: Tree.Index = GetNode[t];
saved: ContextInfo = current;
NewContext[
level: NextLevel[saved.staticLevel],
entries: 0,
unique: FALSE];
SelectionList[tb[node].son[1], Stmt];  Stmt[tb[node].son[2]];
current _ saved};



Exp: PROC[exp: Tree.Link] = {
IF exp = Tree.Null THEN RETURN;
WITH exp SELECT FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
apply => {
Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
signalx, errorx, startx, fork, joinx,
dot, uparrow, uminus, not, addr, create, cast =>
Exp[tb[node].son[1]];
plus, minus, times, div, mod,
relE, relN, relL, relGE, relG, relLE, intOO, intOC, intCO, intCC,
or, and, assignx => {
Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
in, notin => {Exp[tb[node].son[1]]; Range[tb[node].son[2]]};
ifx => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]; Exp[tb[node].son[3]]};
casex => {
Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Exp]; Exp[tb[node].son[3]]};
bindx => {
Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
SelectionList[tb[node].son[3], Exp];
Exp[tb[node].son[4]]};
extractx => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
pred, succ, ord, lengthen, float, abs, min, max, base, length, all, val =>
ExpList[tb[node].son[1]];
arraydesc => {
SELECT ListLength[tb[node].son[1]] FROM
1 => Exp[tb[node].son[1]];
3 => {
subNode: Tree.Index = GetNode[tb[node].son[1]];
Exp[tb[subNode].son[1]];  Exp[tb[subNode].son[2]];
OptTypeExp[tb[subNode].son[3]]};
ENDCASE => ERROR};
void, clit, llit, atom, mwconst, syserrorx => NULL;
loophole => {Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]]};
narrow, istype => {
Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
new => {
Exp[tb[node].son[1]];
TypeExp[tb[node].son[2]];
tb[node].son[3] _ InitialValue[tb[node].son[3], ISENull];
IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
cons, listcons => {
Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
first, last, typecode => TypeExp[tb[node].son[1]];
size => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
nil => OptTypeExp[tb[node].son[1]];
item => Exp[tb[node].son[2]];
ENDCASE => Log.Error[unimplemented]};
ENDCASE => NULL
};

ExpList: PROC[list: Tree.Link] = INLINE {ScanList[list, Exp]};

Position: PROC[t: Tree.Link] = {
IF OpName[t] = item THEN {
node: Tree.Index = GetNode[t];
Exp[tb[node].son[1]];  Exp[tb[node].son[2]]}
ELSE Exp[t]};

Range: PROC[t: Tree.Link] = {
WITH t SELECT FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name FROM
subrangeTC => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
IN [intOO .. intCC] => Exp[t];
ENDCASE => TypeExp[t]};
ENDCASE => TypeExp[t]
};

}.


πPass2.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Satterthwaite, November 26, 1985 3:14:19 pm PST
Donahue,  9-Dec-81 12:03:59
Russ Atkinson (RRA) March 6, 1985 11:54:58 pm PST
called by allocator whenever tables are repacked
main driver
process LOCKS clause
monitor lock processing
body processing
queue body for later processing
force nesting message here
conservative initial approximations
declarations
id list manipulation
type manipulation
statements
expressions
Κ’˜
codeš
œ
™
Kšœ
Οm
œ1™<Kš
œ/™/Kš
œ™K™1—K˜š
Οk	˜	Kšœžœ
žœ2˜CKšœ	žœ
žœŒ
˜Ÿ
Kšœžœ
žœ˜Kšœžœ
žœ˜"Kšœžœ
žœ
˜"Kšœ	žœ
žœ«˜ΎKšœžœ
žœƒ
˜˜
Kšœžœ
žœE˜Ušœ	žœ
žœc˜vK˜——šœž˜Kšžœ<˜CKšžœ˜Kšžœ˜!K˜KšœΟc˜*KšœŸ˜2KšœŸ$˜8KšœŸ!˜3K˜˜Kš
œ0™0K˜K˜AK˜—šœ
žœžœ
˜K˜K˜K˜K˜—K˜K˜šΟn
œžœžœ
žœ˜EKšžœ˜K˜Kšžœ
žœ	žœ'˜Fšžœ˜K˜K˜G—˜K˜K˜——Kš
œ™˜š œžœ
žœžœ˜8K˜K˜5˜Kš
ž˜šžœŸ˜#Kšœ/žœ˜7Kšœ.žœ˜7—K˜"K˜K˜?K˜&˜K˜
K˜AKšœžœ˜—K˜ K˜"K˜š
œ™K˜0K˜)—K˜K˜=Kšžœ
˜—K˜#Kšžœ˜K˜—š 
œžœ˜"K˜Kšœžœ˜%K˜ K˜K˜K˜—š œžœžœ˜'K˜:K˜K˜K˜K˜——Kš
œ™˜K˜K˜š œžœ'žœ˜PK˜šžœžœ˜K˜Kšœ-žœ˜4K˜K˜1K˜—Kšžœ˜K˜—š œžœ˜K˜ ˜K˜K˜K˜—KšœHžœ˜NK˜K˜——Kš
œ™˜K˜K˜š œžœ!žœ˜MKš
œ™Kš
œ™šžœ ž˜*˜Kšœ@žœ˜FK˜1—šžœ˜Kšœ@žœ˜FK˜?——K˜Kš
œ-˜-K˜MK˜Kšœ#žœ
˜)š
œ#™#K˜Kšœžœ
˜Kš	œžœ
žœžœžœ˜O—Kšœžœ˜K˜—š œžœ˜ šžœžœ˜K˜šžœžœ ˜=Kšžœ
žœžœ
žœ
˜!——šžœ˜K˜%K˜4—˜K˜——š œžœ'˜9Kšžœžœžœ˜HšžœŸ˜K˜šžœž˜Kšœžœ
˜Kšœžœ
˜$Kšžœ
˜——š
œ˜˜K˜———š œžœ˜%šžœ-žœž˜Ešžœ	žœ
ž˜Kšœžœ˜*Kšžœžœ
˜—Kšžœžœ
žœ
˜)Kš
ž˜—š
œ˜K˜——š œžœ˜Kšœžœ+˜DK˜K˜K˜+K˜K˜K˜K˜#Kšœ:žœ˜Cšœ	žœžœžœ˜EKšžœ˜Kšžœ˜—˜K˜
K˜,K˜—K˜CK˜Ašœžœžœ˜9Kšžœ
˜Kšžœ*˜.—šžœžœ˜Kšžœžœ
žœ
˜K˜9—K˜Kšžœžœ˜"K˜K˜K˜K˜IK˜K˜—š œžœ%žœ˜LK˜6Kšœ8žœ˜?Kšœ7žœ˜=˜K˜K˜šœžœ˜%Kšžœžœžœ˜4—K˜$K˜K˜DK˜—K˜3K˜K˜K˜—š œžœžœžœ˜OKšœžœ-žœ˜C˜Kšœžœžœžœ
˜2˜Kšœ
žœžœ
˜ Kšœžœžœžœ
˜:Kšœ
žœžœžœ˜2—K˜
K˜K˜K˜—Kšžœ˜K˜K˜—š œžœ˜$K˜#K˜%K˜K˜——Kš
œ™˜Kš œžœ)˜7˜˜K˜Kš
œ-˜-K˜"˜K˜K˜!K˜K˜—Kšœ"žœ
˜(šžœž˜˜
K˜KK˜—˜	K˜*˜K˜Kšžœžœžœ˜?——Kšžœ˜$—K˜K˜—K˜K˜—š œžœžœžœ˜9K˜5Kšœžœ˜#K˜K˜—š œžœžœ˜HKšœŸ˜šžœž˜šžœžœ
ž˜˜K˜!šžœž˜˜	K˜'K˜šžœžœ˜K˜$šžœž˜!K˜1——K˜%—˜K˜&K˜K˜.—˜K˜"K˜)—K˜Kšžœ˜——Kšžœ˜——š
œ˜˜K˜———˜K˜Kš
œ-˜-K˜"Kšœ5žœ˜HK˜K˜K˜——Kš
œ™˜š œžœ˜K˜Kšœžœ
˜
Kšœžœžœ
˜K˜Kšžœ˜K˜˜šžœžœ
ž˜˜šœžœžœ
ž˜ K˜K˜Kšžœžœ˜—K˜ K˜*K˜Kšœžœžœ
žœ	˜5K˜Kšœ)žœ
˜/K˜.Kšœ)žœ
˜/K˜—˜K˜K˜BK˜—Kšžœžœ
˜—Kšžœ˜K˜—Kšžœ˜K˜K˜—š œžœžœ˜1K˜šžœ
žœžœ
ž˜K˜K˜%Kšžœžœ
˜—š
œ˜K˜K˜———Kš
œ™˜š œžœ1˜>K˜šžœžœ
ž˜˜K˜!Kšžœž˜˜˜Kšœ,žœ˜2˜Kšœ	žœ
žœ
˜K˜Kšœžœ˜2K˜1—Kšœžœžœžœ˜>K˜—˜K˜Kšœ	žœ
˜
Kšœ2žœ˜8˜K˜K˜
Kšœžœžœžœ˜3—˜K˜Kšœžœžœ˜BKšœ
žœ
˜˜Kšœžœ˜*K˜Kšœžœžœžœ
˜:Kšœ
žœžœžœ˜1—K˜	K˜K˜'K˜—Kšžœžœžœ˜MK˜—˜Kšœ/žœ˜5˜K˜K˜Kšœ
žœ
˜˜Kšœ
žœ
˜K˜Kšœžœžœžœ
˜:Kšœ
žœžœžœ˜1—K˜	K˜DKšœžœ
˜K˜K˜——˜$Kšœ%žœ˜+˜Kšœžœ˜9K˜K˜K˜K˜K˜K˜—K˜K˜—˜Kšœ'žœ˜-˜K˜K˜K˜—K˜8K˜—˜Kšœ+žœ˜1˜Kšœžœ˜7—K˜K˜—˜<šœ	žœ"žœ˜CK˜/K˜6—Kšœ*žœ˜0˜K˜3K˜"K˜$K˜——K˜K˜˜Kšœ,žœ˜2Kšœ?žœ
˜QK˜—K˜%K˜#K˜˜Kšœ*žœ˜0K˜EK˜5K˜—˜Kšœ*žœ˜0˜Kšœžœ
žœ
˜K˜K˜—K˜1K˜—˜Kšœ&žœ˜,K˜&K˜K˜—˜
Kšœ(žœ˜.˜K˜)K˜
šœžœ
žœ
ž˜ Kšœžœ	˜Kšžœ
˜——K˜K˜—˜Kšœ&žœ˜,K˜IK˜—˜K˜K˜5K˜—K˜-K˜<K˜K˜IK˜Kšžœ,˜3K˜—K˜—Kšžœž˜—š
œ˜K˜——Kš 
œžœžœžœ
˜DK˜K˜š œžœžœ˜>K˜Kšœ,žœ˜F˜K˜K˜K˜—Kšœžœ˜K˜—š œžœ%˜7šžœžœ
ž˜˜Kšœžœ˜šžœ5žœž˜NK˜2K˜Kšœ)žœ
˜.Kšœ"žœ
˜'Kšžœ
˜—K˜!—Kšžœž˜—š
œ˜K˜K˜——š 	œžœ2˜AKšžœžœ˜)K˜K˜Kšœžœ˜6K˜Kšœžœ˜K˜—š œžœžœ˜7Kšžœžœ˜(Kšžœ
žœžœ˜.šžœ˜K˜Kšœ	žœ
˜
Kšœ2žœ˜8K˜(˜Kšœžœ
˜Kšœ	žœ
˜Kšœ
žœ
˜˜K˜Kšœ	žœ
˜Kšœžœžœžœ
˜:Kšœ
žœžœžœ˜1—K˜	K˜Kšœžœ
˜K˜——Kšžœ˜K˜K˜—K˜K˜š œžœ
žœ˜$šžœžœ˜Kšœ(žœ˜.Kšœžœ	žœ˜=—Kšžœ
˜K˜K˜—š
 œžœ œžœ
žœ˜AKšžœ˜K˜K˜KšœBžœ˜IK˜K˜K˜!šžœ&žœ˜.K˜/Kšžœžœ
žœ!˜:Kšžœ5˜9—Kšœžœ˜K˜—š œžœ!žœ˜FK˜K˜š œžœ
žœ˜.K˜K˜˜K˜˜K˜K˜K˜Kšœžœ˜—š
œ˜K˜——Kšœ*žœ˜0Kšœ-žœ˜3˜ Kšœ	žœ
žœ
˜Kšœžœ
˜K˜K˜+—K˜'K˜Kšœžœ˜K˜—K˜9Kšœ*žœ˜0˜ Kšœ2žœ˜;—Kšœ'žœ˜-˜K˜K˜K˜K˜'K˜˜Kšœžœ
˜Kšœ
žœžœžœ˜2——Kšœžœ˜K˜—š œžœžœ˜;Kšœ,žœ˜1Kšžœžœ˜,K˜Kšœ*žœ˜0˜K˜K˜'K˜K˜K˜—Kšžœ˜K˜K˜——Kš
œ
™
˜š œžœ˜K˜Kš
œ-˜-Kšžœžœ
žœ
˜ šžœžœ
ž˜˜K˜
K˜"šžœž˜K˜7K˜<˜
K˜0Kšžœžœ˜9—K˜˜K˜L—˜	K˜S—˜	K˜,K˜%K˜—K˜K˜+K˜@KšœCžœ
˜H˜	K˜,Kšžœžœ˜9—K˜&˜6K˜—K˜>K˜DK˜!K˜K˜Kšžœ˜%——Kšžœžœ
˜—K˜K˜—Kš œžœ˜'K˜š œžœ˜!K˜K˜/K˜K˜K˜K˜7K˜—Kš 
œžœ(˜;˜˜K˜Kš
œ-˜-K˜"šžœ žœ˜(K˜5—šžœ˜K˜K˜/Kšœ?žœ
˜EK˜K˜7—K˜K˜—K˜K˜—š œžœ˜"Kšžœ
˜K˜K˜%K˜šžœžœ˜K˜(Kšžœžœ
˜+Kšžœ˜#K˜šžœž˜K˜=K˜.Kšžœžœ˜——K˜K˜K˜PK˜Kšžœžœ&˜:K˜—š œžœ˜#K˜K˜˜K˜$K˜Kšœžœ˜—K˜=K˜K˜K˜——Kš
œ™˜š œžœ˜Kšžœžœ
žœ
˜šžœžœ
ž˜˜K˜šžœž˜˜
K˜0Kšžœžœ˜9—K˜%˜0K˜—K˜K˜A˜K˜,—K˜<K˜J˜
K˜Q—˜
K˜,K˜$K˜—K˜=˜JK˜—˜šžœž˜'K˜˜K˜/K˜2K˜ —Kšžœžœ˜——Kšœ.žœ
˜3K˜@˜K˜2Kšžœžœ˜9—˜K˜K˜K˜9Kšžœžœ˜9—˜K˜0Kšžœžœ˜9—K˜2K˜9K˜#K˜Kšžœ˜%——Kšžœž˜—š
œ˜K˜——Kš œžœžœ˜>K˜š œžœ˜ šžœžœ˜K˜K˜,—Kšžœ	˜
K˜—š œžœ˜šžœžœ
ž˜˜K˜!šžœž˜K˜?Kšžœ˜Kšžœ˜——Kšžœ˜—š
œ˜K˜———˜K˜———…—`ϊx|