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