[Indigo]<Cedar>Compiler>Pass2.Mesa!7

file Pass2.mesa

last modified by Satterthwaite, February 22, 1983 10:29 am

last modified by Donahue, 9-Dec-81 12:03:59

DIRECTORY

Alloc: TYPE USING [Notifier, AddNotify, Bounds, DropNotify, 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],

Symbols: TYPE USING [

Base, BodyLink, BodyRecord, ContextLevel, SERecord, TransferMode,

Name, Type, CSEIndex, ISEIndex, RecordSEIndex,

CTXIndex, BTIndex, CBTIndex,

nullName, nullType, CSENull, ISENull, RecordSENull,

CTXNull, BTNull, CBTNull,

lG, lL, lZ, RootBti, typeANY, typeTYPE, seType, ctxType, bodyType],

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, 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 = {

called by allocator whenever tables are repacked

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]}};

main driver

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]];

process LOCKS clause

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]};

monitor lock processing

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};

body processing

btLink: BodyLink;

AllocateBody: PROC [node: Tree.Index, id: ISEIndex] RETURNS [bti: CBTIndex] = {

queue body for later processing

force nesting message here

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;

bb[bti].info ← [Internal[bodyTree:node, thread:Tree.NullIndex, frameSize: ]];

bb[bti].id ← id;

bb[bti].entry ← bb[bti].internal ← FALSE;

conservative initial approximations

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 = WITH bb[bti].info SELECT FROM

Internal => bodyTree,

ENDCASE => ERROR;

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]};

declarations

DeclList: PROC [t: Tree.Link, linkId: Type←nullType] = {

DeclItem: Tree.Scan = {

node: Tree.Index = GetNode[t];

saveIndex: CARDINAL = 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𡤀] = {

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 => {

node: Tree.Index = 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]};

IdItem: Tree.Scan = {

node: Tree.Index = GetNode[t];

saveIndex: CARDINAL = dataPtr.textIndex;

dataPtr.textIndex ← tb[node].info;

tb[node].son[1] ← Ids[list: tb[node].son[1], public: FALSE, link: node];

dataPtr.textIndex ← saveIndex};

id list manipulation

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]};

type manipulation

TypeExp: PROC [t: Tree.Link, typeId, linkId: Type←nullType] = {

sei: CSEIndex;

WITH t SELECT FROM

subtree => {

node: Tree.Index = 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[nGfi: 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};

statements

Stmt: PROC [stmt: Tree.Link] = {

node: Tree.Index;

saveIndex: CARDINAL = 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: CARDINAL = 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};

expressions

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] = {

node: Tree.Index;

WITH t SELECT FROM

subtree => {

node ← 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]};