-- file PPPass1T.Mesa rewritten by PGS, 4-Feb-81 15:37
-- Copyright (C) 1985 by Xerox Corporation. All rights reserved.
-- file PPPass1T.Mesa
-- syntax last modified by Satterthwaite, February 4, 1981 3:23 PM
-- rules last modified by Satterthwaite, February 4, 1981 3:23 PM
-- Russ Atkinson, February 12, 1985 3:34:58 pm PST
-- Paul Rovner, August 10, 1983 3:49 pm

DIRECTORY
PPParseTable USING [ActionEntry, ProdDataHandle],
PPP1 USING [Value, ValueStack, InputLoc, IdOfFirst, IdOfLock, IdOfRest, INTSeq, ActionEntrySeq],
PPLeaves USING [HTIndex, HTNull],
PPTree USING [AttrId, Link, Map, NodeName, Null],
PPTreeOps USING [
FreeTree, ListLength, MakeNode, ExtractTree, InsertTree, OpName,
PopTree, PushTree, PushHash, PushList, PushLit, PushProperList, PushSe,
PushNode, PushStringLit, SetAttr, SetInfo, UpdateList],
Rope USING [ROPE];

PPPass1T: PROGRAM
IMPORTS P1: PPP1, TreeOps: PPTreeOps
EXPORTS PPP1 =
BEGIN OPEN PPLeaves, Tree: PPTree, ParseTable: PPParseTable, Rope, TreeOps;

Op: TYPE = Tree.NodeName;
idANY: ROPE = "UNSPECIFIED";
idINT: ROPE = "INTEGER";
idLOCK: ROPE = "LOCK";

-- local data base (supplied by parser)

v: P1.ValueStack;
l: REF P1.INTSeq;
q: REF P1.ActionEntrySeq;

prodData: ParseTable.ProdDataHandle;

-- initialization/termination

AssignDescriptors: PUBLIC PROC [
 qd: REF P1.ActionEntrySeq,
 vd: P1.ValueStack,
 ld: REF P1.INTSeq,
 pp: ParseTable.ProdDataHandle] =
{q ← qd; v ← vd; l ← ld; prodData ← pp};

-- stack manipulation
-- note that r and s may be overlaid in some parameterizations

PushHashV: PROC [k: NAT] = {PushHash[v[k].r]};
PushLitV: PROC [k: NAT] = {PushLit[v[k].r]};
PushStringLitV: PROC [k: NAT] = {PushStringLit[v[k].r]};

PushNodeV: PROC [k: NAT, count: INTEGER] = {PushNode[LOOPHOLE[v[k].s], count]};
PushListV: PROC [k: NAT] = {PushList[v[k].s]};
PushProperListV: PROC [k: NAT] = {PushProperList[v[k].s]};

SetAttrV: PROC [attr: Tree.AttrId, k: NAT] = {SetAttr[attr, LOOPHOLE[v[k].s MOD 2]]};
SetAttrs: PROC [attr1, attr2, attr3: BOOLEAN ← FALSE] =
BEGIN
SetAttr[1,attr1]; SetAttr[2,attr2]; SetAttr[3,attr3];
END;

-- value manipulation

IntV: PROC [k: NAT] RETURNS [INTEGER] = {RETURN [v[k].s]};
SetIntV: PROC [k: NAT, i: INTEGER] = {v[k].s ← i};

BoolV: PROC [k: NAT] RETURNS [BOOLEAN] = {RETURN [LOOPHOLE[v[k].s MOD 2]]};
SetBoolV: PROC [k: NAT, b: BOOLEAN] = {v[k].s ← LOOPHOLE[b]};

OpV: PROC [k: NAT] RETURNS [Op] = {RETURN [LOOPHOLE[v[k].s]]};
SetOpV: PROC [k: NAT, op: Op] = {v[k].s ← LOOPHOLE[op]};

NegatedV: PROC [k: NAT] RETURNS [Op] =
BEGIN
op: Op = LOOPHOLE[v[k].s];
RETURN [SELECT op FROM
relE => relN, relN => relE,
relL => relGE, relGE => relL,
relG => relLE, relLE => relG,
in => notin, notin => in,
ENDCASE => op]
END;


-- shared processing routines

DetachItem: Tree.Map = TRUSTED {PushTree[t]; RETURN [Tree.Null]};

AnonField: PROC [type, default: Tree.Link, top: CARDINAL] =
BEGIN
PushField[HTNull, type, default, top];
END;

PushField: PROC [id: HTIndex, type, default: Tree.Link, top: CARDINAL] =
BEGIN
PushHash[id]; PushTree[type]; PushTree[default];
PushNode[decl,3]; LinkToSource[top];
SetAttrs[FALSE,public,FALSE];
END;

-- the interpretation rules

LinkToSource: PROC [index: CARDINAL] = {SetInfo[l[index]]};

-- propagated attributes
public: BOOLEAN;
machineDep: BOOLEAN;

ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] = BEGIN
t1, t2: Tree.Link;
SetOpTop: PROC [op: Op] = {
 SetOpV[top, op];
 };
FOR i: CARDINAL IN [0..qI) DO {
top ← top-q[i].tag.pLength+1;
SELECT prodData[q[i].transition].rule FROM

-- basic tree building
0 => -- TABLE: MesaTab TYPE: ParseTable EXPORTS: CBinary
  -- GOAL: goal

  --TERMINALS:
  -- id num lnum flnum string lstring char atom
  -- , ; : .. => ←
  -- = # < > <= >= ~
  -- + - * / ^ . @ ! '|
  -- RECORD POINTER REF LIST ARRAY SEQUENCE DESCRIPTOR
  -- PROCEDURE PROC PORT SIGNAL ERROR PROCESS
  -- PROGRAM MONITOR ZONE RELATIVE LONG
  -- TYPE FRAME TO ORDERED UNCOUNTED
  -- BASE OF PACKED RETURNS MONITORED
  -- OVERLAID COMPUTED MACHINE DEPENDENT DIRECTORY
  -- DEFINITIONS IMPORTS EXPORTS SHARES RESIDENT
  -- LOCKS USING PUBLIC PRIVATE READONLY
  -- ENTRY INTERNAL INLINE CODE
  -- ABS ALL AND CONS MAX MIN MOD
  -- NOT OR PRED LENGTH NEW START SUCC
  -- FORK JOIN LOOPHOLE NARROW ISTYPE SIZE
  -- FIRST LAST NIL NULL IF THEN ELSE
  -- WITH FROM FOR DECREASING IN
  -- THROUGH UNTIL WHILE REPEAT FINISHED
  -- RETURN EXIT LOOP GOTO GO
  -- FREE WAIT RESTART NOTIFY BROADCAST STOP
  -- RESUME REJECT CONTINUE RETRY TRANSFER STATE
  -- OPEN ENABLE ANY EXITS )
  -- ) ] } END ENDLOOP ENDCASE
  -- ( [ { BEGIN DO SELECT

  --ALIASES:
  -- id tokenID
  -- num tokenNUM
  -- lnum tokenLNUM
  -- flnum tokenFLNUM
  -- string tokenSTR
  -- lstring tokenLSTR
  -- char tokenCHAR
  -- atom tokenATOM
  -- - tokenMINUS
  -- . tokenDOT
  -- .. tokenDOTS
  -- = tokenEQUAL
  -- => tokenARROW
  -- < tokenLESS
  -- <= tokenLE
  -- > tokenGREATER
  -- >= tokenGE
  -- . InitialSymbol

  --PRODUCTIONS:

-- goal ::= . unit .
  -- goal ::= . unit ..
  NULL;
1 => -- unit ::= directory module
  {PushNode[unit,2]; GO TO linkSource};
2 => -- directory ::= DIRECTORY includelist ;
  PushListV[top+1];
3 => -- includeitem ::= id : FROM string using
  BEGIN
  PushStringLitV[top+3]; PushHashV[top];
  PushNode[diritem,-3]; GO TO linkSource;
  END;
4 => -- includeitem ::= id : TYPE using
  -- includeitem ::= id using
  BEGIN
  PushTree[Tree.Null]; PushHashV[top];
  PushNode[diritem,-3]; GO TO linkSource;
  END;
5 => -- includeitem ::= id : TYPE id using
  BEGIN
  PushHashV[top+3]; PushHashV[top];
  PushNode[diritem,-3]; GO TO linkSource;
  END;
6 => -- using ::= USING [ ]
  PushProperList[0];
7 => -- module ::= identlist classhead block
  -- module ::= identlist defhead defbody
  BEGIN
  IF ~BoolV[top+2] THEN InsertTree[Tree.Null,2];
  PushTree[Tree.Null];
  t1 ← MakeNode[body,4]; t2 ← ExtractTree[2];
  PushTree[ExtractTree[5]]; PushTree[t2]; PushTree[t1];
  SetAttrs[FALSE,FALSE,FALSE];
  PushNode[decl,3]; LinkToSource[top];
  SetAttrs[TRUE,TRUE,FALSE];
  PushNode[module,5]; SetAttrV[1,top+1];
  GO TO linkSource;
  END;
8 => -- classhead ::= resident class arguments locks interface = public
  BEGIN
  t1 ← ExtractTree[4];
  PushTree[ExtractTree[5]]; PushTree[ExtractTree[5]];
  PushNode[programTC,2]; SetAttrV[1, top+1];
  IF ~BoolV[top+1] OR t1 # Tree.Null
  THEN PushTree[t1]
  ELSE
  BEGIN
  PushHash[P1.IdOfLock[]]; PushTree[Tree.Null];
  PushNode[lambda,-2]; SetAttr[1,TRUE]; SetAttr[2,public];
  END;
  machineDep ← FALSE;
  END;
9 => -- resident ::= RESIDENT
  {public ← FALSE; SetBoolV[top,TRUE]};
10 => -- resident ::=
  {public ← FALSE; SetBoolV[top,FALSE]; l[top] ← P1.InputLoc[]};
11 => -- class ::= PROGRAM
  SetBoolV[top,FALSE];
12 => -- class ::= MONITOR
  SetBoolV[top,TRUE];
13 => -- defhead ::= definitions locks imports shares = public
  BEGIN
  t1 ← ExtractTree[3];
  t2 ← PopTree[]; PushTree[Tree.Null]; PushTree[t2];
  PushNode[definitionTC,0]; PushTree[t1];
  SetBoolV[top,FALSE]; machineDep ← FALSE;
  END;
14 => -- definitions ::= DEFINITIONS
  public ← TRUE;
15 => -- defbody ::= BEGIN open declist END
-- defbody ::= { open declist }
  {PushListV[top+2]; PushTree[Tree.Null]; SetBoolV[top,TRUE]};
16 => -- locks ::= LOCKS primary lambda
  {PushNode[lambda,-2]; SetAttr[1,FALSE]; SetAttr[2,FALSE]};
17 => -- lambda ::= USING ident typeexp
  BEGIN
  PushTree[Tree.Null]; PushNode[decl,3]; LinkToSource[top+1];
  SetAttrs[FALSE,FALSE,FALSE];
  END;
18 => -- moduleitem ::= id
  BEGIN
  PushHashV[top]; PushHashV[top];
  PushNode[item,2]; SetAttr[1,FALSE]; GO TO linkSource;
  END;
19 => -- moduleitem ::= id : id
  BEGIN
  PushHashV[top]; PushHashV[top+2];
  PushNode[item,2]; SetAttr[1,TRUE]; GO TO linkSource;
  END;
20 => -- declaration ::= identlist public readonly entry typeexp initialization
  BEGIN
  IF OpV[top+3] # none THEN PushNodeV[top+3,1];
  PushNode[decl,3]; LinkToSource[top];
  SetAttrV[1,top+5]; SetAttr[2,public]; public ← BoolV[top+1];
  SetAttrV[3,top+2];
  END;
21 => -- declaration ::= identlist public TYPE = public typeexp default
BEGIN
  public ← BoolV[top+4];
  PushNode[typedecl,3]; LinkToSource[top];
  SetAttrs[TRUE,public,FALSE]; public ← BoolV[top+1];
  END;
22 => -- declaration ::= identlist public TYPE optargs
BEGIN
  PushNode[opaqueTC,1]; PushTree[Tree.Null];
  PushNode[typedecl,3]; LinkToSource[top];
  SetAttrs[TRUE,public,FALSE]; public ← BoolV[top+1];
  END;
23 => -- public ::= PUBLIC
  {SetBoolV[top,public]; public ← TRUE};
24 => -- public ::= PRIVATE
-- procaccess ::=
  {SetBoolV[top,public]; public ← FALSE};
25 => -- public ::=
  SetBoolV[top,public];
26 => -- entry ::= ENTRY
  SetOpTop[entry];
27 => -- entry ::= INTERNAL
  SetOpTop[internal];
28 => -- entry ::=
  {SetOpTop[none]; l[top] ← P1.InputLoc[]};
29 => -- idlist' ::= id
  -- identlist' ::= id :
  {PushHashV[top]; v[top].s ← LOOPHOLE[-1]};
30 => -- identlist' ::= id position :
  {PushHashV[top]; PushNode[item,-2]; v[top].s ← LOOPHOLE[-1]};
31 => -- idlist' ::= id , idlist'
  -- identlist' ::= id , identlist'
  {PushHashV[top]; v[top].s ← v[top+2].s-1};
32 => -- identlist' ::= id position , identlist'
  BEGIN
  PushTree[ExtractTree[-(v[top+3].s-1)]];
  PushHashV[top]; PushNode[item,-2]; v[top].s ← v[top+3].s-1;
  END;
33 => -- position ::= ( exp optbits )
  PushNode[item,2];
34 => -- optbits ::= : bounds
  -- interval ::= [ bounds ]
PushNode[intCC,2];
35 => -- interval ::= [ bounds )
PushNode[intCO,2];
36 => -- interval ::= ( bounds ]
PushNode[intOC,2];
37 => -- interval ::= ( bounds )
PushNode[intOO,2];
38 => -- typeexp ::= id
  -- range ::= id
  PushHashV[top];
39 => -- typeid ::= id . id
  {PushHashV[top]; PushHashV[top+2]; PushNode[dot,2]};
40 => -- typeid ::= id id
  {PushHashV[top+1]; PushHashV[top]; PushNode[discrimTC,2]};
41 => -- typeid ::= id typeid
  {PushHashV[top]; PushNode[discrimTC,2]};
42 => -- typecons ::= interval
  {PushSe[idINT]; PushNode[subrangeTC,-2]};
43 => -- typecons ::= id interval
  -- range ::= id interval
  {PushHashV[top]; PushNode[subrangeTC,-2]};
44 => -- typecons ::= typeid interval
  -- range ::= typeid interval
  PushNode[subrangeTC,2];
45 => -- typecons ::= id length
  {PushHashV[top]; PushNode[apply,-2]};
46 => -- typecons ::= typeid length
  PushNode[apply,2];
47 => -- typecons ::= dependent { elementlist }
  BEGIN
  PushListV[top+2];
  PushNode[enumeratedTC,1]; SetAttr[1,public]; SetAttr[2,machineDep];
  machineDep ← BoolV[top];
  END;
48 => -- ident  ::= id position :
-- element ::= id ( exp )
  {PushHashV[top]; PushNode[item,-2]};
49 => -- element ::= ( exp )
  {PushHash[HTNull]; PushNode[item,-2]};
50 => -- typecons ::= dependent monitored RECORD reclist
  BEGIN
  IF ~BoolV[top+1]
  THEN PushNode[recordTC,1]
  ELSE
  BEGIN
  t1 ← PopTree[]; v[top+2].s ← ListLength[t1];
  t1 ← UpdateList[t1,DetachItem]; t1 ← FreeTree[t1];
  PushList[IntV[top+2]+1]; PushNode[monitoredTC,1];
  END;
  SetAttr[1,machineDep]; SetAttrV[2,top+3]; machineDep ← BoolV[top];
  SetAttr[3,TRUE];
  END;
51 => -- typecons ::= ordered base pointertype
  BEGIN
  t2 ← MakeNode[pointerTC,1];
  t1 ← PopTree[];
  PushTree[t2];
  SetAttrV[1,top]; SetAttrV[2,top+1]; SetAttrV[3,top+2];
  IF t1 # Tree.Null THEN {PushTree[t1]; PushNode[subrangeTC,2]};
  END;
52 => -- typecons ::= REF readonly typeexp
  BEGIN
  PushNode[refTC,1];
  SetAttr[1,FALSE]; SetAttr[2,FALSE]; SetAttrV[3,top+1];
  PushNode[longTC,1];
  END;
53 => -- typecons ::= REF readonly ANY
  BEGIN
  PushNode[anyTC, 0]; PushNode[refTC,1];
  SetAttr[1,FALSE]; SetAttr[2,FALSE]; SetAttrV[3,top+1];
  PushNode[longTC,1];
  END;
54 => -- typecons ::= REF
  BEGIN
  PushNode[anyTC, 0]; PushNode[refTC,1];
  SetAttrs[FALSE,FALSE,FALSE];
  PushNode[longTC,1];
  END;
55 => -- typecons ::= LIST OF readonly typeexp
  BEGIN
  PushField[P1.IdOfFirst[], PopTree[], Tree.Null, top];
  PushField[P1.IdOfRest[], MakeNode[linkTC,0], Tree.Null, top];
  PushList[2];
  PushNode[recordTC,1]; SetAttrs[FALSE,FALSE,FALSE];
  PushNode[listTC,1]; SetAttr[1,FALSE]; SetAttr[2,FALSE]; SetAttrV[3,top+2];
  PushNode[longTC,1];
  END;
56 => -- typecons ::= packed ARRAY indextype OF typeexp
  {PushNode[arrayTC,2]; SetAttrV[3,top]};
57 => -- typecons ::= DESCRIPTOR FOR readonly typeexp
  {PushNode[arraydescTC,1]; SetAttrV[3,top+2]};
58 => -- typecons ::= transfermode arguments
  PushNodeV[top,2];
59 => -- typecons ::= id RELATIVE typeexp
  {PushHashV[top]; PushNode[relativeTC,-2]};
60 => -- typecons ::= typeid RELATIVE typeexp
  PushNode[relativeTC,2];
61 => -- typecons ::= heap ZONE
  {PushNode[zoneTC,0]; SetAttrV[1,top]; SetAttr[2,FALSE]};
62 => -- typecons ::= LONG typeexp
  PushNode[longTC,1];
63 => -- typecons ::= FRAME [ id ]
  {PushHashV[top+2]; PushNode[frameTC,1]};
64 => -- monitored ::= MONITORED
  BEGIN
  PushSe[idLOCK];
  PushField[P1.IdOfLock[], PopTree[], Tree.Null, top];
  SetBoolV[top,TRUE];
  END;
65 => -- dependent ::= MACHINE DEPENDENT
  {SetBoolV[top,machineDep]; machineDep ← TRUE};
66 => -- dependent ::=
  SetBoolV[top,machineDep];
67 => -- reclist ::= [ ]
-- reclist ::= NULL
  {PushList[0]; SetBoolV[top,FALSE]};
68 => -- reclist ::= [ pairlist ]
  -- reclist ::= [ typelist ]
  {PushListV[top+1]; SetBoolV[top,FALSE]};
69 => -- reclist ::= [ pairlist , variantpair ]
  {PushList[IntV[top+1]+1]; SetBoolV[top,TRUE]};
70 => -- reclist ::= [ variantpart default ]
  {t1 ← PopTree[]; AnonField[PopTree[], t1, top]; SetBoolV[top,TRUE]};
71 => -- pairitem ::= identlist public typeexp default
-- variantpair ::= identlist public variantpart default
  BEGIN
  PushNode[decl,3]; LinkToSource[top];
  SetAttrs[FALSE,public,FALSE]; public ← BoolV[top+1];
  END;
72 => -- defaultopt ::=
  PushProperList[0];
73 => -- defaultopt ::= NULL
  PushNode[void,0];
74 => -- defaultopt ::= exp '| NULL
  {PushNode[void,0]; PushList[2]};
75 => -- variantpart ::= SELECT vcasehead FROM variantlist ENDCASE
-- variantpart ::= SELECT vcasehead FROM variantlist , ENDCASE
  BEGIN
  PushListV[top+3];
  PushNode[unionTC,2]; SetAttr[1,machineDep]; SetAttrV[2,top+1];
  END;
76 => -- variantpart ::= packed SEQUENCE vcasehead OF typeexp
  BEGIN
  PushNode[sequenceTC,2];
  SetAttr[1,machineDep]; SetAttrV[2,top+2]; SetAttrV[3,top];
  END;
77 => -- vcasehead ::= ident public tagtype
  BEGIN
  PushTree[Tree.Null]; PushNode[decl,3]; LinkToSource[top];
  SetAttrs[FALSE,public,FALSE]; public ← BoolV[top+1];
  SetBoolV[top,FALSE];
  END;
78 => -- vcasehead ::= COMPUTED tagtype
  {AnonField[PopTree[], Tree.Null, top]; SetBoolV[top,FALSE]};
79 => -- vcasehead ::= OVERLAID tagtype
  {AnonField[PopTree[], Tree.Null, top]; SetBoolV[top,TRUE]};
80 => -- tagtype ::= *
  PushNode[implicitTC,0];
81 => -- variantitem ::= idlist => reclist
  BEGIN
  PushNode[variantTC,1];
  SetAttr[1,machineDep]; SetAttrV[2,top+2]; SetAttr[3,TRUE];
  PushTree[Tree.Null]; PushNode[typedecl,3];
  SetAttrs[TRUE,public,FALSE];
  GO TO linkSource;
  END;
82 => -- typelist ::= typecons default
  -- typelist ::= typeid default
  {t1 ← PopTree[]; AnonField[PopTree[], t1, top]; v[top].s ← LOOPHOLE[-1]};
83 => -- typelist ::= id
  {PushHashV[top]; AnonField[PopTree[], Tree.Null, top]; v[top].s ← LOOPHOLE[-1]};
84 => -- typelist ::= id ← defaultopt
  {t1 ← PopTree[]; PushHashV[top]; AnonField[PopTree[], t1, top]; v[top].s ← LOOPHOLE[-1]};
85 => -- typelist ::= typecons default , typelist
  -- typelist ::= typeid default , typelist
  BEGIN
  t1 ← ExtractTree[-(v[top+3].s-1)]; AnonField[ExtractTree[-(v[top+3].s-1)], t1, top];
  v[top].s ← v[top+3].s-1;
  END;
86 => -- typelist ::= id , typelist
  {PushHashV[top]; AnonField[PopTree[], Tree.Null, top]; v[top].s ← v[top+2].s-1};
87 => -- typelist ::= id ← defaultopt , typelist
  BEGIN
  t1 ← ExtractTree[-(v[top+4].s-1)]; PushHashV[top]; AnonField[PopTree[], t1, top];
  v[top].s ← v[top+4].s-1;
  END;
88 => -- pointertype ::= pointerprefix
  {PushSe[idANY]; SetBoolV[top,FALSE]};
89 => -- pointertype ::= pointerprefix TO readonly typeexp
  SetBoolV[top, BoolV[top+2]];
90 => -- transfermode ::= PROCEDURE
-- transfermode ::= PROC
  SetOpTop[procTC];
91 => -- transfermode ::= PORT
  SetOpTop[portTC];
92 => -- transfermode ::= SIGNAL
  SetOpTop[signalTC];
93 => -- transfermode ::= ERROR
  SetOpTop[errorTC];
94 => -- transfermode ::= PROCESS
  SetOpTop[processTC];
95 => -- transfermode ::= PROGRAM
  SetOpTop[programTC];
96 => -- initialization ::=
  {PushTree[Tree.Null]; SetBoolV[top,FALSE]};
97 => -- initvalue ::= procaccess inline block
  BEGIN
  IF ~BoolV[top+2] THEN InsertTree[Tree.Null,2];
  PushTree[Tree.Null];
  PushNode[body,4]; SetAttr[1,FALSE]; SetAttr[2,FALSE]; SetAttrV[3,top+1];
  public ← BoolV[top];
  END;
98 => -- initvalue ::= CODE
  PushNode[signalinit,0];
99 => -- initvalue ::= MACHINE CODE BEGIN codelist END
-- initvalue ::= MACHINE CODE { codelist }
  {PushProperListV[top+3]; PushNode[inline,1]};
100 => -- codelist ::= orderlist
  {PushListV[top]; v[top].s ← 1};
101 => -- codelist ::= codelist ; orderlist
  {PushListV[top+2]; v[top].s ← v[top].s+1};

102 => -- statement ::= lhs
  BEGIN
  t1 ← PopTree[]; PushTree[t1];
  IF OpName[t1] # apply THEN {PushTree[Tree.Null]; PushNode[apply,2]};
  GO TO linkSource;
  END;
103 => -- statement ::= lhs ← exp
  {PushNode[assign,2]; GO TO linkSource};
104 => -- statement ::= [ explist ] ← exp
  {PushNode[extract,2]; GO TO linkSource};
105 => -- statement ::= block
  BEGIN
  IF BoolV[top] THEN {PushNode[block,2]; LinkToSource[top]};
  t1 ← ExtractTree[2];
  IF t1 # Tree.Null THEN {PushTree[t1]; PushNode[open,-2]; GO TO linkSource};
  END;
106 => -- statement ::= IF exp THEN statement elsepart
  {PushNode[if,3]; GO TO linkSource};
107 => -- statement ::= casehead casestmtlist ENDCASE otherpart
  BEGIN
  t1 ← PopTree[]; PushProperListV[top+1]; PushTree[t1];
  IF BoolV[top] THEN PushNode[bind,4] ELSE PushNode[case,3];
  GO TO linkSource;
  END;
108 => -- statement ::= forclause dotest DO scope doexit ENDLOOP
  BEGIN
  IF BoolV[top+3]
  THEN
  BEGIN
  t1 ← PopTree[]; t2 ← PopTree[];
  PushNode[block,2]; LinkToSource[top+2];
  PushTree[t2]; PushTree[t1];
  END;
  PushNode[do,6]; GO TO linkSource;
  END;
109 => -- statement ::= EXIT
  {PushNode[exit,0]; GO TO linkSource};
110 => -- statement ::= LOOP
  {PushNode[loop,0]; GO TO linkSource};
111 => -- statement ::= GOTO id
  {PushHashV[top+1]; PushNode[goto,1]; GO TO linkSource};
112 => -- statement ::= GO TO id
  {PushHashV[top+2]; PushNode[goto,1]; GO TO linkSource};
113 => -- statement ::= RETURN optargs
  {PushNode[return,1]; GO TO linkSource};
114 => -- statement ::= transfer lhs
  {PushNodeV[top,1]; GO TO linkSource};
115 => -- statement ::= free [ exp optcatch ]
  BEGIN
  IF BoolV[top+3]
  THEN {t1 ← PopTree[]; PushTree[Tree.Null]; PushTree[t1]; PushNode[free,4]}
  ELSE {PushTree[Tree.Null]; PushNode[free,3]};
  GO TO linkSource;
  END;
116 => -- statement ::= WAIT lhs
  {PushNode[wait,1]; GO TO linkSource};
117 => -- statement ::= ERROR
  {PushNode[syserror,0]; GO TO linkSource};
118 => -- statement ::= STOP
  {PushNode[stop,0]; GO TO linkSource};
119 => -- statement ::= NULL
  {PushNode[null,0]; GO TO linkSource};
120 => -- statement ::= RESUME optargs
  {PushNode[resume,1]; GO TO linkSource};
121 => -- statement ::= REJECT
  {PushNode[reject,0]; GO TO linkSource};
122 => -- statement ::= CONTINUE
  {PushNode[continue,0]; GO TO linkSource};
123 => -- statement ::= RETRY
  {PushNode[retry,0]; GO TO linkSource};
124 => -- statement ::= lhs ← STATE
  {PushNode[dst,1]; GO TO linkSource};
125 => -- block ::= BEGIN scope exits END
-- block ::= { scope exits }
  IF BoolV[top+2]
  THEN
  BEGIN
  IF BoolV[top+1]
  THEN {t1 ← PopTree[]; PushNode[block,2]; LinkToSource[top]; PushTree[t1]};
  SetBoolV[top,FALSE]; PushNode[label,2]; GO TO linkSource;
  END
  ELSE SetBoolV[top, BoolV[top+1]];
126 => -- scope ::= open enables declist statementlist
  BEGIN
  PushListV[top+3];
  IF IntV[top+2] = 0
  THEN SetBoolV[top,FALSE]
  ELSE {t1 ← PopTree[]; PushListV[top+2]; PushTree[t1]; SetBoolV[top,TRUE]};
  IF BoolV[top+1]
  THEN
  BEGIN
  IF BoolV[top] THEN {PushNode[block,2]; LinkToSource[top+2]};
  PushNode[enable,2]; LinkToSource[top+1]; SetBoolV[top,FALSE];
  END;
  END;
127 => -- binditem ::= exp
  {PushHash[HTNull]; PushNode[item,-2]; GO TO linkSource};
128 => -- binditem ::= id : exp
  {PushHashV[top]; PushNode[item,-2]; GO TO linkSource};
129 => -- exits ::= EXITS exitlist
  {PushListV[top+1]; SetBoolV[top,TRUE]};
130 => -- casestmtitem ::= caselabel => statement
  -- caseexpitem ::= caselabel => exp
  -- exititem ::= idlist => statement
  {PushNode[item,2]; GO TO linkSource};
131 => -- casetest ::= optrelation
  {PushTree[Tree.Null]; PushNodeV[top,-2]};
132 => -- casetest ::= exp
  {PushTree[Tree.Null]; PushNode[relE,-2]};
133 => -- caselabel ::= ident typeexp
  -- controlid ::= ident typeexp
  BEGIN
  PushTree[Tree.Null]; PushNode[decl,3];
  SetAttrs[FALSE,public,FALSE];
  GO TO linkSource;
  END;
134 => -- forclause ::= FOR controlid ← exp , exp
  PushNode[forseq,3];
135 => -- forclause ::= FOR controlid direction IN range
  {PushTree[Tree.Null]; PushNodeV[top+2,3]};
136 => -- forclause ::= THROUGH range
  {InsertTree[Tree.Null,2]; PushTree[Tree.Null]; PushNode[upthru,-3]};
137 => -- direction ::= DECREASING
  SetOpTop[downthru];
138 => -- direction ::=
  SetOpTop[upthru];
139 => -- dotest ::= UNTIL exp
  PushNode[not,1];
140 => -- doexit ::=
  {PushTree[Tree.Null]; PushTree[Tree.Null]};
141 => -- doexit ::= REPEAT exitlist
  {PushListV[top+1]; PushTree[Tree.Null]};
142 => -- doexit ::= REPEAT exitlist FINISHED => statement
  -- doexit ::= REPEAT exitlist FINISHED => statement ;
  {t1 ← PopTree[]; PushListV[top+1]; PushTree[t1]};
143 => -- enables ::= ENABLE catchcase ;
  {PushTree[Tree.Null]; PushNode[catch,2]; SetBoolV[top,TRUE]};
144 => -- enables ::= ENABLE catchany ;
  {PushTree[Tree.Null]; PushNode[catch,-2]; SetBoolV[top,TRUE]};
145 => -- enables ::= ENABLE BEGIN catchlist END ;
-- enables ::= ENABLE { catchlist } ;
  BEGIN
  t1 ← PopTree[];
  PushListV[top+2]; PushTree[t1]; PushNode[catch,2];
  SetBoolV[top,TRUE];
  END;
146 => -- catchlist ::= catchhead
  PushTree[Tree.Null];
147 => -- catchlist ::= catchhead catchcase
  {v[top].s ← v[top].s + 1; PushTree[Tree.Null]};
148 => -- catchcase ::= lhslist => statement
  BEGIN
  t1 ← PopTree[]; PushListV[top]; PushTree[t1];
  PushNode[item,2]; GO TO linkSource;
  END;
149 => -- optargs ::= [ explist ]
  BEGIN
  t1 ← PopTree[];
  IF t1 = Tree.Null THEN PushProperList[0] ELSE PushTree[t1];
  END;
150 => -- transfer ::= SIGNAL
  SetOpTop[signal];
151 => -- transfer ::= ERROR
  SetOpTop[error];
152 => -- transfer ::= RETURN WITH ERROR
  SetOpTop[xerror];
153 => -- transfer ::= START
  SetOpTop[start];
154 => -- transfer ::= RESTART
  SetOpTop[restart];
155 => -- transfer ::= JOIN
  SetOpTop[join];
156 => -- transfer ::= NOTIFY
  SetOpTop[notify];
157 => -- transfer ::= BROADCAST
  SetOpTop[broadcast];
158 => -- transfer ::= TRANSFER WITH
  SetOpTop[lst];
159 => -- transfer ::= RETURN WITH
  SetOpTop[lstf];

-- expression processing
160 => -- keyitem ::= id : optexp
  {PushHashV[top]; PushNode[item,-2]};
161 => -- optexp ::= NULL
-- initvalue ::= NULL
  PushNode[void,0];
162 => -- exp ::= transferop lhs
PushNodeV[top,1];
163 => -- exp ::= IF exp THEN exp ELSE exp
PushNode[ifx,3];
164 => -- exp ::= casehead caseexplist ENDCASE => exp
  BEGIN
  t1 ← PopTree[];
  PushProperListV[top+1]; PushTree[t1];
  IF BoolV[top] THEN PushNode[bindx,4] ELSE PushNode[casex,3];
  GO TO linkSource;
  END;
165 => -- exp ::= lhs ← exp
PushNode[assignx,2];
166 => -- exp ::= [ explist ] ← exp
  PushNode[extractx,2];
167 => -- exp ::= ERROR
PushNode[syserrorx,0];
168 => -- disjunct ::= disjunct OR conjunct
PushNode[or,2];
169 => -- conjunct ::= conjunct AND negation
PushNode[and,2];
170 => -- negation ::= not relation
PushNode[not,1];
171 => -- relation ::= sum optrelation
-- sum ::= sum addop product
-- product ::= product multop factor
PushNodeV[top+1,2];
172 => -- optrelation ::= not relationtail
SetOpTop[NegatedV[top+1]];
173 => -- relationtail ::= IN range
SetOpTop[in];
174 => -- relop ::= =
SetOpTop[relE];
175 => -- relop ::= #
SetOpTop[relN];
176 => -- relop ::= <
SetOpTop[relL];
177 => -- relop ::= <=
SetOpTop[relLE];
178 => -- relop ::= >
SetOpTop[relG];
179 => -- relop ::= >=
SetOpTop[relGE];
180 => -- addop ::= +
SetOpTop[plus];
181 => -- addop ::= -
SetOpTop[minus];
182 => -- multop ::= *
SetOpTop[times];
183 => -- multop ::= /
SetOpTop[div];
184 => -- multop ::= MOD
SetOpTop[mod];
185 => -- factor ::= - primary
PushNode[uminus,1];
186 => -- primary ::= num
  PushLitV[top];
187 => -- primary ::= lnum
  {PushLitV[top]; PushNode[mwconst,1]; SetAttr[1,FALSE]};
188 => -- primary ::= flnum
  {PushLitV[top]; PushNode[mwconst,1]; SetAttr[1,TRUE]};
189 => -- primary ::= char
  {PushLitV[top]; PushNode[clit,1]};
190 => -- primary ::= string
  PushStringLitV[top];
191 => -- primary ::= lstring
  {PushStringLitV[top]; PushNode[llit,1]};
192 => -- primary ::= atom
  {PushHashV[top]; PushNode[atom,1]};
193 => -- primary ::= NIL
  {PushTree[Tree.Null]; PushNode[nil,1]};
194 => -- primary  ::= [ explist ]
  {PushTree[Tree.Null]; PushNode[apply,-2]};
195 => -- primary ::= prefixop [ orderlist ]
  {PushListV[top+2]; PushNodeV[top,1]};
196 => -- primary ::= new [ typeexp initialization optcatch ]
{PushNode[new, IF BoolV[top+4] THEN 4 ELSE 3]; SetAttrV[1,top+3]};
197 => -- primary ::= cons [ explist optcatch ]
PushNode[cons, IF BoolV[top+3] THEN 3 ELSE 2];
198 => -- primary ::= listcons [ explist ]
PushNode[listcons,2];
199 => -- primary ::= typeop [ typeexp ]
PushNodeV[top,1];
200 => -- primary ::= SIZE [ typeexp ]
{PushTree[Tree.Null]; PushNode[size, 2]};
201 => -- primary ::= SIZE [ typeexp , exp ]
PushNode[size,2];
202 => -- primary ::= ISTYPE [ exp , typeexp optcatch ]
PushNode[istype, IF BoolV[top+5] THEN 3 ELSE 2];
203 => -- primary ::= @ lhs
  PushNode[addr,1];
204 => -- primary ::= DESCRIPTOR [ desclist ]
  PushNode[arraydesc,1];
205 => -- lhs ::= id
-- element ::= id
  -- ident ::= id :
-- controlid ::= id
  PushHashV[top];
206 => -- lhs ::= NARROW [ exp opttype optcatch ]
  PushNode[narrow, IF BoolV[top+4] THEN 3 ELSE 2];
207 => -- lhs ::= LOOPHOLE [ exp opttype ]
  PushNode[loophole,2];
208 => -- qualifier ::= [ explist optcatch ]
  PushNode[apply, IF BoolV[top+2] THEN 3 ELSE 2];
209 => -- qualifier ::= . id
  {PushHashV[top+1]; PushNode[dot,2]};
210 => -- qualifier ::= ^
  PushNode[uparrow,1];
211 => -- optcatch ::= ! catchlist
  BEGIN
  t1 ← PopTree[];
  PushListV[top+1]; PushTree[t1]; PushNode[catch,2];
  SetBoolV[top,TRUE];
  END;
212 => -- transferop ::= SIGNAL
  SetOpTop[signalx];
213 => -- transferop ::= ERROR
  SetOpTop[errorx];
214 => -- transferop ::= START
  SetOpTop[startx];
215 => -- transferop ::= JOIN
  SetOpTop[joinx];
216 => -- transferop ::= NEW
SetOpTop[create];
217 => -- transferop ::= FORK
  SetOpTop[fork];
218 => -- prefixop ::= LONG
SetOpTop[lengthen];
219 => -- prefixop ::= ABS
SetOpTop[abs];
220 => -- prefixop ::= PRED
SetOpTop[pred];
221 => -- prefixop ::= SUCC
SetOpTop[succ];
222 => -- prefixop ::= MIN
SetOpTop[min];
223 => -- prefixop ::= MAX
SetOpTop[max];
224 => -- prefixop ::= BASE
  SetOpTop[base];
225 => -- prefixop ::= LENGTH
  SetOpTop[length];
226 => -- prefixop ::= ALL
  SetOpTop[all];
227 => -- typeop ::= CODE
  SetOpTop[typecode];
228 => -- typeop ::= FIRST
  SetOpTop[first];
229 => -- typeop ::= LAST
  SetOpTop[last];
230 => -- typeop ::= NIL
  SetOpTop[nil];
231 => -- desclist ::= exp , exp opttype
  PushList[3];
232 => -- directory ::= DIRECTORY ;
  -- fieldlist ::= [ ]
  -- new ::= NEW
-- free ::= FREE
-- cons ::= CONS
-- listcons ::= LIST
-- pointerprefix ::= POINTER
  PushTree[Tree.Null];
233 => -- declist ::=
-- statementlist ::=
  -- casestmtlist ::=
-- exitlist ::=
  -- catchhead ::=
  -- caseexplist ::=
  v[top].s ← 0;
234 => -- includelist ::= includeitem
  -- modulelist ::= moduleitem
  -- pairlist ::= pairitem
  -- elementlist ::= element
  -- variantlist ::= variantitem
  -- bindlist ::= binditem
  -- statementlist' ::= statement
  -- casestmtlist' ::= casestmtitem
  -- caselabel' ::= casetest
  -- exitlist' ::= exititem
  -- lhslist ::= lhs
  -- orderlist ::= optexp
  -- keylist ::= keyitem
  -- caseexplist' ::= caseexpitem
  v[top].s ← 1;
235 => -- includelist ::= includelist , includeitem
  -- modulelist ::= modulelist , moduleitem
  -- declist ::= declist declaration ;
  -- pairlist ::= pairlist , pairitem
  -- elementlist ::= elementlist , element
  -- variantlist ::= variantlist , variantitem
  -- bindlist ::= bindlist , binditem
  -- statementlist' ::= statementlist' ; statement
  -- casestmtlist' ::= casestmtlist' ; casestmtitem
  -- caselabel' ::= caselabel' , casetest
  -- exitlist' ::= exitlist' ; exititem
  -- catchhead ::= catchhead catchcase ;
  -- lhslist ::= lhslist , lhs
  -- orderlist ::= orderlist , optexp
  -- keylist ::= keylist , keyitem
  -- caseexplist' ::= caseexplist' , caseexpitem
  v[top].s ← v[top].s+1;
236 => -- idlist ::= idlist'
  -- identlist ::= identlist'
  -- explist ::= orderlist
  -- explist ::= keylist
  -- caselabel ::= caselabel'
  PushListV[top];
237 => -- imports ::= IMPORTS modulelist
  -- exports ::= EXPORTS modulelist
-- open ::= OPEN bindlist ;
  -- fieldlist ::= [ pairlist ]
  -- fieldlist ::= [ typelist ]
  PushListV[top+1];
238 => -- initialization ::= ← initvalue
  -- casehead ::= SELECT exp FROM
  SetBoolV[top,FALSE];
239 => -- readonly ::= READONLY
  -- reclist ::= [ variantpair ]
  -- ordered ::= ORDERED
  -- base ::= BASE
  -- heap ::= UNCOUNTED
  -- packed  ::= PACKED
  -- initialization ::= = initvalue
  -- inline  ::= INLINE
  -- casehead ::= WITH binditem SELECT optexp FROM
  SetBoolV[top,TRUE];
240 => -- packed  ::=
  -- readonly ::=
  -- monitored ::=
  -- ordered ::=
  -- base ::=
  -- heap ::=
  -- inline  ::=
  -- enables ::=
  -- exits ::=
  -- optcatch ::=
  {SetBoolV[top,FALSE]; l[top] ← P1.InputLoc[]};
241 => -- using ::= USING [ idlist ]
  -- interface ::= imports exports shares
  -- shares ::= SHARES idlist
  -- typeexp ::= typeid
  -- typeexp ::= typecons
  -- length ::= [ exp ]
  -- default ::= ← defaultopt
  -- defaultopt ::= exp
  -- tagtype ::= typeexp
  -- pointerprefix ::= POINTER interval
  -- indextype ::= typeexp
  -- arguments ::= arglist returnlist
  -- arglist ::= fieldlist
  -- returnlist ::= RETURNS fieldlist
  -- initvalue ::= exp
  -- elsepart ::= ELSE statement
  -- otherpart ::= => statement
  -- dotest ::= WHILE exp
  -- catchany ::= ANY => statement
  -- catchlist ::= catchhead catchany
  -- catchlist ::= catchhead catchany ;
  -- statementlist ::= statementlist'
  -- statementlist ::= statementlist' ;
  -- casestmtlist ::= casestmtlist'
  -- casestmtlist ::= casestmtlist' ;
  -- exitlist ::= exitlist'
  -- exitlist ::= exitlist' ;
  -- caseexplist ::= caseexplist'
  -- caseexplist ::= caseexplist' ,
  -- optexp ::= exp
  -- exp ::= disjunct
  -- disjunct ::=C conjunct
  -- conjunct ::=C negation
  -- negation ::=C relation
  -- not ::= ~
  -- not ::= NOT
  -- relation ::= sum
  -- optrelation ::= relationtail
  -- relationtail ::= relop sum
  -- range ::= interval
  -- range ::= typeid
  -- bounds ::= exp .. exp
  -- sum ::=C product
  -- product ::=C factor
  -- factor ::=C primary
  -- primary ::= lhs
  -- desclist ::= exp
  -- lhs ::= ( exp )
  -- lhs ::= lhs qualifier
-- new ::= lhs . NEW
-- free ::= lhs . FREE
-- cons ::= lhs . CONS
-- listcons ::= lhs . LIST
-- opttype ::= , typeexp
  NULL;
242 => -- directory ::=
  -- using ::=
  -- locks ::=
  -- lambda ::=
  -- imports ::=
  -- exports ::=
  -- shares ::=
  -- optbits ::=
  -- default ::=
  -- open ::=
  -- arglist ::=
  -- returnlist ::=
  -- indextype ::=
  -- elsepart ::=
  -- otherpart ::=
  -- forclause ::=
  -- dotest ::=
  -- optargs ::=
  -- optexp ::=
  -- opttype ::=
  {PushTree[Tree.Null]; l[top] ← P1.InputLoc[]};

-- error or unimplemented
 ENDCASE => ERROR;

EXITS linkSource => LinkToSource[top]};

ENDLOOP;
END;

END.