m2comp step 6 — WITH + CASE statements (compare-chain lowering, 61/61 tests green)

docs/summary_m2comp_step6.md

@@ -0,0 +1,47 @@
+# m2comp step 6 — WITH + CASE (tag: `m2comp-step6`)
+
+Statement-level gap closed with v1 lowering recipes, ported to the
+tree-walking backend: `WITH` opens a record scope (bare fields,
+nesting, any record designator incl. `a[i]`), `CASE` lowers to
+compare-chains over int/char selectors (ranges, multi-labels,
+`ELSE`). Suite 61/61 (56 inherited + 2 run + 3 reject); new
+keywords `WITH`/`CASE`/`|` (token numbers shifted, `Msg`
+regenerated, no test depends on numbers).
+
+## What was built
+
+- `src/AST`: `nkWith` (record designator + stmts), `nkCase`
+  (selector + arm chain + else), `nkCaseArm` (label chain + body),
+  `nkRange` (`num` = lo, `op` = hi, both folded) + constructors
+  and `KindName` entries.
+- Grammar: `WithStat` (record check 215, `PushRecord`/`PopScope`
+  around the body), `CaseStat` (ordinal selector check 213,
+  `EqCheck` per label, `ConstFold` per bound with 230 on
+  non-constant, ranges via `..`), wired into `Stat`.
+- `src/SymTab`: `ConstFold` accepts `nkChar` (char labels and
+  char bounds; no other change needed — `PushRecord` and `EqCheck`
+  already existed for this).
+- `src/MGen`: WITH address-temp stack (`withTmps`/`withTyps`,
+  max 8, reset per module); `EmitWith` evaluates any record
+  designator once; bare WITH-fields (`aux = KindField`, no tag)
+  resolve in load/address paths via top-down search (stores flow
+  through the generic address path); `EmitCase` evaluates the
+  selector once and emits per-label `Eq` (ranges: `Ge`+`Le`+`And`)
+  `Jz`-chains into arm bodies.
+- `run_tests.sh`: `expect_fail` gained an optional `.LST`
+  message argument (existing single-arg calls unchanged).
+
+## Tests — 61/61
+
+`t_with` 51 (fields, nested WITH, `a[i]` argument);
+`t_case` 138 (multi-labels, `4..6` range, `ELSE`, char
+selector, fallthrough-free arms). Rejections: WITH on INTEGER
+(215), record selector (213), variable label (230).
+
+## Bugs found (all fixed, all covered)
+
+- None in the compiler: the three rejections "aborted" only
+  inside the suite because the new test lines passed bare
+  filenames to `expect_fail` (it takes `tests/`-prefixed paths),
+  so the driver `HALT`ed on "Could not open input file". Fixed
+  the lines; no compiler change.

run_tests.sh

@@ -11,12 +11,25 @@ expect_ok() {
   collect_mcd
 }
 expect_fail() {
+  # $1 = test file (with dir); $2 = optional message expected in .LST
   if ./M2comp "$1" 2>&1 | grep -q "Incorrect source"; then
-    pass=$((pass+1)); echo "PASS(fail): $1"
+    :
   else
     fail=$((fail+1)); echo "FAIL(fail, accepted): $1"
+    collect_mcd
+    return
   fi
   collect_mcd
+  if [ -z "$2" ]; then
+    pass=$((pass+1)); echo "PASS(fail): $1"
+    return
+  fi
+  lst=$(echo "$1" | sed 's/\.[^.]*$/.LST/')
+  if grep -q "$2" "$lst" 2>/dev/null; then
+    pass=$((pass+1)); echo "PASS(fail): $1 [$2]"
+  else
+    fail=$((fail+1)); echo "FAIL(fail): [$2] not found in $lst"
+  fi
 }
 expect_dump() {
   if ./M2comp "$1" 2>&1 | grep -q "$2"; then
@@ -182,6 +195,13 @@ expect_run r_ptr.mod 111
 expect_run r_module.mod 83
 expect_run r_const.mod 1102
 expect_run r_rcmp.mod 31
+echo "=== Step-6 run tests (WITH, CASE) ==="
+expect_run t_with.mod 51
+expect_run t_case.mod 138
+echo "=== Step-6 rejection tests ==="
+expect_fail tests/t_bad_with.mod "not a RECORD type"
+expect_fail tests/t_bad_case.mod "incompatible comparison"
+expect_fail tests/t_bad_caselbl.mod "not supported in this phase"
 echo "=== Step-5 run tests (DEFINITION/IMPLEMENTATION/IMPORT) ==="
 expect_run_files DBasic 60 tests/d_lib.def tests/d_lib.mod tests/d_basic.mod
 expect_run_files DFrom 35 tests/d_lib.def tests/d_lib.mod tests/d_lib2.def tests/d_lib2.mod tests/d_from.mod

src/AST.def

@@ -48,6 +48,10 @@ CONST
   nkIndex = 38;    (* left=array; right=index chain; typ *)
   nkDeref = 39;    (* left; typ *)
   nkCallExpr = 40; (* left=callee; right=actuals; num=pnum; typ=ret *)
+  nkWith = 41;     (* left=record designator; right=stmt chain *)
+  nkCase = 42;     (* left=selector; right=arm chain; extra=else-or-nil *)
+  nkCaseArm = 43;  (* left=label chain; right=body *)
+  nkRange = 44;    (* num=lo; op=hi (both folded) *)
   (* unary operator codes (binary ones reuse SymTab op codes) *)
   opNot = 1; opNeg = 2; opPos = 3;
 
@@ -101,6 +105,10 @@ PROCEDURE MkFor (nm: ARRAY OF CHAR; lo, hi, by,
                  body: Node): Node;
 PROCEDURE MkReturn (e: Node): Node;
 PROCEDURE MkExit (): Node;
+PROCEDURE MkWith (rec, body: Node): Node;
+PROCEDURE MkCase (sel, arms, els: Node): Node;
+PROCEDURE MkCaseArm (labels, body: Node): Node;
+PROCEDURE MkRange (lo, hi: INTEGER): Node;
 PROCEDURE MkBlock (decls, stmts: Node): Node;
 PROCEDURE MkModule (nm: ARRAY OF CHAR; decls,
                     body: Node): Node;

src/AST.mod

@@ -210,6 +210,35 @@ PROCEDURE MkExit (): Node;
     RETURN New(nkExit)
   END MkExit;
 
+PROCEDURE MkWith (rec, body: Node): Node;
+  VAR n: Node;
+  BEGIN
+    n := New(nkWith); n^.left := rec; n^.right := body;
+    RETURN n
+  END MkWith;
+
+PROCEDURE MkCase (sel, arms, els: Node): Node;
+  VAR n: Node;
+  BEGIN
+    n := New(nkCase); n^.left := sel; n^.right := arms;
+    n^.extra := els;
+    RETURN n
+  END MkCase;
+
+PROCEDURE MkCaseArm (labels, body: Node): Node;
+  VAR n: Node;
+  BEGIN
+    n := New(nkCaseArm); n^.left := labels; n^.right := body;
+    RETURN n
+  END MkCaseArm;
+
+PROCEDURE MkRange (lo, hi: INTEGER): Node;
+  VAR n: Node;
+  BEGIN
+    n := New(nkRange); n^.num := lo; n^.op := hi;
+    RETURN n
+  END MkRange;
+
 PROCEDURE MkBlock (decls, stmts: Node): Node;
   VAR n: Node;
   BEGIN
@@ -363,6 +392,10 @@ PROCEDURE KindName (k: INTEGER; VAR s: ARRAY OF CHAR);
     | nkIndex : Copy(s, "Index")
     | nkDeref : Copy(s, "Deref")
     | nkCallExpr : Copy(s, "CallExpr")
+    | nkWith : Copy(s, "With")
+    | nkCase : Copy(s, "Case")
+    | nkCaseArm : Copy(s, "CaseArm")
+    | nkRange : Copy(s, "Range")
     ELSE Copy(s, "?")
     END
   END KindName;

src/M2comp.atg

@@ -737,6 +737,8 @@ PRODUCTIONS
       | RepeatStat<s>
       | LoopStat<s>
       | ForStat<s>
+      | WithStat<s>
+      | CaseStat<s>
       | ReturnStat<s>
       | "EXIT"                        (. IF ~SymTab.InLoop() THEN
                                          SemError(230) END;
@@ -1020,6 +1022,75 @@ PRODUCTIONS
       StatSeq<bd>                     (. s := AST.MkFor(n, ln, hn, bn,
                                           bd); .)
       "END" .
+  WithStat<VAR s: AST.Node>           (. VAR dt: SymTab.TypeIndex;
+                                           dk, pn: INTEGER;
+                                           dn, bs: AST.Node;
+                                           pushed: BOOLEAN; .)
+    = "WITH"
+      Designator<dt, dk, pn, dn>      (. pushed := FALSE;
+                                         IF dt = SymTab.InvalidType THEN
+                                           (* cascade *)
+                                         ELSIF SymTab.ClassOf(dt) #
+                                            SymTab.ClRecord THEN
+                                           SemError(215)
+                                         ELSE
+                                           pushed :=
+                                             SymTab.PushRecord(dt);
+                                           IF ~pushed THEN
+                                             SemError(215) END
+                                         END; .)
+      "DO"
+      StatSeq<bs>
+      "END"                           (. IF pushed THEN
+                                           SymTab.PopScope END;
+                                         s := AST.MkWith(dn, bs); .) .
+  CaseStat<VAR s: AST.Node>           (. VAR st: SymTab.TypeIndex;
+                                           vD: BOOLEAN;
+                                           se, arms, arm, el: AST.Node; .)
+    =                                 (. arms := NIL; el := NIL; .)
+      "CASE"
+      Expr<st, vD, se>                (. IF (st # SymTab.InvalidType)
+                                          & ~SymTab.IsIntFamily(st)
+                                          & (SymTab.ClassOf(st) #
+                                             SymTab.ClChar) THEN
+                                          SemError(213) END; .)
+      "OF"
+      [ CaseArm<st, arm>              (. arms := arm; .)
+        { "|" CaseArm<st, arm>        (. arms := AST.Append(arms,
+                                           arm); .) } ]
+      [ "ELSE"
+        StatSeq<el> ]
+      "END"                           (. s := AST.MkCase(se, arms,
+                                           el); .) .
+  CaseArm<st: SymTab.TypeIndex; VAR n: AST.Node>
+                                      (. VAR lh, lab, bs: AST.Node; .)
+    = CaseLabel<st, lab>              (. lh := lab; .)
+      { "," CaseLabel<st, lab>        (. lh := AST.Append(lh, lab); .) }
+      ":" StatSeq<bs>                 (. n := AST.MkCaseArm(lh, bs); .) .
+  CaseLabel<st: SymTab.TypeIndex; VAR n: AST.Node>
+                                      (. VAR t, t2: SymTab.TypeIndex;
+                                           vD, vD2: BOOLEAN;
+                                           en, en2: AST.Node;
+                                           lo, hi: INTEGER; .)
+    = ConstExpr<t, en>                (. n := NIL;
+                                         IF t = SymTab.InvalidType THEN
+                                           (* cascade *)
+                                         ELSIF ~SymTab.EqCheck(t,
+                                            st) THEN SemError(213)
+                                         ELSIF ~SymTab.ConstFold(en,
+                                            lo) THEN SemError(230)
+                                         ELSE n := AST.MkInt(lo, t)
+                                         END; .)
+      [ ".."
+        ConstExpr<t2, en2>            (. IF (t2 #
+                                           SymTab.InvalidType)
+                                          & ~SymTab.EqCheck(t2,
+                                             st) THEN SemError(213)
+                                         ELSIF ~SymTab.ConstFold(en2,
+                                            hi) THEN SemError(230)
+                                         ELSE n := AST.MkRange(lo,
+                                           hi)
+                                         END; .) ] .
   ReturnStat<VAR s: AST.Node>         (. VAR et: SymTab.TypeIndex;
                                            ev, hasE: BOOLEAN;
                                            en, e0: AST.Node; .)

src/M2comp.err

@@ -46,34 +46,37 @@
 | 45: Msg("'LOOP' expected")
 | 46: Msg("'FOR' expected")
 | 47: Msg("'BY' expected")
-| 48: Msg("'RETURN' expected")
-| 49: Msg("'#' expected")
-| 50: Msg("'<>' expected")
-| 51: Msg("'<' expected")
-| 52: Msg("'<=' expected")
-| 53: Msg("'>' expected")
-| 54: Msg("'>=' expected")
-| 55: Msg("'IN' expected")
-| 56: Msg("'+' expected")
-| 57: Msg("'-' expected")
-| 58: Msg("'OR' expected")
-| 59: Msg("'*' expected")
-| 60: Msg("'/' expected")
-| 61: Msg("'DIV' expected")
-| 62: Msg("'MOD' expected")
-| 63: Msg("'AND' expected")
-| 64: Msg("'NOT' expected")
-| 65: Msg("not expected")
-| 66: Msg("invalid MulOp")
-| 67: Msg("invalid AddOp")
-| 68: Msg("invalid Fact")
-| 69: Msg("invalid Relation")
-| 70: Msg("invalid SimExpr")
-| 71: Msg("invalid AssignOrCall")
-| 72: Msg("invalid IndexType")
-| 73: Msg("invalid BoundedBase")
-| 74: Msg("invalid Type")
-| 75: Msg("invalid Declaration")
-| 76: Msg("invalid ImplDecl")
-| 77: Msg("invalid DefDecl")
-| 78: Msg("invalid Unit")
+| 48: Msg("'WITH' expected")
+| 49: Msg("'CASE' expected")
+| 50: Msg("'|' expected")
+| 51: Msg("'RETURN' expected")
+| 52: Msg("'#' expected")
+| 53: Msg("'<>' expected")
+| 54: Msg("'<' expected")
+| 55: Msg("'<=' expected")
+| 56: Msg("'>' expected")
+| 57: Msg("'>=' expected")
+| 58: Msg("'IN' expected")
+| 59: Msg("'+' expected")
+| 60: Msg("'-' expected")
+| 61: Msg("'OR' expected")
+| 62: Msg("'*' expected")
+| 63: Msg("'/' expected")
+| 64: Msg("'DIV' expected")
+| 65: Msg("'MOD' expected")
+| 66: Msg("'AND' expected")
+| 67: Msg("'NOT' expected")
+| 68: Msg("not expected")
+| 69: Msg("invalid MulOp")
+| 70: Msg("invalid AddOp")
+| 71: Msg("invalid Fact")
+| 72: Msg("invalid Relation")
+| 73: Msg("invalid SimExpr")
+| 74: Msg("invalid AssignOrCall")
+| 75: Msg("invalid IndexType")
+| 76: Msg("invalid BoundedBase")
+| 77: Msg("invalid Type")
+| 78: Msg("invalid Declaration")
+| 79: Msg("invalid ImplDecl")
+| 80: Msg("invalid DefDecl")
+| 81: Msg("invalid Unit")

src/M2comp.lst

@@ -17,11 +17,11 @@ LL(1) conditions:         --  ok  --
 
 Statistics:
 
-  nr of terminals:        66 (limit   400)
-  nr of non-terminals:    52 (limit   210)
-  nr of pragmas:           0 (limit   434)
-  nr of symbolnodes:     118 (limit   500)
-  nr of graphnodes:      590 (limit  1500)
+  nr of terminals:        69 (limit   400)
+  nr of non-terminals:    56 (limit   210)
+  nr of pragmas:           0 (limit   431)
+  nr of symbolnodes:     125 (limit   500)
+  nr of graphnodes:      633 (limit  1500)
   nr of conditionsets:     6 (limit   100)
   nr of charactersets:     9 (limit   250)
 

src/M2comp.mod

@@ -144,37 +144,40 @@ MODULE M2comp;
         | 45: Msg("'LOOP' expected")
         | 46: Msg("'FOR' expected")
         | 47: Msg("'BY' expected")
-        | 48: Msg("'RETURN' expected")
-        | 49: Msg("'#' expected")
-        | 50: Msg("'<>' expected")
-        | 51: Msg("'<' expected")
-        | 52: Msg("'<=' expected")
-        | 53: Msg("'>' expected")
-        | 54: Msg("'>=' expected")
-        | 55: Msg("'IN' expected")
-        | 56: Msg("'+' expected")
-        | 57: Msg("'-' expected")
-        | 58: Msg("'OR' expected")
-        | 59: Msg("'*' expected")
-        | 60: Msg("'/' expected")
-        | 61: Msg("'DIV' expected")
-        | 62: Msg("'MOD' expected")
-        | 63: Msg("'AND' expected")
-        | 64: Msg("'NOT' expected")
-        | 65: Msg("not expected")
-        | 66: Msg("invalid MulOp")
-        | 67: Msg("invalid AddOp")
-        | 68: Msg("invalid Fact")
-        | 69: Msg("invalid Relation")
-        | 70: Msg("invalid SimExpr")
-        | 71: Msg("invalid AssignOrCall")
-        | 72: Msg("invalid IndexType")
-        | 73: Msg("invalid BoundedBase")
-        | 74: Msg("invalid Type")
-        | 75: Msg("invalid Declaration")
-        | 76: Msg("invalid ImplDecl")
-        | 77: Msg("invalid DefDecl")
-        | 78: Msg("invalid Unit")
+        | 48: Msg("'WITH' expected")
+        | 49: Msg("'CASE' expected")
+        | 50: Msg("'|' expected")
+        | 51: Msg("'RETURN' expected")
+        | 52: Msg("'#' expected")
+        | 53: Msg("'<>' expected")
+        | 54: Msg("'<' expected")
+        | 55: Msg("'<=' expected")
+        | 56: Msg("'>' expected")
+        | 57: Msg("'>=' expected")
+        | 58: Msg("'IN' expected")
+        | 59: Msg("'+' expected")
+        | 60: Msg("'-' expected")
+        | 61: Msg("'OR' expected")
+        | 62: Msg("'*' expected")
+        | 63: Msg("'/' expected")
+        | 64: Msg("'DIV' expected")
+        | 65: Msg("'MOD' expected")
+        | 66: Msg("'AND' expected")
+        | 67: Msg("'NOT' expected")
+        | 68: Msg("not expected")
+        | 69: Msg("invalid MulOp")
+        | 70: Msg("invalid AddOp")
+        | 71: Msg("invalid Fact")
+        | 72: Msg("invalid Relation")
+        | 73: Msg("invalid SimExpr")
+        | 74: Msg("invalid AssignOrCall")
+        | 75: Msg("invalid IndexType")
+        | 76: Msg("invalid BoundedBase")
+        | 77: Msg("invalid Type")
+        | 78: Msg("invalid Declaration")
+        | 79: Msg("invalid ImplDecl")
+        | 80: Msg("invalid DefDecl")
+        | 81: Msg("invalid Unit")
         
         (* add customized cases here *)
         | 200: Msg("duplicate identifier")

src/M2compP.mod

@@ -9,7 +9,7 @@ IMPORT SymTab, AST;
 
 
 CONST 
-  maxT = 65;
+  maxT = 68;
   minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
   setsize     = 16;  (* sets are stored in 16 bits *)
 
@@ -123,10 +123,14 @@ PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
 PROCEDURE Relation (VAR op: INTEGER); FORWARD;
 PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
                     VAR e: AST.Node); FORWARD;
+PROCEDURE CaseLabel (st: SymTab.TypeIndex; VAR n: AST.Node); FORWARD;
+PROCEDURE CaseArm (st: SymTab.TypeIndex; VAR n: AST.Node); FORWARD;
 PROCEDURE ActParams (VAR h: AST.Node; VAR n: CARDINAL); FORWARD;
 PROCEDURE Designator (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                        VAR pn: INTEGER; VAR dn: AST.Node); FORWARD;
 PROCEDURE ReturnStat (VAR s: AST.Node); FORWARD;
+PROCEDURE CaseStat (VAR s: AST.Node); FORWARD;
+PROCEDURE WithStat (VAR s: AST.Node); FORWARD;
 PROCEDURE ForStat (VAR s: AST.Node); FORWARD;
 PROCEDURE LoopStat (VAR s: AST.Node); FORWARD;
 PROCEDURE RepeatStat (VAR s: AST.Node); FORWARD;
@@ -178,37 +182,37 @@ PROCEDURE M2comp; FORWARD;
 
 PROCEDURE MulOp (VAR op: INTEGER);
   BEGIN
-    IF (sym = 59) THEN
+    IF (sym = 62) THEN
       Get;
       op := SymTab.OpTimes;;
-    ELSIF (sym = 60) THEN
+    ELSIF (sym = 63) THEN
       Get;
       op := SymTab.OpSlash;;
-    ELSIF (sym = 61) THEN
+    ELSIF (sym = 64) THEN
       Get;
       op := SymTab.OpDiv;;
-    ELSIF (sym = 62) THEN
+    ELSIF (sym = 65) THEN
       Get;
       op := SymTab.OpMod;;
-    ELSIF (sym = 63) THEN
+    ELSIF (sym = 66) THEN
       Get;
       op := SymTab.OpAnd;;
-    ELSE SynError(66);
+    ELSE SynError(69);
     END;
   END MulOp;
 
 PROCEDURE AddOp (VAR op: INTEGER);
   BEGIN
-    IF (sym = 56) THEN
+    IF (sym = 59) THEN
       Get;
       op := SymTab.OpAdd;;
-    ELSIF (sym = 57) THEN
+    ELSIF (sym = 60) THEN
       Get;
       op := SymTab.OpSub;;
-    ELSIF (sym = 58) THEN
+    ELSIF (sym = 61) THEN
       Get;
       op := SymTab.OpOr;;
-    ELSE SynError(67);
+    ELSE SynError(70);
     END;
   END AddOp;
 
@@ -314,7 +318,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
         Expect(22);
         t := et; v := FALSE;
         e := en;;
-    | 64 :
+    | 67 :
         Get;
         Fact(t2, v2, en);
         IF SymTab.BoolCheck(t2) THEN
@@ -324,7 +328,7 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
         v := FALSE;
         e := AST.MkUn(AST.opNot, en,
          t);;
-    ELSE SynError(68);
+    ELSE SynError(71);
     END;
   END Fact;
 
@@ -336,7 +340,7 @@ PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
     e2: AST.Node;
   BEGIN
     Fact(t, v, e);
-    WHILE (sym = 59) OR (sym = 60) OR (sym = 61) OR (sym = 62) OR (sym = 63) DO
+    WHILE (sym = 62) OR (sym = 63) OR (sym = 64) OR (sym = 65) OR (sym = 66) DO
       MulOp(op);
       Fact(t2, v2, e2);
       v := FALSE;
@@ -360,28 +364,28 @@ PROCEDURE Relation (VAR op: INTEGER);
       20 :
         Get;
         op := SymTab.OpEq;;
-    | 49 :
+    | 52 :
         Get;
         op := SymTab.OpNeq1;;
-    | 50 :
+    | 53 :
         Get;
         op := SymTab.OpNeq2;;
-    | 51 :
+    | 54 :
         Get;
         op := SymTab.OpLt;;
-    | 52 :
+    | 55 :
         Get;
         op := SymTab.OpLe;;
-    | 53 :
+    | 56 :
         Get;
         op := SymTab.OpGt;;
-    | 54 :
+    | 57 :
         Get;
         op := SymTab.OpGe;;
-    | 55 :
+    | 58 :
         Get;
         op := SymTab.OpIn;;
-    ELSE SynError(69);
+    ELSE SynError(72);
     END;
   END Relation;
 
@@ -392,7 +396,7 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
     op: INTEGER;
     e2: AST.Node;
   BEGIN
-    IF (sym = 56) THEN
+    IF (sym = 59) THEN
       Get;
       Term(t, v, e);
       IF ~SymTab.UnaryCheck(t,
@@ -403,7 +407,7 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
       v := FALSE;
       e := AST.MkUn(AST.opPos,
        e, t);;
-    ELSIF (sym = 57) THEN
+    ELSIF (sym = 60) THEN
       Get;
       Fact(t, v, e);
       IF ~SymTab.UnaryCheck(t,
@@ -416,9 +420,9 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
        e, t);;
     ELSIF In(symSet[1], sym) THEN
       Term(t, v, e);
-    ELSE SynError(70);
+    ELSE SynError(73);
     END;
-    WHILE (sym = 56) OR (sym = 57) OR (sym = 58) DO
+    WHILE (sym = 59) OR (sym = 60) OR (sym = 61) DO
       AddOp(op);
       Term(t2, v2, e2);
       v := FALSE;
@@ -435,6 +439,52 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR v: BOOLEAN;
     END;
   END SimExpr;
 
+PROCEDURE CaseLabel (st: SymTab.TypeIndex; VAR n: AST.Node);
+  VAR t, t2: SymTab.TypeIndex;
+    vD, vD2: BOOLEAN;
+    en, en2: AST.Node;
+    lo, hi: INTEGER;
+  BEGIN
+    ConstExpr(t, en);
+    n := NIL;
+    IF t = SymTab.InvalidType THEN
+      (* cascade *)
+    ELSIF ~SymTab.EqCheck(t,
+       st) THEN SemError(213)
+    ELSIF ~SymTab.ConstFold(en,
+       lo) THEN SemError(230)
+    ELSE n := AST.MkInt(lo, t)
+    END;;
+    IF (sym = 33) THEN
+      Get;
+      ConstExpr(t2, en2);
+      IF (t2 #
+        SymTab.InvalidType)
+       & ~SymTab.EqCheck(t2,
+          st) THEN SemError(213)
+      ELSIF ~SymTab.ConstFold(en2,
+         hi) THEN SemError(230)
+      ELSE n := AST.MkRange(lo,
+        hi)
+      END;;
+    END;
+  END CaseLabel;
+
+PROCEDURE CaseArm (st: SymTab.TypeIndex; VAR n: AST.Node);
+  VAR lh, lab, bs: AST.Node;
+  BEGIN
+    CaseLabel(st, lab);
+    lh := lab;;
+    WHILE (sym = 19) DO
+      Get;
+      CaseLabel(st, lab);
+      lh := AST.Append(lh, lab);;
+    END;
+    Expect(15);
+    StatSeq(bs);
+    n := AST.MkCaseArm(lh, bs);;
+  END CaseArm;
+
 PROCEDURE ActParams (VAR h: AST.Node; VAR n: CARDINAL);
   VAR at: SymTab.TypeIndex;
     av: BOOLEAN;
@@ -632,7 +682,7 @@ PROCEDURE ReturnStat (VAR s: AST.Node);
     en, e0: AST.Node;
   BEGIN
     hasE := FALSE; e0 := NIL;;
-    Expect(48);
+    Expect(51);
     IF In(symSet[2], sym) THEN
       Expr(et, ev, en);
       hasE := TRUE; e0 := en;;
@@ -644,6 +694,67 @@ PROCEDURE ReturnStat (VAR s: AST.Node);
     s := AST.MkReturn(e0);;
   END ReturnStat;
 
+PROCEDURE CaseStat (VAR s: AST.Node);
+  VAR st: SymTab.TypeIndex;
+    vD: BOOLEAN;
+    se, arms, arm, el: AST.Node;
+  BEGIN
+    arms := NIL; el := NIL;;
+    Expect(49);
+    Expr(st, vD, se);
+    IF (st # SymTab.InvalidType)
+     & ~SymTab.IsIntFamily(st)
+     & (SymTab.ClassOf(st) #
+        SymTab.ClChar) THEN
+     SemError(213) END;;
+    Expect(28);
+    IF In(symSet[2], sym) THEN
+      CaseArm(st, arm);
+      arms := arm;;
+      WHILE (sym = 50) DO
+        Get;
+        CaseArm(st, arm);
+        arms := AST.Append(arms,
+          arm);;
+      END;
+    END;
+    IF (sym = 40) THEN
+      Get;
+      StatSeq(el);
+    END;
+    Expect(10);
+    s := AST.MkCase(se, arms,
+      el);;
+  END CaseStat;
+
+PROCEDURE WithStat (VAR s: AST.Node);
+  VAR dt: SymTab.TypeIndex;
+    dk, pn: INTEGER;
+    dn, bs: AST.Node;
+    pushed: BOOLEAN;
+  BEGIN
+    Expect(48);
+    Designator(dt, dk, pn, dn);
+    pushed := FALSE;
+    IF dt = SymTab.InvalidType THEN
+      (* cascade *)
+    ELSIF SymTab.ClassOf(dt) #
+       SymTab.ClRecord THEN
+      SemError(215)
+    ELSE
+      pushed :=
+        SymTab.PushRecord(dt);
+      IF ~pushed THEN
+        SemError(215) END
+    END;;
+    Expect(42);
+    StatSeq(bs);
+    Expect(10);
+    IF pushed THEN
+      SymTab.PopScope END;
+    s := AST.MkWith(dn, bs);;
+  END WithStat;
+
 PROCEDURE ForStat (VAR s: AST.Node);
   VAR n: SymTab.Name;
     lo, hi, by: SymTab.TypeIndex;
@@ -812,7 +923,7 @@ PROCEDURE AssignOrCall (VAR s: AST.Node);
       IF ~SymTab.CallEndNum(nn) THEN
         SemError(233) END;
       s := AST.MkCall(dn, ah, pn);;
-    ELSE SynError(71);
+    ELSE SynError(74);
     END;
   END AssignOrCall;
 
@@ -834,6 +945,10 @@ PROCEDURE Stat (VAR s: AST.Node);
       | 46 :
           ForStat(s);
       | 48 :
+          WithStat(s);
+      | 49 :
+          CaseStat(s);
+      | 51 :
           ReturnStat(s);
       | 34 :
           Get;
@@ -969,7 +1084,7 @@ PROCEDURE IndexType (VAR t: SymTab.TypeIndex; VAR lo, hi: INTEGER;
        t := SymTab.NewSub(t1)
       END;;
       Expect(24);
-    ELSE SynError(72);
+    ELSE SynError(75);
     END;
   END IndexType;
 
@@ -1085,7 +1200,7 @@ PROCEDURE BoundedBase (VAR t: SymTab.TypeIndex);
        t := SymTab.NewSub(t1)
       END;;
       Expect(24);
-    ELSE SynError(73);
+    ELSE SynError(76);
     END;
   END BoundedBase;
 
@@ -1241,7 +1356,7 @@ PROCEDURE Type (VAR t: SymTab.TypeIndex);
       Expect(32);
       Type(e);
       t := SymTab.NewPtr(e);;
-    ELSE SynError(74);
+    ELSE SynError(77);
     END;
   END Type;
 
@@ -1385,7 +1500,7 @@ PROCEDURE Declaration (VAR n: AST.Node);
     ELSIF (sym = 8) THEN
       ModuleDecl(n);
       Expect(9);
-    ELSE SynError(75);
+    ELSE SynError(78);
     END;
   END Declaration;
 
@@ -1546,7 +1661,7 @@ PROCEDURE ImplDecl (VAR n: AST.Node);
       ImplProcBody(cn);
       Expect(9);
       n := cn;;
-    ELSE SynError(76);
+    ELSE SynError(79);
     END;
   END ImplDecl;
 
@@ -1742,7 +1857,7 @@ PROCEDURE DefDecl (VAR n: AST.Node);
       ProcHeading;
       Expect(9);
       n := NIL;;
-    ELSE SynError(77);
+    ELSE SynError(80);
     END;
   END DefDecl;
 
@@ -1905,7 +2020,7 @@ PROCEDURE Unit;
       ImplUnit;
     ELSIF (sym = 8) THEN
       Module;
-    ELSE SynError(78);
+    ELSE SynError(81);
     END;
   END Unit;
 
@@ -1935,26 +2050,26 @@ BEGIN
   symSet[ 1, 1] := BITSET{5};
   symSet[ 1, 2] := BITSET{};
   symSet[ 1, 3] := BITSET{};
-  symSet[ 1, 4] := BITSET{0};
+  symSet[ 1, 4] := BITSET{3};
   symSet[ 2, 0] := BITSET{1, 2, 3, 4};
   symSet[ 2, 1] := BITSET{5};
   symSet[ 2, 2] := BITSET{};
-  symSet[ 2, 3] := BITSET{8, 9};
-  symSet[ 2, 4] := BITSET{0};
+  symSet[ 2, 3] := BITSET{11, 12};
+  symSet[ 2, 4] := BITSET{3};
   symSet[ 3, 0] := BITSET{9, 10};
   symSet[ 3, 1] := BITSET{5};
   symSet[ 3, 2] := BITSET{7, 8, 12};
-  symSet[ 3, 3] := BITSET{};
+  symSet[ 3, 3] := BITSET{2};
   symSet[ 3, 4] := BITSET{};
   symSet[ 4, 0] := BITSET{1};
   symSet[ 4, 1] := BITSET{};
   symSet[ 4, 2] := BITSET{2, 5, 9, 11, 13, 14};
-  symSet[ 4, 3] := BITSET{0};
+  symSet[ 4, 3] := BITSET{0, 1, 3};
   symSet[ 4, 4] := BITSET{};
   symSet[ 5, 0] := BITSET{};
   symSet[ 5, 1] := BITSET{4};
   symSet[ 5, 2] := BITSET{};
-  symSet[ 5, 3] := BITSET{1, 2, 3, 4, 5, 6, 7};
+  symSet[ 5, 3] := BITSET{4, 5, 6, 7, 8, 9, 10};
   symSet[ 5, 4] := BITSET{};
 END M2compP.
 

src/M2compS.mod

@@ -5,7 +5,7 @@ IMPLEMENTATION MODULE M2compS;
 IMPORT FileIO, Storage;
 
 CONST
-  noSYMB  = 65; (*error token code*)
+  noSYMB  = 68; (*error token code*)
   (* not only for errors but also for not finished states of scanner analysis *)
   eof     = 32C (* MS-DOS Keyboard eof char *);
   EOF     = 0C;
@@ -102,16 +102,17 @@ PROCEDURE Get (VAR sym: CARDINAL);
   PROCEDURE CheckLiteral;
     BEGIN
       CASE CurrentCh(bp0) OF
-        "A": IF Equal("AND") THEN sym := 63; 
+        "A": IF Equal("AND") THEN sym := 66; 
              ELSIF Equal("ARRAY") THEN sym := 27; 
              END
       | "B": IF Equal("BEGIN") THEN sym := 16; 
              ELSIF Equal("BY") THEN sym := 47; 
              END
-      | "C": IF Equal("CONST") THEN sym := 11; 
+      | "C": IF Equal("CASE") THEN sym := 49; 
+             ELSIF Equal("CONST") THEN sym := 11; 
              END
       | "D": IF Equal("DEFINITION") THEN sym := 6; 
-             ELSIF Equal("DIV") THEN sym := 61; 
+             ELSIF Equal("DIV") THEN sym := 64; 
              ELSIF Equal("DO") THEN sym := 42; 
              END
       | "E": IF Equal("ELSE") THEN sym := 40; 
@@ -126,17 +127,17 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | "I": IF Equal("IF") THEN sym := 37; 
              ELSIF Equal("IMPLEMENTATION") THEN sym := 7; 
              ELSIF Equal("IMPORT") THEN sym := 18; 
-             ELSIF Equal("IN") THEN sym := 55; 
+             ELSIF Equal("IN") THEN sym := 58; 
              END
       | "L": IF Equal("LOOP") THEN sym := 45; 
              END
-      | "M": IF Equal("MOD") THEN sym := 62; 
+      | "M": IF Equal("MOD") THEN sym := 65; 
              ELSIF Equal("MODULE") THEN sym := 8; 
              END
-      | "N": IF Equal("NOT") THEN sym := 64; 
+      | "N": IF Equal("NOT") THEN sym := 67; 
              END
       | "O": IF Equal("OF") THEN sym := 28; 
-             ELSIF Equal("OR") THEN sym := 58; 
+             ELSIF Equal("OR") THEN sym := 61; 
              END
       | "P": IF Equal("POINTER") THEN sym := 31; 
              ELSIF Equal("PROCEDURE") THEN sym := 14; 
@@ -145,7 +146,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
              END
       | "R": IF Equal("RECORD") THEN sym := 29; 
              ELSIF Equal("REPEAT") THEN sym := 43; 
-             ELSIF Equal("RETURN") THEN sym := 48; 
+             ELSIF Equal("RETURN") THEN sym := 51; 
              END
       | "S": IF Equal("SET") THEN sym := 30; 
              END
@@ -158,6 +159,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | "V": IF Equal("VAR") THEN sym := 13; 
              END
       | "W": IF Equal("WHILE") THEN sym := 41; 
+             ELSIF Equal("WITH") THEN sym := 48; 
              END
       ELSE
       END
@@ -242,22 +244,23 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | 23: sym := 33; RETURN
       | 24: sym := 35; RETURN
       | 25: sym := 36; RETURN
-      | 26: sym := 49; RETURN
-      | 27: IF (ch = ">") THEN state := 28; 
-            ELSIF (ch = "=") THEN state := 29; 
-            ELSE sym := 51; RETURN
+      | 26: sym := 50; RETURN
+      | 27: sym := 52; RETURN
+      | 28: IF (ch = ">") THEN state := 29; 
+            ELSIF (ch = "=") THEN state := 30; 
+            ELSE sym := 54; RETURN
             END;
-      | 28: sym := 50; RETURN
-      | 29: sym := 52; RETURN
-      | 30: IF (ch = "=") THEN state := 31; 
-            ELSE sym := 53; RETURN
+      | 29: sym := 53; RETURN
+      | 30: sym := 55; RETURN
+      | 31: IF (ch = "=") THEN state := 32; 
+            ELSE sym := 56; RETURN
             END;
-      | 31: sym := 54; RETURN
-      | 32: sym := 56; RETURN
-      | 33: sym := 57; RETURN
-      | 34: sym := 59; RETURN
-      | 35: sym := 60; RETURN
-      | 36: sym := 0; ch := 0C; DEC(bp); RETURN
+      | 32: sym := 57; RETURN
+      | 33: sym := 59; RETURN
+      | 34: sym := 60; RETURN
+      | 35: sym := 62; RETURN
+      | 36: sym := 63; RETURN
+      | 37: sym := 0; ch := 0C; DEC(bp); RETURN
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       END
     END
@@ -325,69 +328,69 @@ PROCEDURE Reset;
 
 BEGIN
   CurrentCh := CharAt;
-  start[  0] := 36; start[  1] := 37; start[  2] := 37; start[  3] := 37; 
-  start[  4] := 37; start[  5] := 37; start[  6] := 37; start[  7] := 37; 
-  start[  8] := 37; start[  9] := 37; start[ 10] := 37; start[ 11] := 37; 
-  start[ 12] := 37; start[ 13] := 37; start[ 14] := 37; start[ 15] := 37; 
-  start[ 16] := 37; start[ 17] := 37; start[ 18] := 37; start[ 19] := 37; 
-  start[ 20] := 37; start[ 21] := 37; start[ 22] := 37; start[ 23] := 37; 
-  start[ 24] := 37; start[ 25] := 37; start[ 26] := 37; start[ 27] := 37; 
-  start[ 28] := 37; start[ 29] := 37; start[ 30] := 37; start[ 31] := 37; 
-  start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
-  start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
-  start[ 40] := 19; start[ 41] := 20; start[ 42] := 34; start[ 43] := 32; 
-  start[ 44] := 17; start[ 45] := 33; start[ 46] := 14; start[ 47] := 35; 
+  start[  0] := 37; start[  1] := 38; start[  2] := 38; start[  3] := 38; 
+  start[  4] := 38; start[  5] := 38; start[  6] := 38; start[  7] := 38; 
+  start[  8] := 38; start[  9] := 38; start[ 10] := 38; start[ 11] := 38; 
+  start[ 12] := 38; start[ 13] := 38; start[ 14] := 38; start[ 15] := 38; 
+  start[ 16] := 38; start[ 17] := 38; start[ 18] := 38; start[ 19] := 38; 
+  start[ 20] := 38; start[ 21] := 38; start[ 22] := 38; start[ 23] := 38; 
+  start[ 24] := 38; start[ 25] := 38; start[ 26] := 38; start[ 27] := 38; 
+  start[ 28] := 38; start[ 29] := 38; start[ 30] := 38; start[ 31] := 38; 
+  start[ 32] := 38; start[ 33] := 38; start[ 34] := 10; start[ 35] := 27; 
+  start[ 36] := 38; start[ 37] := 38; start[ 38] := 38; start[ 39] :=  9; 
+  start[ 40] := 19; start[ 41] := 20; start[ 42] := 35; start[ 43] := 33; 
+  start[ 44] := 17; start[ 45] := 34; start[ 46] := 14; start[ 47] := 36; 
   start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
   start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
   start[ 56] := 12; start[ 57] := 12; start[ 58] := 16; start[ 59] := 15; 
-  start[ 60] := 27; start[ 61] := 18; start[ 62] := 30; start[ 63] := 37; 
-  start[ 64] := 37; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
+  start[ 60] := 28; start[ 61] := 18; start[ 62] := 31; start[ 63] := 38; 
+  start[ 64] := 38; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
   start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
   start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 
   start[ 76] :=  1; start[ 77] :=  1; start[ 78] :=  1; start[ 79] :=  1; 
   start[ 80] :=  1; start[ 81] :=  1; start[ 82] :=  1; start[ 83] :=  1; 
   start[ 84] :=  1; start[ 85] :=  1; start[ 86] :=  1; start[ 87] :=  1; 
   start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] := 21; 
-  start[ 92] := 37; start[ 93] := 22; start[ 94] := 25; start[ 95] := 37; 
-  start[ 96] := 37; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
+  start[ 92] := 38; start[ 93] := 22; start[ 94] := 25; start[ 95] := 38; 
+  start[ 96] := 38; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
   start[100] :=  1; start[101] :=  1; start[102] :=  1; start[103] :=  1; 
   start[104] :=  1; start[105] :=  1; start[106] :=  1; start[107] :=  1; 
   start[108] :=  1; start[109] :=  1; start[110] :=  1; start[111] :=  1; 
   start[112] :=  1; start[113] :=  1; start[114] :=  1; start[115] :=  1; 
   start[116] :=  1; start[117] :=  1; start[118] :=  1; start[119] :=  1; 
-  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] := 37; 
-  start[124] := 37; start[125] := 37; start[126] := 37; start[127] := 37; 
-  start[128] := 37; start[129] := 37; start[130] := 37; start[131] := 37; 
-  start[132] := 37; start[133] := 37; start[134] := 37; start[135] := 37; 
-  start[136] := 37; start[137] := 37; start[138] := 37; start[139] := 37; 
-  start[140] := 37; start[141] := 37; start[142] := 37; start[143] := 37; 
-  start[144] := 37; start[145] := 37; start[146] := 37; start[147] := 37; 
-  start[148] := 37; start[149] := 37; start[150] := 37; start[151] := 37; 
-  start[152] := 37; start[153] := 37; start[154] := 37; start[155] := 37; 
-  start[156] := 37; start[157] := 37; start[158] := 37; start[159] := 37; 
-  start[160] := 37; start[161] := 37; start[162] := 37; start[163] := 37; 
-  start[164] := 37; start[165] := 37; start[166] := 37; start[167] := 37; 
-  start[168] := 37; start[169] := 37; start[170] := 37; start[171] := 37; 
-  start[172] := 37; start[173] := 37; start[174] := 37; start[175] := 37; 
-  start[176] := 37; start[177] := 37; start[178] := 37; start[179] := 37; 
-  start[180] := 37; start[181] := 37; start[182] := 37; start[183] := 37; 
-  start[184] := 37; start[185] := 37; start[186] := 37; start[187] := 37; 
-  start[188] := 37; start[189] := 37; start[190] := 37; start[191] := 37; 
-  start[192] := 37; start[193] := 37; start[194] := 37; start[195] := 37; 
-  start[196] := 37; start[197] := 37; start[198] := 37; start[199] := 37; 
-  start[200] := 37; start[201] := 37; start[202] := 37; start[203] := 37; 
-  start[204] := 37; start[205] := 37; start[206] := 37; start[207] := 37; 
-  start[208] := 37; start[209] := 37; start[210] := 37; start[211] := 37; 
-  start[212] := 37; start[213] := 37; start[214] := 37; start[215] := 37; 
-  start[216] := 37; start[217] := 37; start[218] := 37; start[219] := 37; 
-  start[220] := 37; start[221] := 37; start[222] := 37; start[223] := 37; 
-  start[224] := 37; start[225] := 37; start[226] := 37; start[227] := 37; 
-  start[228] := 37; start[229] := 37; start[230] := 37; start[231] := 37; 
-  start[232] := 37; start[233] := 37; start[234] := 37; start[235] := 37; 
-  start[236] := 37; start[237] := 37; start[238] := 37; start[239] := 37; 
-  start[240] := 37; start[241] := 37; start[242] := 37; start[243] := 37; 
-  start[244] := 37; start[245] := 37; start[246] := 37; start[247] := 37; 
-  start[248] := 37; start[249] := 37; start[250] := 37; start[251] := 37; 
-  start[252] := 37; start[253] := 37; start[254] := 37; start[255] := 37; 
+  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] := 38; 
+  start[124] := 26; start[125] := 38; start[126] := 38; start[127] := 38; 
+  start[128] := 38; start[129] := 38; start[130] := 38; start[131] := 38; 
+  start[132] := 38; start[133] := 38; start[134] := 38; start[135] := 38; 
+  start[136] := 38; start[137] := 38; start[138] := 38; start[139] := 38; 
+  start[140] := 38; start[141] := 38; start[142] := 38; start[143] := 38; 
+  start[144] := 38; start[145] := 38; start[146] := 38; start[147] := 38; 
+  start[148] := 38; start[149] := 38; start[150] := 38; start[151] := 38; 
+  start[152] := 38; start[153] := 38; start[154] := 38; start[155] := 38; 
+  start[156] := 38; start[157] := 38; start[158] := 38; start[159] := 38; 
+  start[160] := 38; start[161] := 38; start[162] := 38; start[163] := 38; 
+  start[164] := 38; start[165] := 38; start[166] := 38; start[167] := 38; 
+  start[168] := 38; start[169] := 38; start[170] := 38; start[171] := 38; 
+  start[172] := 38; start[173] := 38; start[174] := 38; start[175] := 38; 
+  start[176] := 38; start[177] := 38; start[178] := 38; start[179] := 38; 
+  start[180] := 38; start[181] := 38; start[182] := 38; start[183] := 38; 
+  start[184] := 38; start[185] := 38; start[186] := 38; start[187] := 38; 
+  start[188] := 38; start[189] := 38; start[190] := 38; start[191] := 38; 
+  start[192] := 38; start[193] := 38; start[194] := 38; start[195] := 38; 
+  start[196] := 38; start[197] := 38; start[198] := 38; start[199] := 38; 
+  start[200] := 38; start[201] := 38; start[202] := 38; start[203] := 38; 
+  start[204] := 38; start[205] := 38; start[206] := 38; start[207] := 38; 
+  start[208] := 38; start[209] := 38; start[210] := 38; start[211] := 38; 
+  start[212] := 38; start[213] := 38; start[214] := 38; start[215] := 38; 
+  start[216] := 38; start[217] := 38; start[218] := 38; start[219] := 38; 
+  start[220] := 38; start[221] := 38; start[222] := 38; start[223] := 38; 
+  start[224] := 38; start[225] := 38; start[226] := 38; start[227] := 38; 
+  start[228] := 38; start[229] := 38; start[230] := 38; start[231] := 38; 
+  start[232] := 38; start[233] := 38; start[234] := 38; start[235] := 38; 
+  start[236] := 38; start[237] := 38; start[238] := 38; start[239] := 38; 
+  start[240] := 38; start[241] := 38; start[242] := 38; start[243] := 38; 
+  start[244] := 38; start[245] := 38; start[246] := 38; start[247] := 38; 
+  start[248] := 38; start[249] := 38; start[250] := 38; start[251] := 38; 
+  start[252] := 38; start[253] := 38; start[254] := 38; start[255] := 38; 
   Error := Err; lastCh := EOF;
 END M2compS.

src/MGen.mod

@@ -121,6 +121,9 @@ VAR
   curProc : INTEGER;
   loopSt : ARRAY [0 .. MaxLoop - 1] OF INTEGER;
   loopTop : CARDINAL;
+  withTmps : ARRAY [0 .. 7] OF INTEGER;
+  withTyps : ARRAY [0 .. 7] OF INTEGER;
+  withTop : CARDINAL;
   ok : BOOLEAN;
 
 (* ---------------- small helpers ---------------- *)
@@ -663,6 +666,7 @@ PROCEDURE OpenModule (name: ARRAY OF CHAR);
     nInits := 0;
     curDepth := 0; curProc := 0;
     loopTop := 0;
+    withTop := 0;
     ok := TRUE;
     i := 0;
     WHILE i <= MaxProc DO
@@ -977,9 +981,13 @@ PROCEDURE EmitAddr (n: AST.Node);
   BEGIN
     IF (n = NIL) OR ~ok THEN RETURN END;
     IF n^.kind = AST.nkName THEN
-      vi := ResolveName(n);
-      IF vi < 0 THEN Fail230(); PushInt(0); RETURN END;
-      EmitAddrEntry(vi)
+      IF (n^.aux = SymTab.KindField) & (n^.tag[0] = 0C) THEN
+        IF ~EmitWithAddr(n^.name) THEN Fail230(); PushInt(0) END
+      ELSE
+        vi := ResolveName(n);
+        IF vi < 0 THEN Fail230(); PushInt(0); RETURN END;
+        EmitAddrEntry(vi)
+      END
     ELSIF n^.kind = AST.nkField THEN
       IF n^.tag[0] # 0C THEN
         vi := FindModVar(n^.tag, n^.name);
@@ -1124,9 +1132,13 @@ PROCEDURE EmitExpr (n: AST.Node);
       END
     ELSIF n^.kind = AST.nkStr THEN Fail230()
     ELSIF n^.kind = AST.nkName THEN
-      vi := ResolveName(n);
-      IF vi >= 0 THEN EmitLoadEntry(vi)
-      ELSE PushConstName(n)
+      IF (n^.aux = SymTab.KindField) & (n^.tag[0] = 0C) THEN
+        EmitWithLoad(n^.name)
+      ELSE
+        vi := ResolveName(n);
+        IF vi >= 0 THEN EmitLoadEntry(vi)
+        ELSE PushConstName(n)
+        END
       END
     ELSIF n^.kind = AST.nkBin THEN
       isR := IsRealTyp(t);
@@ -1358,6 +1370,8 @@ PROCEDURE EmitStmt (n: AST.Node);
       IF loopTop = 0 THEN Fail230(); RETURN END;
       Jmp(loopSt[loopTop - 1])
     ELSIF n^.kind = AST.nkFor THEN EmitFor(n)
+    ELSIF n^.kind = AST.nkWith THEN EmitWith(n)
+    ELSIF n^.kind = AST.nkCase THEN EmitCase(n)
     ELSIF n^.kind = AST.nkReturn THEN
       IF curProc < 1 THEN Fail230(); RETURN END;
       IF n^.left # NIL THEN EmitExpr(n^.left) END;
@@ -1616,6 +1630,101 @@ PROCEDURE EmitFor (n: AST.Node);
     DefLabel(lEnd)
   END EmitFor;
 
+(* ---------------- WITH / CASE (step 6) ---------------- *)
+
+PROCEDURE EmitWithAddr (name: ARRAY OF CHAR): BOOLEAN;
+(* Pushes the byte address of a WITH-field (top-down search over
+   open WITH levels). FALSE when no open WITH owns the field. *)
+  VAR i: CARDINAL;
+    off: INTEGER;
+  BEGIN
+    i := withTop;
+    WHILE i > 0 DO
+      DEC(i);
+      IF SymTab.FieldExists(withTyps[i], name) THEN
+        off := SymTab.FieldOffset(withTyps[i], name);
+        LoadTemp(withTmps[i]);
+        IF off > 0 THEN
+          PushInt(off * 8);
+          EmitOp(OPadd)
+        END;
+        RETURN TRUE
+      END
+    END;
+    RETURN FALSE
+  END EmitWithAddr;
+
+PROCEDURE EmitWithLoad (name: ARRAY OF CHAR);
+(* Pushes a WITH-field value (no scope entry exists for it). *)
+  BEGIN
+    IF ~EmitWithAddr(name) THEN Fail230(); PushInt(0); RETURN END;
+    LoadIndir
+  END EmitWithLoad;
+
+PROCEDURE EmitWith (n: AST.Node);
+  VAR tmp: INTEGER;
+  BEGIN
+    IF (n = NIL) OR ~ok THEN RETURN END;
+    IF n^.left = NIL THEN Fail230(); RETURN END;
+    IF withTop > 7 THEN Fail230(); RETURN END;
+    EmitAddr(n^.left);
+    tmp := TempGlobal();
+    StoreTemp(tmp);
+    withTmps[withTop] := tmp;
+    withTyps[withTop] := n^.left^.typ;
+    INC(withTop);
+    EmitStmts(n^.right);
+    IF withTop > 0 THEN DEC(withTop) END
+  END EmitWith;
+
+PROCEDURE EmitCase (n: AST.Node);
+(* Compare-chain lowering (v1 recipe): selector to a temp, then per
+   label Eq (ranges: Ge+Le+And) with Jz-chains into arm bodies. *)
+  VAR ts, endL, bodyL, nextL, chunkL: INTEGER;
+    arm, lab: AST.Node;
+  BEGIN
+    IF (n = NIL) OR ~ok THEN RETURN END;
+    IF n^.left = NIL THEN Fail230(); RETURN END;
+    ts := TempGlobal();
+    EmitExpr(n^.left);
+    StoreTemp(ts);
+    endL := NewLabel();
+    arm := n^.right;
+    WHILE (arm # NIL) & ok DO
+      bodyL := NewLabel(); nextL := NewLabel();
+      lab := arm^.left;
+      WHILE (lab # NIL) & ok DO
+        IF lab^.kind = AST.nkInt THEN
+          LoadTemp(ts);
+          PushInt(lab^.num);
+          EmitOp(OPeq)
+        ELSIF lab^.kind = AST.nkRange THEN
+          LoadTemp(ts);
+          PushInt(lab^.num);
+          EmitOp(OPige);
+          LoadTemp(ts);
+          PushInt(lab^.op);
+          EmitOp(OPile);
+          EmitOp(OPand)
+        ELSE Fail230(); RETURN
+        END;
+        chunkL := NewLabel();
+        Jz(chunkL);
+        Jmp(bodyL);
+        DefLabel(chunkL);
+        lab := lab^.next
+      END;
+      Jmp(nextL);
+      DefLabel(bodyL);
+      EmitStmts(arm^.right);
+      Jmp(endL);
+      DefLabel(nextL);
+      arm := arm^.next
+    END;
+    IF n^.extra # NIL THEN EmitStmts(n^.extra) END;
+    DefLabel(endL)
+  END EmitCase;
+
 PROCEDURE Prescan (n: AST.Node; VAR maxP, nIni: CARDINAL);
   BEGIN
     WHILE (n # NIL) & ok DO
@@ -1674,6 +1783,7 @@ BEGIN
   nInits := 0;
   curDepth := 0; curProc := 0;
   loopTop := 0;
+  withTop := 0;
   ok := TRUE;
   modName[0] := 0C
 END MGen.

src/SymTab.mod

@@ -170,6 +170,8 @@ PROCEDURE ConstFold (n: AST.Node; VAR v: INTEGER): BOOLEAN;
     IF n = NIL THEN RETURN FALSE END;
     IF n^.kind = AST.nkInt THEN
       v := n^.num; RETURN TRUE
+    ELSIF n^.kind = AST.nkChar THEN
+      v := n^.num; RETURN TRUE
     ELSIF n^.kind = AST.nkUn THEN
       IF ~ConstFold(n^.left, a) THEN RETURN FALSE END;
       IF n^.op = AST.opNeg THEN v := -a

tests/t_bad_case.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  MODULE TBadCase;
+    2  VAR ExitCode : INTEGER;
+    3      r : RECORD x : INTEGER END;
+    4  BEGIN
+    5    r.x := 1;
+    6    CASE r OF
+*****         ^ incompatible comparison
+    7      1: r.x := 2
+*****      ^ incompatible comparison
+    8    ELSE r.x := 3
+    9    END;
+   10    ExitCode := r.x
+   11  END TBadCase.
+
+    2 errors
+
+

tests/t_bad_case.mod

@@ -0,0 +1,11 @@
+MODULE TBadCase;
+VAR ExitCode : INTEGER;
+    r : RECORD x : INTEGER END;
+BEGIN
+  r.x := 1;
+  CASE r OF
+    1: r.x := 2
+  ELSE r.x := 3
+  END;
+  ExitCode := r.x
+END TBadCase.

tests/t_bad_caselbl.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE TBadLabel;
+    2  VAR ExitCode : INTEGER;
+    3      i, j : INTEGER;
+    4  BEGIN
+    5    i := 1; j := 2;
+    6    CASE i OF
+    7      j: i := 3
+*****      ^ not supported in this phase
+    8    ELSE i := 4
+    9    END;
+   10    ExitCode := i
+   11  END TBadLabel.
+
+    1 error
+
+

tests/t_bad_caselbl.mod

@@ -0,0 +1,11 @@
+MODULE TBadLabel;
+VAR ExitCode : INTEGER;
+    i, j : INTEGER;
+BEGIN
+  i := 1; j := 2;
+  CASE i OF
+    j: i := 3
+  ELSE i := 4
+  END;
+  ExitCode := i
+END TBadLabel.

tests/t_bad_with.LST

@@ -0,0 +1,17 @@
+Listing:
+
+    1  MODULE TBadWith;
+    2  VAR ExitCode : INTEGER;
+    3      n : INTEGER;
+    4  BEGIN
+    5    n := 1;
+    6    WITH n DO
+*****         ^ not a RECORD type
+    7      n := 2
+    8    END;
+    9    ExitCode := n
+   10  END TBadWith.
+
+    1 error
+
+

tests/t_bad_with.mod

@@ -0,0 +1,10 @@
+MODULE TBadWith;
+VAR ExitCode : INTEGER;
+    n : INTEGER;
+BEGIN
+  n := 1;
+  WITH n DO
+    n := 2
+  END;
+  ExitCode := n
+END TBadWith.

tests/t_case.LST

@@ -0,0 +1,38 @@
+Listing:
+
+    1  MODULE TCase;
+    2  VAR ExitCode : INTEGER;
+    3      i, k : INTEGER;
+    4      c : CHAR;
+    5  BEGIN
+    6    ExitCode := 0;
+    7    i := 2;
+    8    CASE i OF
+    9      1: ExitCode := ExitCode + 1
+   10    | 2, 3: ExitCode := ExitCode + 10
+   11    | 4..6: ExitCode := ExitCode + 100
+   12    ELSE ExitCode := ExitCode + 1000
+   13    END;
+   14    k := 7;
+   15    CASE k OF
+   16      1: k := 0
+   17    ELSE k := k + 1
+   18    END;
+   19    ExitCode := ExitCode + k;
+   20    c := 'b';
+   21    CASE c OF
+   22      'a': ExitCode := ExitCode + 100
+   23    | 'b': ExitCode := ExitCode + 20
+   24    ELSE ExitCode := ExitCode + 200
+   25    END;
+   26    i := 99;
+   27    CASE i OF
+   28      1: i := 0
+   29    ELSE i := i + 1
+   30    END;
+   31    ExitCode := ExitCode + i
+   32  END TCase.
+
+    0 errors
+
+

tests/t_case.mod

@@ -0,0 +1,32 @@
+MODULE TCase;
+VAR ExitCode : INTEGER;
+    i, k : INTEGER;
+    c : CHAR;
+BEGIN
+  ExitCode := 0;
+  i := 2;
+  CASE i OF
+    1: ExitCode := ExitCode + 1
+  | 2, 3: ExitCode := ExitCode + 10
+  | 4..6: ExitCode := ExitCode + 100
+  ELSE ExitCode := ExitCode + 1000
+  END;
+  k := 7;
+  CASE k OF
+    1: k := 0
+  ELSE k := k + 1
+  END;
+  ExitCode := ExitCode + k;
+  c := 'b';
+  CASE c OF
+    'a': ExitCode := ExitCode + 100
+  | 'b': ExitCode := ExitCode + 20
+  ELSE ExitCode := ExitCode + 200
+  END;
+  i := 99;
+  CASE i OF
+    1: i := 0
+  ELSE i := i + 1
+  END;
+  ExitCode := ExitCode + i
+END TCase.

tests/t_with.LST

@@ -0,0 +1,23 @@
+Listing:
+
+    1  MODULE TWith;
+    2  VAR ExitCode : INTEGER;
+    3      r : RECORD x, y : INTEGER END;
+    4      a : ARRAY [0 .. 1] OF RECORD v : INTEGER END;
+    5  BEGIN
+    6    r.x := 10; r.y := 20;
+    7    WITH r DO
+    8      x := x + 1;
+    9      y := y + x
+   10    END;
+   11    WITH a[1] DO v := 5 END;
+   12    WITH r DO
+   13      WITH a[0] DO v := 2 END;
+   14      x := x + a[0].v
+   15    END;
+   16    ExitCode := r.x + r.y + a[0].v + a[1].v
+   17  END TWith.
+
+    0 errors
+
+

tests/t_with.mod

@@ -0,0 +1,17 @@
+MODULE TWith;
+VAR ExitCode : INTEGER;
+    r : RECORD x, y : INTEGER END;
+    a : ARRAY [0 .. 1] OF RECORD v : INTEGER END;
+BEGIN
+  r.x := 10; r.y := 20;
+  WITH r DO
+    x := x + 1;
+    y := y + x
+  END;
+  WITH a[1] DO v := 5 END;
+  WITH r DO
+    WITH a[0] DO v := 2 END;
+    x := x + a[0].v
+  END;
+  ExitCode := r.x + r.y + a[0].v + a[1].v
+END TWith.