step2: scalars + MC64 backend — SymTab, MGen emitter, 25/25 tests green; fix bit_in operand order

M2c.atg

@@ -1,12 +1,45 @@
 COMPILER M2c
-(* Phase 0: module skeleton only.
-   Accepts "MODULE <name> ; [ BEGIN ] END <name> ." and checks that
-   the closing name matches (error 202). No declarations, no
-   statements, no symbol table yet — those arrive in Phase 1. *)
+(* Modula-2 program modules without procedures, with an MC64 backend
+   (see MGen for details).
+
+   - program module only, no DEFINITION / IMPLEMENTATION split
+   - no local modules, no EXPORT, no PRIORITY
+   - no ProcedureDeclaration, FormalParameters, ProcedureType,
+     ProcedureCall, ActualParameters, FORWARD, RETURN
+   - statements: assignment, IF, CASE, WHILE, REPEAT, LOOP/EXIT, FOR, WITH
+   - symbol table (SymTab) with static type checking: error codes
+     200/201/202 and 210-224, same lenient rules as the reference
+     implementation (single pass, declare-before-use; INTEGER,
+     CARDINAL and subranges form one integer family; no mixed
+     INTEGER/REAL arithmetic; INTEGER assigns to REAL; 1-character
+     literal is CHAR; InvalidType suppresses follow-on errors)
+   - backend (MGen): emits a single-module MC64 image <ModName>.MCD
+     (current directory), runnable with mcint. Lowered: scalar
+     globals, CONST literals (startup stores), SET OF ordinals
+     (bit masks) with literals, IN, = and #; full scalar
+     expressions on the stack machine; control flow via E0/E1 jumps.
+     Everything else parses and type-checks but gets error 230
+     (not supported in this phase): ARRAY/RECORD/POINTER variables,
+     string variables, WITH, non-literal CONST expressions and BY
+     steps, EXIT outside LOOP, imported names used as values.
+   - test convention (the language has no I/O): a global
+       VAR ExitCode : INTEGER;
+     is printed as decimal + CRLF through an embedded helper;
+     without it the program just ends.
+   - known semantic edges: INTEGER DIV/MOD truncate toward zero
+     (not Modula-2 floor); CARDINAL values past MAXINT compare as
+     signed; AND/OR are eager (no short-circuit); REAL widens to
+     binary64; assignment targets cost one dead load. *)
+
+IMPORT SymTab, MGen;
 
 CHARACTERS
-  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
-  digit  = "0123456789" .
+  eol      = CHR(13) .
+  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit    = "0123456789" .
+  hexDigit = digit + "ABCDEF" .
+  noQuote1 = ANY - "'" - eol .
+  noQuote2 = ANY - '"' - eol .
 
 IGNORE CHR(9) .. CHR(13)
 
@@ -14,23 +47,855 @@ COMMENTS
   FROM "(*" TO "*)" NESTED
 
 TOKENS
-  ident = letter { letter | digit } .
+  ident   = letter { letter | digit } .
+  integer = digit { digit }
+          | digit { digit } CONTEXT("..")
+          | digit { hexDigit } "H" .
+  real    = digit { digit } "." { digit }
+            [ "E" [ "+" | "-" ] digit { digit } ] .
+  string  = "'" { noQuote1 } "'"
+          | '"' { noQuote2 } '"' .
 
 PRODUCTIONS
-  M2c                             (. VAR m1, m2: ARRAY [0 .. 63] OF CHAR;
-                                       i: CARDINAL; same: BOOLEAN; .)
-    = "MODULE" ident              (. LexName(m1); .)
-      ";" [ "BEGIN" ] "END"
-      ident                       (. LexName(m2);
-                                     i := 0; same := TRUE;
-                                     WHILE same & ((m1[i] # 0C)
-                                           OR (m2[i] # 0C)) DO
-                                       IF m1[i] # m2[i] THEN
-                                         same := FALSE
-                                       END;
-                                       INC(i)
-                                     END;
-                                     IF ~same THEN SemError(202) END; .)
-      "." .
+  M2c                                   (. VAR m1, m2: SymTab.Name; .)
+    = "MODULE"
+      GetIdent<m1>                      (. SymTab.Init; MGen.OpenModule(m1);
+                                           IF ~SymTab.Enter(m1, SymTab.KindModule)
+                                           THEN SemError(200) END .)
+      ";"
+      { Import } Block GetIdent<m2>     (. IF ~SymTab.Equal(m1, m2)
+                                           THEN SemError(202) END .)
+      "."                               (. MGen.EndModule;
+                                           SymTab.PrintTable; .) .
+  Import                                (. VAR n: SymTab.Name; .)
+    = "FROM"
+      GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .)
+      "IMPORT"
+      ImportList ";"
+    | "IMPORT"
+      ImportList ";" .
+  ImportList                            (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.Enter(n, SymTab.KindImport)
+                                           THEN SemError(200) END .) } .
+  Block      = { Declaration }
+               [ "BEGIN"                (. MGen.BeginBody; .)
+                 StatSeq ]
+               "END" .
+  Declaration = "CONST"
+                          {
+                            ConstDecl ";" }
+              | "TYPE"
+                          {
+                            TypeDecl ";" }
+              | "VAR"
+                          {
+                            VarDecl ";" } .
+  ConstDecl                             (. VAR n: SymTab.Name;
+                                             t: SymTab.TypeIndex;
+                                             lx: MGen.LitStr;
+                                             cls: INTEGER; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindConst)
+                                           THEN SemError(200) END .)
+      "="                               (. MGen.NoEmitEnter; .)
+      ConstExpr<t, lx>                  (. SymTab.SetSymType(n, t);
+                                           cls := SymTab.ClassOf(t);
+                                           IF cls = SymTab.ClStr THEN
+                                             SemError(230)
+                                           ELSIF ~MGen.IsLit(lx) THEN
+                                             SemError(230)
+                                           END;
+                                           MGen.DeclConst(n, lx, t);
+                                           MGen.NoEmitExit; .) .
+  ConstExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+    = Expr<t, lx> .
+  TypeDecl                              (. VAR n: SymTab.Name;
+                                             t0, t1: SymTab.TypeIndex; .)
+    = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindType)
+                                           THEN SemError(200) END;
+                                           t0 := SymTab.NewAlias();
+                                           SymTab.SetSymType(n, t0); .)
+      "="
+      Type<t1>                          (. IF t1 = t0 THEN SemError(223);
+                                             SymTab.SetTarget(t0,
+                                               SymTab.InvalidType)
+                                           ELSE SymTab.SetTarget(t0, t1) END; .) .
+  VarDecl                               (. VAR t: SymTab.TypeIndex;
+                                             i: CARDINAL;
+                                             nm: SymTab.Name;
+                                             cls: INTEGER; .)
+    = VarIdents ":"
+      Type<t>                           (. cls := SymTab.ClassOf(t);
+                                           IF (cls # SymTab.ClInt)
+                                              & (cls # SymTab.ClReal)
+                                              & (cls # SymTab.ClBool)
+                                              & (cls # SymTab.ClChar)
+                                              & (cls # SymTab.ClEnum)
+                                              & (cls # SymTab.ClSet) THEN
+                                             SemError(230)
+                                           END;
+                                           i := 0;
+                                           WHILE i < SymTab.PendCount() DO
+                                             SymTab.PendName(i, nm);
+                                             MGen.DeclVar(nm);
+                                             INC(i)
+                                           END;
+                                           SymTab.FixPending(t); .) .
+  VarIdents                             (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.EnterPending(n,
+                                             SymTab.KindVar)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.EnterPending(n,
+                                             SymTab.KindVar)
+                                           THEN SemError(200) END .) } .
+  QualIdent <VAR t: SymTab.TypeIndex>
+                                        (. VAR n, m: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+                                             SemError(201);
+                                             t := SymTab.InvalidType
+                                           ELSIF (SymTab.SymKind(n) #
+                                                  SymTab.KindType)
+                                             & (SymTab.SymKind(n) #
+                                                SymTab.KindPredef)
+                                             & (SymTab.SymKind(n) #
+                                                SymTab.KindImport) THEN
+                                             SemError(221);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.SymType(n) END; .)
+      { "."
+        GetIdent<m>                     (. t := SymTab.InvalidType; .) } .
+
+  (* Types: ProcedureType removed; subrange factored for LL(1) *)
+  Type <VAR t: SymTab.TypeIndex>
+    = SimpleType<t> | ArrayType<t> | RecordType<t>
+    | SetType<t> | PointerType<t> .
+  SimpleType <VAR t: SymTab.TypeIndex>
+                                        (. VAR t1, t2: SymTab.TypeIndex;
+                                             lx1, lx2: MGen.LitStr; .)
+    = QualIdent<t> [ "["
+                      (. MGen.NoEmitEnter; .)
+                      ConstExpr<t1, lx1> (. IF (t1 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+                      ".."
+                      ConstExpr<t2, lx2> (. IF (t2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+                      "]"
+                                     (. t := SymTab.NewSub(t1);
+                                        MGen.NoEmitExit; .) ]
+    | "["                               (. MGen.NoEmitEnter; .)
+      ConstExpr<t1, lx1>                (. IF (t1 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t1) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      ".."
+      ConstExpr<t2, lx2>                (. IF (t2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(t2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      "]"                               (. t := SymTab.NewSub(t1);
+                                           MGen.NoEmitExit; .)
+    | Enum<t> .
+  Enum <VAR t: SymTab.TypeIndex>
+                                        (. VAR n: SymTab.Name;
+                                             ord: INTEGER; .)
+    = "("                               (. t := SymTab.NewEnum();
+                                           ord := 0; .)
+      GetIdent<n>                       (. IF ~SymTab.Enter(n,
+                                             SymTab.KindConst)
+                                           THEN SemError(200) END;
+                                           SymTab.SetSymType(n, t);
+                                           MGen.DeclConstInt(n, ord);
+                                           INC(ord); .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.Enter(n,
+                                             SymTab.KindConst)
+                                           THEN SemError(200) END;
+                                           SymTab.SetSymType(n, t);
+                                           MGen.DeclConstInt(n, ord);
+                                           INC(ord); .) }
+      ")" .
+  ArrayType <VAR t: SymTab.TypeIndex>
+                                        (. VAR s, s2, e: SymTab.TypeIndex; .)
+    = "ARRAY"
+      SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .)
+      { ","
+        SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s2) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END; .) }
+      "OF"
+      Type<e>                           (. t := SymTab.NewArray(e); .) .
+  RecordType <VAR t: SymTab.TypeIndex>
+    = "RECORD"                          (. t := SymTab.NewRecord(); .)
+      FieldSeq<t>
+      "END" .
+  FieldSeq <rt: SymTab.TypeIndex>
+    = Field<rt> { ";"
+                  Field<rt> } .
+  Field <rt: SymTab.TypeIndex>
+                                        (. VAR et: SymTab.TypeIndex; .)
+    = [ FieldIdents<rt> ":"
+        Type<et>                       (. SymTab.FixPendingF(rt, et); .) ] .
+  FieldIdents <rt: SymTab.TypeIndex>
+                                        (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                       (. IF ~SymTab.FieldPending(rt, n)
+                                           THEN SemError(200) END .)
+      { ","
+        GetIdent<n>                     (. IF ~SymTab.FieldPending(rt, n)
+                                           THEN SemError(200) END .) } .
+  SetType <VAR t: SymTab.TypeIndex>
+                                        (. VAR s: SymTab.TypeIndex; .)
+    = "SET"
+      "OF"
+      SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClInt)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClChar)
+                                            & (SymTab.ClassOf(s) #
+                                               SymTab.ClEnum) THEN
+                                            SemError(224) END;
+                                           t := SymTab.NewSet(s); .) .
+  PointerType <VAR t: SymTab.TypeIndex>
+                                        (. VAR b: SymTab.TypeIndex; .)
+    = "POINTER"
+      "TO"
+      Type<b>                           (. t := SymTab.NewPtr(b); .) .
+
+  (* Statements: ProcedureCall and RETURN removed *)
+  StatSeq    = Stat { ";"
+                     Stat } .
+  Stat                                  (. VAR lx: INTEGER; .)
+    = [ Assign | IfStat | CaseStat | WhileStat
+      | RepeatStat | LoopStat | ForStat | WithStat
+      | "EXIT"                 (. IF MGen.TopLoop(lx) THEN
+                                    MGen.Jmp(lx)
+                                  ELSE SemError(230) END; .) ] .
+  Assign                                (. VAR dt, et: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             bn: SymTab.Name;
+                                             lxe, lxD: MGen.LitStr;
+                                             isR, conv: BOOLEAN; .)
+    = Design<dt, dk, bn, FALSE, lxD> ":="
+      Expr<et, lxe>                     (. IF (dt # SymTab.InvalidType)
+                                           & (dk # SymTab.KindVar)
+                                           & (dk # SymTab.KindField)
+                                           & (dk # SymTab.KindImport) THEN
+                                           SemError(210)
+                                         ELSIF ~SymTab.Assignable(et, dt) THEN
+                                           SemError(210) END;
+                                         IF dk = SymTab.KindImport THEN
+                                           SemError(230)
+                                         END;
+                                         isR := (dt # SymTab.InvalidType)
+                                                & (SymTab.ClassOf(dt)
+                                                   = SymTab.ClReal);
+                                         conv := isR
+                                                 & SymTab.IsIntFamily(et);
+                                         IF dk = SymTab.KindVar THEN
+                                           IF conv THEN
+                                             MGen.IntToReal;
+                                           END;
+                                           MGen.StoreVar(bn)
+                                         ELSE MGen.Drop
+                                         END; .) .
+  IfStat                                (. VAR t: SymTab.TypeIndex;
+                                             lxC: MGen.LitStr;
+                                             elseL, endL: INTEGER;
+                                             hasElse: BOOLEAN; .)
+    = "IF"
+      Expr<t, lxC>                      (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           elseL := MGen.NewLabel();
+                                           endL := MGen.NewLabel();
+                                           MGen.Jz(elseL);
+                                           hasElse := FALSE; .)
+      "THEN"
+      StatSeq
+      { "ELSIF"                         (. MGen.Jmp(endL);
+                                           MGen.DefLabel(elseL); .)
+        Expr<t, lxC>                    (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           elseL := MGen.NewLabel();
+                                           MGen.Jz(elseL); .)
+        "THEN"
+        StatSeq }
+      [ "ELSE"                          (. MGen.Jmp(endL);
+                                           MGen.DefLabel(elseL);
+                                           hasElse := TRUE; .)
+        StatSeq ]
+      "END"                             (. IF ~hasElse THEN
+                                           MGen.DefLabel(elseL)
+                                         END;
+                                         MGen.DefLabel(endL); .) .
+  CaseStat                              (. VAR st: SymTab.TypeIndex;
+                                             lxS: MGen.LitStr;
+                                             tmp, endL: INTEGER; .)
+    = "CASE"
+      Expr<st, lxS>                     (. tmp := MGen.TempGlobal();
+                                           MGen.StoreTemp(tmp);
+                                           endL := MGen.NewLabel(); .)
+      "OF"
+      Case<st, tmp, endL> { "|"
+                 Case<st, tmp, endL> }
+      [ "ELSE"
+        StatSeq ]
+      "END"                             (. MGen.DefLabel(endL); .) .
+  Case <sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER>
+                                        (. VAR lB, lN: INTEGER; .)
+    = [ LabelList<sel, tmp, lB, lN> ":" (. MGen.DefLabel(lB); .)
+        StatSeq                         (. MGen.Jmp(endL);
+                                           MGen.DefLabel(lN); .) ] .
+  LabelList <sel: SymTab.TypeIndex; tmp: INTEGER;
+             VAR lB: INTEGER; VAR lN: INTEGER>
+    =                                   (. lB := MGen.NewLabel();
+                                           lN := MGen.NewLabel(); .)
+      Labels<sel, tmp, lB> { ","
+                    Labels<sel, tmp, lB> }
+                                        (. MGen.Jmp(lN); .) .
+  Labels <sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER>
+                                        (. VAR t, t2: SymTab.TypeIndex;
+                                             lx1, lx2: MGen.LitStr;
+                                             ta, tb, chunk: INTEGER;
+                                             r, hasRange: BOOLEAN; .)
+    = ConstExpr<t, lx1>                 (. IF ~SymTab.EqCheck(t, sel) THEN
+                                           SemError(213) END;
+                                           r := (SymTab.ClassOf(sel)
+                                                 = SymTab.ClReal)
+                                                & (SymTab.ClassOf(t)
+                                                   = SymTab.ClReal);
+                                           ta := MGen.TempGlobal();
+                                           MGen.StoreTemp(ta);
+                                           hasRange := FALSE; .)
+      [ ".."
+        ConstExpr<t2, lx2>              (. IF ~SymTab.EqCheck(t2, sel) THEN
+                                           SemError(213) END;
+                                           tb := MGen.TempGlobal();
+                                           MGen.StoreTemp(tb);
+                                           hasRange := TRUE; .) ]
+                                        (. IF hasRange THEN
+                                             MGen.LoadTemp(tmp);
+                                             MGen.LoadTemp(ta);
+                                             IF r THEN MGen.RealGe
+                                             ELSE MGen.IGe END;
+                                             MGen.LoadTemp(tmp);
+                                             MGen.LoadTemp(tb);
+                                             IF r THEN MGen.RealLe
+                                             ELSE MGen.ILe END;
+                                             MGen.And
+                                           ELSE
+                                             MGen.LoadTemp(tmp);
+                                             MGen.LoadTemp(ta);
+                                             IF r THEN MGen.RealEq
+                                             ELSE MGen.Eq END
+                                           END;
+                                           chunk := MGen.NewLabel();
+                                           MGen.Jz(chunk);
+                                           MGen.Jmp(bodyL);
+                                           MGen.DefLabel(chunk); .) .
+  WhileStat                             (. VAR t: SymTab.TypeIndex;
+                                             lxC: MGen.LitStr;
+                                             topL, endL: INTEGER; .)
+    = "WHILE"                           (. topL := MGen.NewLabel();
+                                           endL := MGen.NewLabel();
+                                           MGen.DefLabel(topL); .)
+      Expr<t, lxC>                      (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           MGen.Jz(endL); .)
+      "DO"
+      StatSeq
+      "END"                             (. MGen.Jmp(topL);
+                                           MGen.DefLabel(endL); .) .
+  RepeatStat                            (. VAR t: SymTab.TypeIndex;
+                                             lxC: MGen.LitStr;
+                                             topL: INTEGER; .)
+    = "REPEAT"                          (. topL := MGen.NewLabel();
+                                           MGen.DefLabel(topL); .)
+      StatSeq
+      "UNTIL"
+      Expr<t, lxC>                      (. IF ~SymTab.BoolCheck(t) THEN
+                                           SemError(214) END;
+                                           MGen.Jz(topL); .) .
+  LoopStat                              (. VAR topL, exitL: INTEGER; .)
+    = "LOOP"                            (. topL := MGen.NewLabel();
+                                           exitL := MGen.NewLabel();
+                                           MGen.DefLabel(topL);
+                                           MGen.PushLoop(exitL); .)
+      StatSeq
+      "END"                             (. MGen.Jmp(topL);
+                                           MGen.DefLabel(exitL);
+                                           MGen.PopLoop; .) .
+  ForStat                               (. VAR n, lv: SymTab.Name;
+                                             lo, hi: SymTab.TypeIndex;
+                                             lxLo, lxHi: MGen.LitStr;
+                                             byV, ht: INTEGER;
+                                             lTop, lChk, lEnd: INTEGER;
+                                             neg: BOOLEAN; .)
+    = "FOR"
+      GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+                                            SemError(201)
+                                          ELSIF (SymTab.SymKind(n) #
+                                                 SymTab.KindVar)
+                                            & (SymTab.SymKind(n) #
+                                               SymTab.KindField) THEN
+                                            SemError(220)
+                                          ELSIF (SymTab.SymType(n) #
+                                                 SymTab.InvalidType)
+                                            & ~SymTab.IsIntFamily(
+                                                SymTab.SymType(n)) THEN
+                                            SemError(220) END;
+                                            MGen.CopyName(n, lv); .)
+      ":="
+      Expr<lo, lxLo>                    (. IF (lo # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(lo) THEN
+                                           SemError(220) END;
+                                           MGen.StoreVar(lv); .)
+      "TO"
+      Expr<hi, lxHi>                    (. IF (hi # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(hi) THEN
+                                           SemError(220) END;
+                                           ht := MGen.TempGlobal();
+                                           MGen.StoreTemp(ht);
+                                           byV := 1; neg := FALSE; .)
+      [ "BY"
+        ByLit<byV>                      (. neg := byV < 0; .) ]
+      "DO"                              (. lTop := MGen.NewLabel();
+                                           lChk := MGen.NewLabel();
+                                           lEnd := MGen.NewLabel();
+                                           MGen.Jmp(lChk);
+                                           MGen.DefLabel(lTop); .)
+      StatSeq
+      "END"                             (. MGen.LoadVar(lv);
+                                           MGen.PushInt(byV);
+                                           MGen.Add;
+                                           MGen.StoreVar(lv);
+                                           MGen.DefLabel(lChk);
+                                           MGen.LoadVar(lv);
+                                           MGen.LoadTemp(ht);
+                                           IF neg THEN MGen.IGe
+                                           ELSE MGen.ILe END;
+                                           MGen.Jz(lEnd);
+                                           MGen.Jmp(lTop);
+                                           MGen.DefLabel(lEnd); .) .
+  ByLit <VAR v: INTEGER>                (. VAR s: ARRAY [0 .. 255] OF CHAR; .)
+    = integer                           (. LexString(s);
+                                           IF ~MGen.ParseInt(s, v) THEN
+                                             v := 1
+                                           END; .)
+    | "-" integer                       (. LexString(s);
+                                           IF MGen.ParseInt(s, v) THEN
+                                             v := -v
+                                           ELSE v := -1
+                                           END; .) .
+  WithStat                              (. VAR dt: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             bnW: SymTab.Name;
+                                             lxW: MGen.LitStr;
+                                             pushed: BOOLEAN; .)
+    = "WITH"
+      Design<dt, dk, bnW, FALSE, lxW>   (. pushed := FALSE;
+                                           IF dt # SymTab.InvalidType THEN
+                                             pushed :=
+                                               SymTab.PushRecord(dt);
+                                             IF ~pushed THEN
+                                               SemError(215)
+                                             END
+                                           END;
+                                           IF pushed THEN
+                                             MGen.NoSupEnter;
+                                             SemError(230)
+                                           END; .)
+      "DO"
+      StatSeq
+      "END"                             (. IF pushed THEN
+                                             SymTab.PopScope;
+                                             MGen.NoSupExit
+                                           END; .) .
+
+  (* Expressions: Designator without ActualParameters.
+     Only record fields resolve qualified access; WITH pushes an
+     inner scope so field names also work unqualified in its body.
+     Each expression synthesizes its SymTab type in t and, for
+     single literals, the source text in lx ("" otherwise, used for
+     CONST validation). Values travel on the MC64 stack. *)
+  Design <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+          VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr>
+                                        (. VAR n, m: SymTab.Name;
+                                             it: SymTab.TypeIndex;
+                                             lxI: MGen.LitStr;
+                                             cls: INTEGER; .)
+    = GetIdent<n>                       (. MGen.CopyName(n, bn);
+                                           lx[0] := 0C;
+                                           IF ~SymTab.Lookup(n) THEN
+                                             SemError(201);
+                                             t := SymTab.InvalidType; k := -1;
+                                             IF doLoad THEN
+                                               MGen.PushInt(0)
+                                             END
+                                           ELSE
+                                             t := SymTab.SymType(n);
+                                             k := SymTab.SymKind(n);
+                                             IF k = SymTab.KindConst THEN
+                                               IF SymTab.Equal(n, "TRUE") THEN
+                                                 t := SymTab.BoolType();
+                                                 MGen.CopyName("TRUE", lx);
+                                                 IF doLoad THEN
+                                                   MGen.PushInt(1)
+                                                 END
+                                               ELSIF SymTab.Equal(n,
+                                                       "FALSE") THEN
+                                                 t := SymTab.BoolType();
+                                                 MGen.CopyName("FALSE", lx);
+                                                 IF doLoad THEN
+                                                   MGen.PushInt(0)
+                                                 END
+                                               ELSE
+                                                 cls :=
+                                                   SymTab.ClassOf(t);
+                                                 IF (t #
+                                                     SymTab.InvalidType)
+                                                    & (cls # SymTab.ClStr)
+                                                    & ((cls = SymTab.ClInt)
+                                                    OR (cls = SymTab.ClReal)
+                                                    OR (cls = SymTab.ClBool)
+                                                    OR (cls = SymTab.ClChar)
+                                                    OR (cls
+                                                        = SymTab.ClEnum)) THEN
+                                                   IF doLoad THEN
+                                                     MGen.LoadVar(n)
+                                                   END
+                                                 ELSIF doLoad THEN
+                                                   MGen.PushInt(0)
+                                                 END
+                                               END
+                                             ELSIF k = SymTab.KindVar THEN
+                                               cls := SymTab.ClassOf(t);
+                                               IF (cls = SymTab.ClInt)
+                                                  OR (cls = SymTab.ClReal)
+                                                  OR (cls = SymTab.ClBool)
+                                                  OR (cls = SymTab.ClChar)
+                                                  OR (cls
+                                                      = SymTab.ClEnum)
+                                                  OR (cls
+                                                      = SymTab.ClSet) THEN
+                                                 IF doLoad THEN
+                                                   MGen.LoadVar(n)
+                                                 END
+                                               ELSE SemError(230);
+                                                 IF doLoad THEN
+                                                   MGen.PushInt(0)
+                                                 END
+                                               END
+                                             ELSE
+                                               IF doLoad THEN
+                                                 MGen.PushInt(0)
+                                               END;
+                                               IF k = SymTab.KindField THEN
+                                                 IF ~MGen.NoSup() THEN
+                                                   SemError(230)
+                                                 END
+                                               ELSIF k
+                                                     = SymTab.KindImport THEN
+                                                 SemError(230)
+                                               END
+                                             END
+                                           END; .)
+      { "."                             (. lx[0] := 0C; .)
+        GetIdent<m>                     (. IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClRecord THEN
+                                             SemError(215);
+                                             t := SymTab.InvalidType
+                                           ELSIF ~SymTab.FieldExists(t, m) THEN
+                                             SemError(216);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.FieldType(t, m);
+                                             SemError(230)
+                                           END;
+                                           IF doLoad THEN
+                                             MGen.Drop; MGen.PushInt(0)
+                                           END; .)
+      | "["
+        Expr<it, lxI>                   (. MGen.Drop;
+                                           IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClArray THEN
+                                             SemError(217);
+                                             t := SymTab.InvalidType
+                                           ELSIF (it #
+                                                  SymTab.InvalidType)
+                                             & ~SymTab.IsIntFamily(it) THEN
+                                             SemError(218);
+                                             t := SymTab.InvalidType
+                                           ELSE t :=
+                                             SymTab.ArrayElem(t);
+                                             SemError(230)
+                                           END;
+                                           IF doLoad THEN
+                                             MGen.Drop; MGen.PushInt(0)
+                                           END; .)
+        { ","
+          Expr<it, lxI>                 (. MGen.Drop;
+                                           IF (it # SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(it) THEN
+                                           SemError(218) END; .) }
+        "]"
+      | "^"                             (. lx[0] := 0C;
+                                           IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClPtr THEN
+                                             SemError(219);
+                                             t := SymTab.InvalidType
+                                           ELSE t := SymTab.PtrBase(t);
+                                             SemError(230)
+                                           END;
+                                           IF doLoad THEN
+                                             MGen.Drop; MGen.PushInt(0)
+                                           END; .) } .
+  Expr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+                                        (. VAR t2: SymTab.TypeIndex;
+                                             tc, op: INTEGER;
+                                             lx2: MGen.LitStr;
+                                             r: BOOLEAN; .)
+    = SimExpr<t, lx> [ Rel<op> SimExpr<t2, lx2>
+      (. lx[0] := 0C;
+         IF op = SymTab.OpIn THEN
+           IF SymTab.InCheck(t, t2) THEN
+             t := SymTab.BoolType();
+             MGen.BitIn
+           ELSE SemError(222);
+             t := SymTab.InvalidType;
+             MGen.Drop; MGen.Drop; MGen.PushInt(0)
+           END
+         ELSE
+           tc := SymTab.ClassOf(t);
+           IF SymTab.RelCheck(t, t2, op) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(213); t := SymTab.InvalidType END;
+           IF t # SymTab.InvalidType THEN
+             r := tc = SymTab.ClReal;
+             IF r THEN
+               IF op = SymTab.OpEq THEN MGen.RealEq
+               ELSIF (op = SymTab.OpNeq1)
+                     OR (op = SymTab.OpNeq2) THEN MGen.RealNe
+               ELSIF op = SymTab.OpLt THEN MGen.RealLt
+               ELSIF op = SymTab.OpLe THEN MGen.RealLe
+               ELSIF op = SymTab.OpGt THEN MGen.RealGt
+               ELSE MGen.RealGe END
+             ELSE
+               IF op = SymTab.OpEq THEN MGen.Eq
+               ELSIF (op = SymTab.OpNeq1)
+                     OR (op = SymTab.OpNeq2) THEN MGen.Neq
+               ELSIF op = SymTab.OpLt THEN MGen.ILt
+               ELSIF op = SymTab.OpLe THEN MGen.ILe
+               ELSIF op = SymTab.OpGt THEN MGen.IGt
+               ELSE MGen.IGe END
+             END
+           ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0)
+           END
+         END; .) ] .
+  Rel <VAR op: INTEGER>
+    = "="                     (. op := SymTab.OpEq; .)
+    | "#"                     (. op := SymTab.OpNeq1; .)
+    | "<>"                    (. op := SymTab.OpNeq2; .)
+    | "<"                     (. op := SymTab.OpLt; .)
+    | "<="                    (. op := SymTab.OpLe; .)
+    | ">"                     (. op := SymTab.OpGt; .)
+    | ">="                    (. op := SymTab.OpGe; .)
+    | "IN"                    (. op := SymTab.OpIn; .) .
+  SimExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             lx2: MGen.LitStr;
+                                             neg, isR: BOOLEAN; .)
+    =                                   (. neg := FALSE; .)
+      [ "+" | "-"                       (. neg := TRUE; .) ]
+      Term<t, lx>                       (. IF neg THEN
+                                           IF MGen.IsLit(lx) THEN
+                                             MGen.NegFold(lx, lx)
+                                           ELSE lx[0] := 0C
+                                           END;
+                                           IF SymTab.ClassOf(t)
+                                              = SymTab.ClReal THEN
+                                             MGen.NegReal
+                                           ELSE MGen.NegInt
+                                           END
+                                         END; .)
+      { AddOp<op> Term<t2, lx2>
+      (. lx[0] := 0C;
+         IF op = SymTab.OpOr THEN
+           IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(212); t := SymTab.InvalidType END;
+           MGen.Or
+         ELSE
+           IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
+           ELSE SemError(211); t := SymTab.InvalidType END;
+           isR := (t # SymTab.InvalidType)
+                  & (SymTab.ClassOf(t) = SymTab.ClReal);
+           IF op = SymTab.OpAdd THEN
+             IF isR THEN MGen.RealAdd ELSE MGen.Add END
+           ELSE
+             IF isR THEN MGen.RealSub ELSE MGen.Sub END
+           END
+         END; .) } .
+  AddOp <VAR op: INTEGER>
+    = "+"                     (. op := SymTab.OpAdd; .)
+    | "-"                     (. op := SymTab.OpSub; .)
+    | "OR"                    (. op := SymTab.OpOr; .) .
+  Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+                                        (. VAR t2, res2: SymTab.TypeIndex;
+                                             op: INTEGER;
+                                             lx2: MGen.LitStr;
+                                             isR: BOOLEAN;
+                                             mt: INTEGER; .)
+    = Fact<t, lx> { MulOp<op> Fact<t2, lx2>
+      (. lx[0] := 0C;
+         IF op = SymTab.OpAnd THEN
+           IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+             t := SymTab.BoolType()
+           ELSE SemError(212); t := SymTab.InvalidType END;
+           MGen.And
+         ELSE
+           IF SymTab.ArithCheck(t, t2,
+                (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+                res2) THEN t := res2
+           ELSE SemError(211); t := SymTab.InvalidType END;
+           isR := (t # SymTab.InvalidType)
+                  & (SymTab.ClassOf(t) = SymTab.ClReal);
+           IF op = SymTab.OpTimes THEN
+             IF isR THEN MGen.RealMul ELSE MGen.MulU END
+           ELSIF op = SymTab.OpSlash THEN
+             IF isR THEN MGen.RealDiv ELSE MGen.DivI END
+           ELSIF op = SymTab.OpDiv THEN
+             MGen.DivI
+           ELSE
+             mt := MGen.TempGlobal();
+             MGen.ModI(mt)
+           END
+         END; .) } .
+  MulOp <VAR op: INTEGER>
+    = "*"                     (. op := SymTab.OpTimes; .)
+    | "/"                     (. op := SymTab.OpSlash; .)
+    | "DIV"                   (. op := SymTab.OpDiv; .)
+    | "MOD"                   (. op := SymTab.OpMod; .)
+    | "AND"                   (. op := SymTab.OpAnd; .)
+    | "&"                     (. op := SymTab.OpAnd; .) .
+  Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+                                        (. VAR s: ARRAY [0 .. 255] OF CHAR;
+                                             t2, et, dt, st: SymTab.TypeIndex;
+                                             dk: INTEGER;
+                                             bnF: SymTab.Name;
+                                             lxD, lx2: MGen.LitStr;
+                                             v: INTEGER;
+                                             c: CARDINAL;
+                                             b: LONGCARD; .)
+    = integer                         (. LexString(s);
+                                         MGen.CopyName(s, lx);
+                                         IF MGen.ParseInt(s, v) THEN
+                                           MGen.PushInt(v)
+                                         ELSIF MGen.ParseCard(s, c) THEN
+                                           MGen.PushBits(
+                                             VAL(LONGCARD, c))
+                                         ELSE MGen.PushInt(0)
+                                         END;
+                                         t := SymTab.IntType(); .)
+    | real                            (. LexString(s);
+                                         MGen.CopyName(s, lx);
+                                         IF MGen.ParseReal(s, b) THEN
+                                           MGen.PushBits(b)
+                                         ELSE MGen.PushBits(0H)
+                                         END;
+                                         t := SymTab.RealType(); .)
+    | string                          (. LexString(s);
+                                         IF SymTab.StrLen(s) <= 3 THEN
+                                           t := SymTab.CharType();
+                                           MGen.CopyName(s, lx);
+                                           MGen.PushInt(
+                                             MGen.CharOrd(s))
+                                         ELSE t := SymTab.NewStr();
+                                           SemError(230);
+                                           lx[0] := 0C;
+                                           MGen.PushInt(0)
+                                         END; .)
+    | Design<dt, dk, bnF, TRUE, lxD>   (. t := dt;
+                                         MGen.CopyName(lxD, lx); .)
+    | "("
+      Expr<et, lx> ")"                (. t := et; .)
+    | ( "NOT" | "~" )
+      Fact<t2, lx2>                   (. lx[0] := 0C;
+                                         IF SymTab.BoolCheck(t2) THEN
+                                           t := SymTab.BoolType()
+                                         ELSE SemError(212);
+                                           t := SymTab.InvalidType END;
+                                         MGen.Not; .)
+    | SetLit<st>                      (. lx[0] := 0C;
+                                         t := st; .) .
+  SetLit <VAR t: SymTab.TypeIndex>
+                                        (. VAR first, et: SymTab.TypeIndex;
+                                             lxE, lxE2: MGen.LitStr;
+                                             hasR: BOOLEAN; .)
+    = "{"
+                                (. MGen.PushInt(0);
+                                   t := SymTab.SetFor(SymTab.IntType()); .)
+      [ Elem<et, lxE, lxE2, hasR>   (. first := et;
+                                       t := SymTab.SetFor(et);
+                                       IF hasR THEN MGen.FieldMask
+                                       ELSE MGen.Power2 END;
+                                       MGen.Or; .)
+        { ","
+          Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
+                                       SemError(222) END;
+                                       IF hasR THEN MGen.FieldMask
+                                       ELSE MGen.Power2 END;
+                                       MGen.Or; .) } ]
+      "}" .
+  Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+        VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
+                                        (. VAR t2: SymTab.TypeIndex; .)
+    = Expr<t, lx>                       (. hasR := FALSE;
+                                           lx2[0] := 0C; .)
+      [ ".."
+        Expr<t2, lx2>                   (. IF ~SymTab.SetElemCheck(t, t2) THEN
+                                           SemError(222) END;
+                                           hasR := TRUE; .) ] .
+
+  GetIdent <VAR n: SymTab.Name>
+    = ident                           (. LexName(n); .) .
 
 END M2c.

M2c.err

@@ -1,8 +1,76 @@
    0: Msg("EOF expected")
 |  1: Msg("ident expected")
-|  2: Msg("'MODULE' expected")
-|  3: Msg("';' expected")
-|  4: Msg("'BEGIN' expected")
-|  5: Msg("'END' expected")
-|  6: Msg("'.' expected")
-|  7: Msg("not expected")
+|  2: Msg("integer expected")
+|  3: Msg("real expected")
+|  4: Msg("string expected")
+|  5: Msg("'MODULE' expected")
+|  6: Msg("';' expected")
+|  7: Msg("'.' expected")
+|  8: Msg("'FROM' expected")
+|  9: Msg("'IMPORT' expected")
+| 10: Msg("',' expected")
+| 11: Msg("'BEGIN' expected")
+| 12: Msg("'END' expected")
+| 13: Msg("'CONST' expected")
+| 14: Msg("'TYPE' expected")
+| 15: Msg("'VAR' expected")
+| 16: Msg("'=' expected")
+| 17: Msg("':' expected")
+| 18: Msg("'[' expected")
+| 19: Msg("'..' expected")
+| 20: Msg("']' expected")
+| 21: Msg("'(' expected")
+| 22: Msg("')' expected")
+| 23: Msg("'ARRAY' expected")
+| 24: Msg("'OF' expected")
+| 25: Msg("'RECORD' expected")
+| 26: Msg("'SET' expected")
+| 27: Msg("'POINTER' expected")
+| 28: Msg("'TO' expected")
+| 29: Msg("'EXIT' expected")
+| 30: Msg("':=' expected")
+| 31: Msg("'IF' expected")
+| 32: Msg("'THEN' expected")
+| 33: Msg("'ELSIF' expected")
+| 34: Msg("'ELSE' expected")
+| 35: Msg("'CASE' expected")
+| 36: Msg("'|' expected")
+| 37: Msg("'WHILE' expected")
+| 38: Msg("'DO' expected")
+| 39: Msg("'REPEAT' expected")
+| 40: Msg("'UNTIL' expected")
+| 41: Msg("'LOOP' expected")
+| 42: Msg("'FOR' expected")
+| 43: Msg("'BY' expected")
+| 44: Msg("'-' expected")
+| 45: Msg("'WITH' expected")
+| 46: Msg("'^' expected")
+| 47: Msg("'#' expected")
+| 48: Msg("'<>' expected")
+| 49: Msg("'<' expected")
+| 50: Msg("'<=' expected")
+| 51: Msg("'>' expected")
+| 52: Msg("'>=' expected")
+| 53: Msg("'IN' expected")
+| 54: Msg("'+' expected")
+| 55: Msg("'OR' expected")
+| 56: Msg("'*' expected")
+| 57: Msg("'/' expected")
+| 58: Msg("'DIV' expected")
+| 59: Msg("'MOD' expected")
+| 60: Msg("'AND' expected")
+| 61: Msg("'&' expected")
+| 62: Msg("'NOT' expected")
+| 63: Msg("'~' expected")
+| 64: Msg("'{' expected")
+| 65: Msg("'}' expected")
+| 66: Msg("not expected")
+| 67: Msg("invalid MulOp")
+| 68: Msg("invalid Fact")
+| 69: Msg("invalid AddOp")
+| 70: Msg("invalid Rel")
+| 71: Msg("invalid ByLit")
+| 72: Msg("invalid SimpleType")
+| 73: Msg("invalid Type")
+| 74: Msg("invalid Declaration")
+| 75: Msg("invalid Import")

M2c.lst

@@ -4,7 +4,12 @@ Source file: M2c.atg
 
 Grammar Tests:
 
-Deletable symbols:        -- none --
+Deletable symbols:
+     Case
+     Stat
+     Field
+     FieldSeq
+     StatSeq
 Undefined nonterminals:   -- none --
 Unreachable nonterminals: -- none --
 Circular derivations:     -- none --
@@ -13,12 +18,12 @@ LL(1) conditions:         --  ok  --
 
 Statistics:
 
-  nr of terminals:         8 (limit   400)
-  nr of non-terminals:     1 (limit   210)
-  nr of pragmas:           0 (limit   492)
-  nr of symbolnodes:       9 (limit   500)
-  nr of graphnodes:       12 (limit  1500)
-  nr of conditionsets:     1 (limit   100)
-  nr of charactersets:     3 (limit   250)
+  nr of terminals:        67 (limit   400)
+  nr of non-terminals:    46 (limit   210)
+  nr of pragmas:           0 (limit   433)
+  nr of symbolnodes:     113 (limit   500)
+  nr of graphnodes:      428 (limit  1500)
+  nr of conditionsets:     5 (limit   100)
+  nr of charactersets:     9 (limit   250)
 
 

M2c.mod

@@ -97,15 +97,101 @@ MODULE M2c;
         CASE nr OF
            0: Msg("EOF expected")
         |  1: Msg("ident expected")
-        |  2: Msg("'MODULE' expected")
-        |  3: Msg("';' expected")
-        |  4: Msg("'BEGIN' expected")
-        |  5: Msg("'END' expected")
-        |  6: Msg("'.' expected")
-        |  7: Msg("not expected")
+        |  2: Msg("integer expected")
+        |  3: Msg("real expected")
+        |  4: Msg("string expected")
+        |  5: Msg("'MODULE' expected")
+        |  6: Msg("';' expected")
+        |  7: Msg("'.' expected")
+        |  8: Msg("'FROM' expected")
+        |  9: Msg("'IMPORT' expected")
+        | 10: Msg("',' expected")
+        | 11: Msg("'BEGIN' expected")
+        | 12: Msg("'END' expected")
+        | 13: Msg("'CONST' expected")
+        | 14: Msg("'TYPE' expected")
+        | 15: Msg("'VAR' expected")
+        | 16: Msg("'=' expected")
+        | 17: Msg("':' expected")
+        | 18: Msg("'[' expected")
+        | 19: Msg("'..' expected")
+        | 20: Msg("']' expected")
+        | 21: Msg("'(' expected")
+        | 22: Msg("')' expected")
+        | 23: Msg("'ARRAY' expected")
+        | 24: Msg("'OF' expected")
+        | 25: Msg("'RECORD' expected")
+        | 26: Msg("'SET' expected")
+        | 27: Msg("'POINTER' expected")
+        | 28: Msg("'TO' expected")
+        | 29: Msg("'EXIT' expected")
+        | 30: Msg("':=' expected")
+        | 31: Msg("'IF' expected")
+        | 32: Msg("'THEN' expected")
+        | 33: Msg("'ELSIF' expected")
+        | 34: Msg("'ELSE' expected")
+        | 35: Msg("'CASE' expected")
+        | 36: Msg("'|' expected")
+        | 37: Msg("'WHILE' expected")
+        | 38: Msg("'DO' expected")
+        | 39: Msg("'REPEAT' expected")
+        | 40: Msg("'UNTIL' expected")
+        | 41: Msg("'LOOP' expected")
+        | 42: Msg("'FOR' expected")
+        | 43: Msg("'BY' expected")
+        | 44: Msg("'-' expected")
+        | 45: Msg("'WITH' expected")
+        | 46: Msg("'^' expected")
+        | 47: Msg("'#' expected")
+        | 48: Msg("'<>' expected")
+        | 49: Msg("'<' expected")
+        | 50: Msg("'<=' expected")
+        | 51: Msg("'>' expected")
+        | 52: Msg("'>=' expected")
+        | 53: Msg("'IN' expected")
+        | 54: Msg("'+' expected")
+        | 55: Msg("'OR' expected")
+        | 56: Msg("'*' expected")
+        | 57: Msg("'/' expected")
+        | 58: Msg("'DIV' expected")
+        | 59: Msg("'MOD' expected")
+        | 60: Msg("'AND' expected")
+        | 61: Msg("'&' expected")
+        | 62: Msg("'NOT' expected")
+        | 63: Msg("'~' expected")
+        | 64: Msg("'{' expected")
+        | 65: Msg("'}' expected")
+        | 66: Msg("not expected")
+        | 67: Msg("invalid MulOp")
+        | 68: Msg("invalid Fact")
+        | 69: Msg("invalid AddOp")
+        | 70: Msg("invalid Rel")
+        | 71: Msg("invalid ByLit")
+        | 72: Msg("invalid SimpleType")
+        | 73: Msg("invalid Type")
+        | 74: Msg("invalid Declaration")
+        | 75: Msg("invalid Import")
         
         (* add customized cases here *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
         | 202: Msg("module name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("not supported in this phase")
         ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
         END;
         WriteLn(lst)

M2cS.mod

@@ -5,7 +5,7 @@ IMPLEMENTATION MODULE M2cS;
 IMPORT FileIO, Storage;
 
 CONST
-  noSYMB  = 7; (*error token code*)
+  noSYMB  = 66; (*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,11 +102,57 @@ PROCEDURE Get (VAR sym: CARDINAL);
   PROCEDURE CheckLiteral;
     BEGIN
       CASE CurrentCh(bp0) OF
-        "B": IF Equal("BEGIN") THEN sym := 4; 
+        "A": IF Equal("AND") THEN sym := 60; 
+             ELSIF Equal("ARRAY") THEN sym := 23; 
              END
-      | "E": IF Equal("END") THEN sym := 5; 
+      | "B": IF Equal("BEGIN") THEN sym := 11; 
+             ELSIF Equal("BY") THEN sym := 43; 
              END
-      | "M": IF Equal("MODULE") THEN sym := 2; 
+      | "C": IF Equal("CASE") THEN sym := 35; 
+             ELSIF Equal("CONST") THEN sym := 13; 
+             END
+      | "D": IF Equal("DIV") THEN sym := 58; 
+             ELSIF Equal("DO") THEN sym := 38; 
+             END
+      | "E": IF Equal("ELSE") THEN sym := 34; 
+             ELSIF Equal("ELSIF") THEN sym := 33; 
+             ELSIF Equal("END") THEN sym := 12; 
+             ELSIF Equal("EXIT") THEN sym := 29; 
+             END
+      | "F": IF Equal("FOR") THEN sym := 42; 
+             ELSIF Equal("FROM") THEN sym := 8; 
+             END
+      | "I": IF Equal("IF") THEN sym := 31; 
+             ELSIF Equal("IMPORT") THEN sym := 9; 
+             ELSIF Equal("IN") THEN sym := 53; 
+             END
+      | "L": IF Equal("LOOP") THEN sym := 41; 
+             END
+      | "M": IF Equal("MOD") THEN sym := 59; 
+             ELSIF Equal("MODULE") THEN sym := 5; 
+             END
+      | "N": IF Equal("NOT") THEN sym := 62; 
+             END
+      | "O": IF Equal("OF") THEN sym := 24; 
+             ELSIF Equal("OR") THEN sym := 55; 
+             END
+      | "P": IF Equal("POINTER") THEN sym := 27; 
+             END
+      | "R": IF Equal("RECORD") THEN sym := 25; 
+             ELSIF Equal("REPEAT") THEN sym := 39; 
+             END
+      | "S": IF Equal("SET") THEN sym := 26; 
+             END
+      | "T": IF Equal("THEN") THEN sym := 32; 
+             ELSIF Equal("TO") THEN sym := 28; 
+             ELSIF Equal("TYPE") THEN sym := 14; 
+             END
+      | "U": IF Equal("UNTIL") THEN sym := 40; 
+             END
+      | "V": IF Equal("VAR") THEN sym := 15; 
+             END
+      | "W": IF Equal("WHILE") THEN sym := 37; 
+             ELSIF Equal("WITH") THEN sym := 45; 
              END
       ELSE
       END
@@ -129,9 +175,89 @@ PROCEDURE Get (VAR sym: CARDINAL);
                (ch >= "a") & (ch <= "z")) THEN 
             ELSE sym := 1; CheckLiteral; RETURN
             END;
-      |  2: sym := 3; RETURN
-      |  3: sym := 6; RETURN
-      |  4: sym := 0; ch := 0C; DEC(bp); RETURN
+      |  2: IF ((ch >= "0") & (ch <= "9") OR
+               (ch >= "A") & (ch <= "F")) THEN 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  3: bp := bp - apx - Long1; DEC(nextLen, ORDL(apx)); NextCh; sym := 2; RETURN
+      |  4: sym := 2; RETURN
+      |  5: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF (ch = "E") THEN state := 6; 
+            ELSE sym := 3; RETURN
+            END;
+      |  6: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSIF ((ch = "+") OR
+                  (ch = "-")) THEN state := 7; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  7: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  8: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSE sym := 3; RETURN
+            END;
+      |  9: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "&") OR
+               (ch >= "(")) THEN 
+            ELSIF (ch = "'") THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 10: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "!") OR
+               (ch >= "#")) THEN 
+            ELSIF (ch = '"') THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 11: sym := 4; RETURN
+      | 12: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF ((ch >= "A") & (ch <= "F")) THEN state := 2; 
+            ELSIF (ch = ".") THEN state := 13; INC(apx) 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := 2; RETURN
+            END;
+      | 13: IF ((ch >= "0") & (ch <= "9")) THEN state := 5; apx := Long0 
+            ELSIF (ch = ".") THEN state := 3; INC(apx) 
+            ELSIF (ch = "E") THEN state := 6; apx := Long0 
+            ELSE sym := 3; RETURN
+            END;
+      | 14: sym := 6; RETURN
+      | 15: IF (ch = ".") THEN state := 20; 
+            ELSE sym := 7; RETURN
+            END;
+      | 16: sym := 10; RETURN
+      | 17: sym := 16; RETURN
+      | 18: IF (ch = "=") THEN state := 24; 
+            ELSE sym := 17; RETURN
+            END;
+      | 19: sym := 18; RETURN
+      | 20: sym := 19; RETURN
+      | 21: sym := 20; RETURN
+      | 22: sym := 21; RETURN
+      | 23: sym := 22; RETURN
+      | 24: sym := 30; RETURN
+      | 25: sym := 36; RETURN
+      | 26: sym := 44; RETURN
+      | 27: sym := 46; RETURN
+      | 28: sym := 47; RETURN
+      | 29: IF (ch = ">") THEN state := 30; 
+            ELSIF (ch = "=") THEN state := 31; 
+            ELSE sym := 49; RETURN
+            END;
+      | 30: sym := 48; RETURN
+      | 31: sym := 50; RETURN
+      | 32: IF (ch = "=") THEN state := 33; 
+            ELSE sym := 51; RETURN
+            END;
+      | 33: sym := 52; RETURN
+      | 34: sym := 54; RETURN
+      | 35: sym := 56; RETURN
+      | 36: sym := 57; RETURN
+      | 37: sym := 61; RETURN
+      | 38: sym := 63; RETURN
+      | 39: sym := 64; RETURN
+      | 40: sym := 65; RETURN
+      | 41: sym := 0; ch := 0C; DEC(bp); RETURN
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       END
     END
@@ -199,69 +325,69 @@ PROCEDURE Reset;
 
 BEGIN
   CurrentCh := CharAt;
-  start[  0] :=  4; start[  1] :=  5; start[  2] :=  5; start[  3] :=  5; 
-  start[  4] :=  5; start[  5] :=  5; start[  6] :=  5; start[  7] :=  5; 
-  start[  8] :=  5; start[  9] :=  5; start[ 10] :=  5; start[ 11] :=  5; 
-  start[ 12] :=  5; start[ 13] :=  5; start[ 14] :=  5; start[ 15] :=  5; 
-  start[ 16] :=  5; start[ 17] :=  5; start[ 18] :=  5; start[ 19] :=  5; 
-  start[ 20] :=  5; start[ 21] :=  5; start[ 22] :=  5; start[ 23] :=  5; 
-  start[ 24] :=  5; start[ 25] :=  5; start[ 26] :=  5; start[ 27] :=  5; 
-  start[ 28] :=  5; start[ 29] :=  5; start[ 30] :=  5; start[ 31] :=  5; 
-  start[ 32] :=  5; start[ 33] :=  5; start[ 34] :=  5; start[ 35] :=  5; 
-  start[ 36] :=  5; start[ 37] :=  5; start[ 38] :=  5; start[ 39] :=  5; 
-  start[ 40] :=  5; start[ 41] :=  5; start[ 42] :=  5; start[ 43] :=  5; 
-  start[ 44] :=  5; start[ 45] :=  5; start[ 46] :=  3; start[ 47] :=  5; 
-  start[ 48] :=  5; start[ 49] :=  5; start[ 50] :=  5; start[ 51] :=  5; 
-  start[ 52] :=  5; start[ 53] :=  5; start[ 54] :=  5; start[ 55] :=  5; 
-  start[ 56] :=  5; start[ 57] :=  5; start[ 58] :=  5; start[ 59] :=  2; 
-  start[ 60] :=  5; start[ 61] :=  5; start[ 62] :=  5; start[ 63] :=  5; 
-  start[ 64] :=  5; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
+  start[  0] := 41; start[  1] := 42; start[  2] := 42; start[  3] := 42; 
+  start[  4] := 42; start[  5] := 42; start[  6] := 42; start[  7] := 42; 
+  start[  8] := 42; start[  9] := 42; start[ 10] := 42; start[ 11] := 42; 
+  start[ 12] := 42; start[ 13] := 42; start[ 14] := 42; start[ 15] := 42; 
+  start[ 16] := 42; start[ 17] := 42; start[ 18] := 42; start[ 19] := 42; 
+  start[ 20] := 42; start[ 21] := 42; start[ 22] := 42; start[ 23] := 42; 
+  start[ 24] := 42; start[ 25] := 42; start[ 26] := 42; start[ 27] := 42; 
+  start[ 28] := 42; start[ 29] := 42; start[ 30] := 42; start[ 31] := 42; 
+  start[ 32] := 42; start[ 33] := 42; start[ 34] := 10; start[ 35] := 28; 
+  start[ 36] := 42; start[ 37] := 42; start[ 38] := 37; start[ 39] :=  9; 
+  start[ 40] := 22; start[ 41] := 23; start[ 42] := 35; start[ 43] := 34; 
+  start[ 44] := 16; start[ 45] := 26; start[ 46] := 15; 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] := 18; start[ 59] := 14; 
+  start[ 60] := 29; start[ 61] := 17; start[ 62] := 32; start[ 63] := 42; 
+  start[ 64] := 42; 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] :=  5; 
-  start[ 92] :=  5; start[ 93] :=  5; start[ 94] :=  5; start[ 95] :=  5; 
-  start[ 96] :=  5; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
+  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] := 19; 
+  start[ 92] := 42; start[ 93] := 21; start[ 94] := 27; start[ 95] := 42; 
+  start[ 96] := 42; 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] :=  5; 
-  start[124] :=  5; start[125] :=  5; start[126] :=  5; start[127] :=  5; 
-  start[128] :=  5; start[129] :=  5; start[130] :=  5; start[131] :=  5; 
-  start[132] :=  5; start[133] :=  5; start[134] :=  5; start[135] :=  5; 
-  start[136] :=  5; start[137] :=  5; start[138] :=  5; start[139] :=  5; 
-  start[140] :=  5; start[141] :=  5; start[142] :=  5; start[143] :=  5; 
-  start[144] :=  5; start[145] :=  5; start[146] :=  5; start[147] :=  5; 
-  start[148] :=  5; start[149] :=  5; start[150] :=  5; start[151] :=  5; 
-  start[152] :=  5; start[153] :=  5; start[154] :=  5; start[155] :=  5; 
-  start[156] :=  5; start[157] :=  5; start[158] :=  5; start[159] :=  5; 
-  start[160] :=  5; start[161] :=  5; start[162] :=  5; start[163] :=  5; 
-  start[164] :=  5; start[165] :=  5; start[166] :=  5; start[167] :=  5; 
-  start[168] :=  5; start[169] :=  5; start[170] :=  5; start[171] :=  5; 
-  start[172] :=  5; start[173] :=  5; start[174] :=  5; start[175] :=  5; 
-  start[176] :=  5; start[177] :=  5; start[178] :=  5; start[179] :=  5; 
-  start[180] :=  5; start[181] :=  5; start[182] :=  5; start[183] :=  5; 
-  start[184] :=  5; start[185] :=  5; start[186] :=  5; start[187] :=  5; 
-  start[188] :=  5; start[189] :=  5; start[190] :=  5; start[191] :=  5; 
-  start[192] :=  5; start[193] :=  5; start[194] :=  5; start[195] :=  5; 
-  start[196] :=  5; start[197] :=  5; start[198] :=  5; start[199] :=  5; 
-  start[200] :=  5; start[201] :=  5; start[202] :=  5; start[203] :=  5; 
-  start[204] :=  5; start[205] :=  5; start[206] :=  5; start[207] :=  5; 
-  start[208] :=  5; start[209] :=  5; start[210] :=  5; start[211] :=  5; 
-  start[212] :=  5; start[213] :=  5; start[214] :=  5; start[215] :=  5; 
-  start[216] :=  5; start[217] :=  5; start[218] :=  5; start[219] :=  5; 
-  start[220] :=  5; start[221] :=  5; start[222] :=  5; start[223] :=  5; 
-  start[224] :=  5; start[225] :=  5; start[226] :=  5; start[227] :=  5; 
-  start[228] :=  5; start[229] :=  5; start[230] :=  5; start[231] :=  5; 
-  start[232] :=  5; start[233] :=  5; start[234] :=  5; start[235] :=  5; 
-  start[236] :=  5; start[237] :=  5; start[238] :=  5; start[239] :=  5; 
-  start[240] :=  5; start[241] :=  5; start[242] :=  5; start[243] :=  5; 
-  start[244] :=  5; start[245] :=  5; start[246] :=  5; start[247] :=  5; 
-  start[248] :=  5; start[249] :=  5; start[250] :=  5; start[251] :=  5; 
-  start[252] :=  5; start[253] :=  5; start[254] :=  5; start[255] :=  5; 
+  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] := 39; 
+  start[124] := 25; start[125] := 40; start[126] := 38; start[127] := 42; 
+  start[128] := 42; start[129] := 42; start[130] := 42; start[131] := 42; 
+  start[132] := 42; start[133] := 42; start[134] := 42; start[135] := 42; 
+  start[136] := 42; start[137] := 42; start[138] := 42; start[139] := 42; 
+  start[140] := 42; start[141] := 42; start[142] := 42; start[143] := 42; 
+  start[144] := 42; start[145] := 42; start[146] := 42; start[147] := 42; 
+  start[148] := 42; start[149] := 42; start[150] := 42; start[151] := 42; 
+  start[152] := 42; start[153] := 42; start[154] := 42; start[155] := 42; 
+  start[156] := 42; start[157] := 42; start[158] := 42; start[159] := 42; 
+  start[160] := 42; start[161] := 42; start[162] := 42; start[163] := 42; 
+  start[164] := 42; start[165] := 42; start[166] := 42; start[167] := 42; 
+  start[168] := 42; start[169] := 42; start[170] := 42; start[171] := 42; 
+  start[172] := 42; start[173] := 42; start[174] := 42; start[175] := 42; 
+  start[176] := 42; start[177] := 42; start[178] := 42; start[179] := 42; 
+  start[180] := 42; start[181] := 42; start[182] := 42; start[183] := 42; 
+  start[184] := 42; start[185] := 42; start[186] := 42; start[187] := 42; 
+  start[188] := 42; start[189] := 42; start[190] := 42; start[191] := 42; 
+  start[192] := 42; start[193] := 42; start[194] := 42; start[195] := 42; 
+  start[196] := 42; start[197] := 42; start[198] := 42; start[199] := 42; 
+  start[200] := 42; start[201] := 42; start[202] := 42; start[203] := 42; 
+  start[204] := 42; start[205] := 42; start[206] := 42; start[207] := 42; 
+  start[208] := 42; start[209] := 42; start[210] := 42; start[211] := 42; 
+  start[212] := 42; start[213] := 42; start[214] := 42; start[215] := 42; 
+  start[216] := 42; start[217] := 42; start[218] := 42; start[219] := 42; 
+  start[220] := 42; start[221] := 42; start[222] := 42; start[223] := 42; 
+  start[224] := 42; start[225] := 42; start[226] := 42; start[227] := 42; 
+  start[228] := 42; start[229] := 42; start[230] := 42; start[231] := 42; 
+  start[232] := 42; start[233] := 42; start[234] := 42; start[235] := 42; 
+  start[236] := 42; start[237] := 42; start[238] := 42; start[239] := 42; 
+  start[240] := 42; start[241] := 42; start[242] := 42; start[243] := 42; 
+  start[244] := 42; start[245] := 42; start[246] := 42; start[247] := 42; 
+  start[248] := 42; start[249] := 42; start[250] := 42; start[251] := 42; 
+  start[252] := 42; start[253] := 42; start[254] := 42; start[255] := 42; 
   Error := Err; lastCh := EOF;
 END M2cS.

MGen.def

@@ -0,0 +1,168 @@
+DEFINITION MODULE MGen;
+(* MC64 image emitter for the M2c scalar subset (see M2c.atg).
+
+   Buffers a single-module MC64 image and writes "<Module>.MCD"
+   (current directory) at EndModule. The image satisfies the
+   reference loader (Loader2): magic "MC64", descriptor with name,
+   TOINIT flag, global sizes (one 8-byte slot per variable), two
+   procedures (0 = user code, 1 = decimal print helper), relative
+   procedure-table cells, and the checksum rule.
+
+   Lowered: scalar globals (INTEGER/CARDINAL/CHAR/BOOLEAN/enums as
+   32-bit ops on slots, REAL as binary64), CONST initializers that
+   are plain literals (emitted as startup stores), full scalar
+   expressions on the stack machine, IF/CASE/WHILE/REPEAT/LOOP+EXIT/
+   FOR via E0/E1 jumps with fixups. Everything else is reported by
+   the parser (error 230); this module only needs structurally
+   valid placeholders for those cases.
+
+   Test convention (no I/O in the language): if the source declares
+     VAR ExitCode : INTEGER;   (int family, VAR kind)
+   the epilogue prints its value as decimal + CRLF through the
+   embedded print procedure; otherwise the program just ends. *)
+
+TYPE
+  LitStr = ARRAY [0 .. 63] OF CHAR;
+  (* Literal text: "42", "-5", "0FFH", "3.14", "'a'", "TRUE". ""
+     means "not a plain literal". *)
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+(* Resets all state; reserves slots 0..3 for the print helper. *)
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR);
+(* Assigns the next global slot to name (any type; one slot). *)
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; lit: LitStr; t: INTEGER);
+(* Assigns a slot and buffers a startup initializer from the literal
+   text (t is a SymTab.TypeIndex). Empty lit buffers a 0. *)
+
+PROCEDURE DeclConstInt (name: ARRAY OF CHAR; v: INTEGER);
+(* Assigns a slot with an INTEGER startup value (enum literals). *)
+
+PROCEDURE BeginBody;
+(* Flushes buffered CONST initializers as startup stores. *)
+
+PROCEDURE EndModule;
+(* Emits the epilogue, the print procedure, the procedure table,
+   the descriptor, the checksum, and writes the .MCD file. *)
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR);
+(* Pushes the global (placeholder push-0 if unknown). *)
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR);
+(* Pops into the global (dropped if unknown). *)
+
+PROCEDURE LoadTemp (t: INTEGER);
+PROCEDURE StoreTemp (t: INTEGER);
+(* Direct slot access for compiler temporaries. *)
+
+PROCEDURE TempGlobal (): INTEGER;
+(* Allocates a fresh hidden global slot, returns its index. *)
+
+PROCEDURE PushInt (v: INTEGER);
+(* Small encodings for 0..15; negatives via 0,mag,sub. *)
+
+PROCEDURE PushBits (b: LONGCARD);
+(* 8E + 8 bytes: CARDINAL values and REAL bit patterns. *)
+
+PROCEDURE ParseInt (s: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
+(* Decimal, H-suffixed hex, optional leading '-'. *)
+
+PROCEDURE ParseCard (s: ARRAY OF CHAR; VAR v: CARDINAL): BOOLEAN;
+(* Decimal or H-suffixed hex (for literals past MAXINT). *)
+
+PROCEDURE ParseReal (s: ARRAY OF CHAR; VAR b: LONGCARD): BOOLEAN;
+(* Decimal with optional fraction/exponent/sign to IEEE bits. *)
+
+PROCEDURE CharOrd (s: ARRAY OF CHAR): INTEGER;
+(* ORD of a 1-character literal such as 'a'. *)
+
+PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: LitStr);
+(* Folds a unary minus into literal text ("5" -> "-5"). *)
+
+PROCEDURE IsLit (s: ARRAY OF CHAR): BOOLEAN;
+(* TRUE for non-empty literal text. *)
+
+(* ---- stack operators (one opcode each, see mc64-spec.md §11) ---- *)
+
+PROCEDURE Add;
+PROCEDURE Sub;
+PROCEDURE MulU;
+PROCEDURE DivU;
+PROCEDURE ModU;
+PROCEDURE MulI;
+PROCEDURE DivI;
+PROCEDURE ModI (t: INTEGER);
+(* Signed a MOD b with truncation semantics via temp slot t:
+   a - (a DIV b) * b. Caller passes TempGlobal(). *)
+
+PROCEDURE RealAdd;
+PROCEDURE RealSub;
+PROCEDURE RealMul;
+PROCEDURE RealDiv;
+
+PROCEDURE And;
+PROCEDURE Or;
+PROCEDURE Not;
+
+PROCEDURE Power2;
+(* Push (1 << pop) for set element masks. *)
+PROCEDURE FieldMask;
+(* (1<<hi)-(1<<lo) for set ranges. *)
+PROCEDURE BitIn;
+(* Push (pop in bitset(pop)). *)
+
+PROCEDURE Eq;
+PROCEDURE Neq;
+PROCEDURE ULt;
+PROCEDURE ULe;
+PROCEDURE UGt;
+PROCEDURE UGe;
+PROCEDURE ILt;
+PROCEDURE ILe;
+PROCEDURE IGt;
+PROCEDURE IGe;
+
+PROCEDURE RealEq;
+PROCEDURE RealNe;
+PROCEDURE RealLt;
+PROCEDURE RealLe;
+PROCEDURE RealGt;
+PROCEDURE RealGe;
+
+PROCEDURE NegInt;
+PROCEDURE NegReal;
+PROCEDURE IntToReal;
+(* BD int_to_long + BE long_to_real. *)
+
+PROCEDURE Dup;
+PROCEDURE Drop;
+
+(* ---- control flow (E0/E1 with fixups) ---- *)
+
+PROCEDURE NewLabel (): INTEGER;
+PROCEDURE DefLabel (id: INTEGER);
+PROCEDURE Jmp (id: INTEGER);
+PROCEDURE Jz (id: INTEGER);
+(* Jump if false (pops the condition). *)
+
+PROCEDURE PushLoop (exit: INTEGER);
+PROCEDURE PopLoop;
+PROCEDURE TopLoop (VAR exit: INTEGER): BOOLEAN;
+(* Innermost LOOP exit label; FALSE outside any LOOP. *)
+
+PROCEDURE NoSupEnter;
+PROCEDURE NoSupExit;
+PROCEDURE CopyName (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+(* Copies zero-terminated strings between any char arrays. *)
+
+PROCEDURE NoEmitEnter;
+PROCEDURE NoEmitExit;
+(* Suppresses code emission (not literal capture) in declarative
+   contexts such as CONST initializers and subrange bounds. *)
+
+PROCEDURE NoSup (): BOOLEAN;
+(* Guard depth for unsupported constructs: while > 0 the grammar
+   suppresses follow-on 230 errors to avoid cascades. *)
+
+END MGen.

MGen.mod

@@ -0,0 +1,835 @@
+IMPLEMENTATION MODULE MGen;
+
+IMPORT FileIO, SymTab;
+
+CONST
+  MaxCode = 8191;
+  MaxImg  = 16383;
+  MaxGlb  = 255;
+  MaxInit = 255;
+  MaxLab  = 255;
+  MaxFix  = 2047;
+  MaxLoop = 15;
+
+  (* opcodes, see mc64-spec.md §11 *)
+  OPdup = 20H;  OPswap = 21H;
+  OPloadGlb = 2DH;  OPstoreGlb = 3DH;
+  OPext = 40H;  SUBdrop = 00H;
+  OPenter = 0D4H;  OPfctLeave = 85H;  OPprocCall = 0EDH;
+  OPimmB = 8DH;  OPimmW = 8EH;  OPimm0 = 90H;
+  OPadd = 0A6H;  OPsub = 0A7H;  OPumul = 0A8H;
+  OPudiv = 0A9H;  OPumod = 0AAH;
+  OPaeq0 = 0ABH;  OPinc = 0ACH;  OPdec = 0ADH;
+  OPeq = 0A0H;  OPne = 0A1H;
+  OPult = 0A2H;  OPugt = 0A3H;  OPule = 0A4H;  OPuge = 0A5H;
+  OPilt = 0B2H;  OPigt = 0B3H;  OPile = 0B4H;  OPige = 0B5H;
+  OPnot = 0B6H;
+  OPimul = 0B8H;  OPidiv = 0B9H;
+  OPintToLong = 0BDH;  OPlongToReal = 0BEH;
+  OPrCmp = 0D5H;  OPrAdd = 0D6H;  OPrSub = 0D7H;
+  OPrMul = 0D8H;  OPrDiv = 0D9H;
+  OPor = 0E6H;  OPand = 0E8H;
+  OPpower2 = 0EAH;  OPbitIn = 0E7H;
+  OPjp = 0E0H;  OPjz = 0E1H;
+  OPsys = 0C3H;  OPend = 50H;
+
+  (* image layout *)
+  HeadSize = 64;
+  DName = 264;  DChecksum = 288;  DFlags = 292;
+  DVarCount = 293;  DDepCount = 294;  DProcs = 296;
+  DVarSizes = 304;
+
+TYPE
+  FixRec = RECORD
+    pos : CARDINAL;
+    lab : INTEGER;
+  END;
+  InitRec = RECORD
+    idx  : CARDINAL;
+    kind : INTEGER;  (* 0 = INTEGER value, 1 = raw 64-bit pattern *)
+    ival : INTEGER;
+    bits : LONGCARD;
+  END;
+  RealView = RECORD CASE : BOOLEAN OF
+               | TRUE : r : REAL;
+               | FALSE : w : LONGCARD;
+             END;
+           END;
+
+VAR
+  code : ARRAY [0 .. MaxCode] OF CHAR;
+  nCode : CARDINAL;
+  img : ARRAY [0 .. MaxImg] OF CHAR;
+  modName : ARRAY [0 .. 63] OF CHAR;
+  gNames : ARRAY [0 .. MaxGlb] OF ARRAY [0 .. 63] OF CHAR;
+  nGlb : CARDINAL;
+  inits : ARRAY [0 .. MaxInit] OF InitRec;
+  nInit : CARDINAL;
+  inBody : BOOLEAN;
+  labs : ARRAY [0 .. MaxLab] OF INTEGER;
+  nLab : CARDINAL;
+  fixs : ARRAY [0 .. MaxFix] OF FixRec;
+  nFix : CARDINAL;
+  loopSt : ARRAY [0 .. MaxLoop] OF INTEGER;
+  loopTop : CARDINAL;
+  noSup : CARDINAL;
+  noEmit : CARDINAL;
+
+(* ---------------- byte helpers ---------------- *)
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
+    RETURN i
+  END StrLen;
+
+PROCEDURE StrCpy (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
+      d[i] := s[i]; INC(i)
+    END;
+    IF i <= HIGH(d) THEN d[i] := 0C END
+  END StrCpy;
+
+PROCEDURE EmitByte (b: CARDINAL);
+  BEGIN
+    IF noEmit > 0 THEN RETURN END;
+    IF nCode <= MaxCode THEN
+      code[nCode] := CHR(b MOD 256); INC(nCode)
+    END
+  END EmitByte;
+
+PROCEDURE EmitOp (o: CARDINAL);
+  BEGIN
+    EmitByte(o)
+  END EmitOp;
+
+PROCEDURE EmitOpB (o, b: CARDINAL);
+  BEGIN
+    EmitByte(o); EmitByte(b)
+  END EmitOpB;
+
+PROCEDURE EmitW64 (v: LONGCARD);
+  VAR j : CARDINAL;
+  BEGIN
+    FOR j := 0 TO 7 DO
+      EmitByte(VAL(CARDINAL, v MOD 256)); v := v DIV 256
+    END
+  END EmitW64;
+
+PROCEDURE EmitS64 (rel: INTEGER);
+(* Appends a signed 64-bit little-endian offset. *)
+  VAR mag : CARDINAL;
+  BEGIN
+    IF rel >= 0 THEN EmitW64(VAL(LONGCARD, VAL(CARDINAL, rel)))
+    ELSE
+      IF rel = -2147483647 - 1 THEN mag := 80000000H
+      ELSE mag := VAL(CARDINAL, -rel)
+      END;
+      EmitW64(0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H)
+    END
+  END EmitS64;
+
+PROCEDURE WriteS64At (off: CARDINAL; rel: INTEGER);
+(* Backpatches a signed offset into already-emitted code. *)
+  VAR mag : CARDINAL;
+    bits : LONGCARD;
+    j : CARDINAL;
+  BEGIN
+    IF rel >= 0 THEN bits := VAL(LONGCARD, VAL(CARDINAL, rel))
+    ELSE
+      IF rel = -2147483647 - 1 THEN mag := 80000000H
+      ELSE mag := VAL(CARDINAL, -rel)
+      END;
+      bits := 0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H
+    END;
+    FOR j := 0 TO 7 DO
+      code[off + j] := CHR(VAL(CARDINAL, bits MOD 256));
+      bits := bits DIV 256
+    END
+  END WriteS64At;
+
+PROCEDURE FindVar (name: ARRAY OF CHAR): INTEGER;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nGlb DO
+      IF SymTab.Equal(gNames[i], name) THEN RETURN VAL(INTEGER, i) END;
+      INC(i)
+    END;
+    RETURN -1
+  END FindVar;
+
+PROCEDURE AssignSlot (name: ARRAY OF CHAR): INTEGER;
+  BEGIN
+    IF nGlb > MaxGlb THEN RETURN -1 END;
+    StrCpy(gNames[nGlb], name);
+    INC(nGlb);
+    RETURN VAL(INTEGER, nGlb - 1)
+  END AssignSlot;
+
+(* ---------------- module / data section ---------------- *)
+
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+    dummy : INTEGER;
+  BEGIN
+    StrCpy(modName, name);
+    nCode := 0; nGlb := 0; nInit := 0;
+    nLab := 0; nFix := 0; loopTop := 0; noSup := 0; noEmit := 0;
+    inBody := FALSE;
+    i := 0;
+    WHILE i <= MaxGlb DO gNames[i][0] := 0C; INC(i) END;
+    (* slots 0..3 belong to the print helper *)
+    dummy := AssignSlot(""); dummy := AssignSlot("");
+    dummy := AssignSlot(""); dummy := AssignSlot("")
+  END OpenModule;
+
+PROCEDURE DeclVar (name: ARRAY OF CHAR);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := AssignSlot(name);
+    IF idx < 0 THEN RETURN END
+  END DeclVar;
+
+PROCEDURE BufInit (idx: INTEGER; kind: INTEGER; ival: INTEGER;
+                   bits: LONGCARD);
+  BEGIN
+    IF nInit > MaxInit THEN RETURN END;
+    inits[nInit].idx := VAL(CARDINAL, idx);
+    inits[nInit].kind := kind;
+    inits[nInit].ival := ival;
+    inits[nInit].bits := bits;
+    INC(nInit)
+  END BufInit;
+
+PROCEDURE DeclConst (name: ARRAY OF CHAR; lit: LitStr; t: INTEGER);
+  VAR idx : INTEGER;
+    cls : INTEGER;
+    v : INTEGER;
+    c : CARDINAL;
+    b : LONGCARD;
+  BEGIN
+    idx := AssignSlot(name);
+    IF idx < 0 THEN RETURN END;
+    cls := SymTab.ClassOf(t);
+    IF ~IsLit(lit) OR (cls = SymTab.ClStr) THEN
+      BufInit(idx, 0, 0, 0H); RETURN
+    END;
+    IF cls = SymTab.ClReal THEN
+      IF ParseReal(lit, b) THEN BufInit(idx, 1, 0, b)
+      ELSE BufInit(idx, 1, 0, 0H)
+      END
+    ELSIF SymTab.Equal(lit, "TRUE") THEN BufInit(idx, 0, 1, 0H)
+    ELSIF SymTab.Equal(lit, "FALSE") THEN BufInit(idx, 0, 0, 0H)
+    ELSIF ParseInt(lit, v) THEN BufInit(idx, 0, v, 0H)
+    ELSIF ParseCard(lit, c) THEN
+      BufInit(idx, 1, 0, VAL(LONGCARD, c))
+    ELSE BufInit(idx, 0, 0, 0H)
+    END
+  END DeclConst;
+
+PROCEDURE DeclConstInt (name: ARRAY OF CHAR; v: INTEGER);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := AssignSlot(name);
+    IF idx < 0 THEN RETURN END;
+    BufInit(idx, 0, v, 0H)
+  END DeclConstInt;
+
+PROCEDURE PushValue (kind: INTEGER; ival: INTEGER; bits: LONGCARD);
+  BEGIN
+    IF kind = 0 THEN PushInt(ival) ELSE PushBits(bits) END
+  END PushValue;
+
+PROCEDURE BeginBody;
+  VAR i : CARDINAL;
+  BEGIN
+    IF inBody THEN RETURN END;
+    inBody := TRUE;
+    i := 0;
+    WHILE i < nInit DO
+      PushValue(inits[i].kind, inits[i].ival, inits[i].bits);
+      EmitOpB(OPstoreGlb, inits[i].idx);
+      INC(i)
+    END
+  END BeginBody;
+
+(* ---------------- loads, stores, pushes ---------------- *)
+
+PROCEDURE LoadVar (name: ARRAY OF CHAR);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := FindVar(name);
+    IF idx < 0 THEN EmitOp(OPimm0)
+    ELSE EmitOpB(OPloadGlb, VAL(CARDINAL, idx))
+    END
+  END LoadVar;
+
+PROCEDURE StoreVar (name: ARRAY OF CHAR);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := FindVar(name);
+    IF idx < 0 THEN EmitOp(OPext); EmitOp(SUBdrop)
+    ELSE EmitOpB(OPstoreGlb, VAL(CARDINAL, idx))
+    END
+  END StoreVar;
+
+PROCEDURE LoadTemp (t: INTEGER);
+  BEGIN
+    EmitOpB(OPloadGlb, VAL(CARDINAL, t))
+  END LoadTemp;
+
+PROCEDURE StoreTemp (t: INTEGER);
+  BEGIN
+    EmitOpB(OPstoreGlb, VAL(CARDINAL, t))
+  END StoreTemp;
+
+PROCEDURE TempGlobal (): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := AssignSlot("");
+    IF idx < 0 THEN RETURN 4 END;
+    RETURN idx
+  END TempGlobal;
+
+PROCEDURE EmitMag (c: CARDINAL);
+  BEGIN
+    IF c <= 255 THEN EmitOpB(OPimmB, c)
+    ELSE EmitOp(OPimmW); EmitW64(VAL(LONGCARD, c))
+    END
+  END EmitMag;
+
+PROCEDURE PushInt (v: INTEGER);
+  VAR mag : CARDINAL;
+  BEGIN
+    IF (v >= 0) & (v <= 15) THEN EmitOp(OPimm0 + VAL(CARDINAL, v))
+    ELSIF v < 0 THEN
+      IF v = -2147483647 - 1 THEN mag := 80000000H
+      ELSE mag := VAL(CARDINAL, -v)
+      END;
+      EmitOp(OPimm0); EmitMag(mag); EmitOp(OPsub)
+    ELSE EmitMag(VAL(CARDINAL, v))
+    END
+  END PushInt;
+
+PROCEDURE PushBits (b: LONGCARD);
+  BEGIN
+    EmitOp(OPimmW); EmitW64(b)
+  END PushBits;
+
+(* ---------------- literal parsing ---------------- *)
+
+PROCEDURE DigVal (ch: CHAR): INTEGER;
+  BEGIN
+    IF (ch >= "0") & (ch <= "9") THEN RETURN ORD(ch) - ORD("0") END;
+    IF (ch >= "A") & (ch <= "F") THEN RETURN ORD(ch) - ORD("A") + 10 END;
+    IF (ch >= "a") & (ch <= "f") THEN RETURN ORD(ch) - ORD("a") + 10 END;
+    RETURN -1
+  END DigVal;
+
+PROCEDURE ParseCard (s: ARRAY OF CHAR; VAR v: CARDINAL): BOOLEAN;
+  VAR i, n : CARDINAL;
+    hex : BOOLEAN;
+    d : INTEGER;
+    acc : LONGCARD;
+  BEGIN
+    v := 0;
+    n := StrLen(s);
+    IF n = 0 THEN RETURN FALSE END;
+    hex := (s[n - 1] = "H") OR (s[n - 1] = "h");
+    IF hex THEN DEC(n) END;
+    IF n = 0 THEN RETURN FALSE END;
+    acc := 0H; i := 0;
+    WHILE i < n DO
+      d := DigVal(s[i]);
+      IF hex THEN
+        IF d < 0 THEN RETURN FALSE END;
+        acc := acc * 16 + VAL(LONGCARD, VAL(CARDINAL, d))
+      ELSE
+        IF (d < 0) OR (d > 9) THEN RETURN FALSE END;
+        acc := acc * 10 + VAL(LONGCARD, VAL(CARDINAL, d))
+      END;
+      IF acc > 0FFFFFFFFH THEN RETURN FALSE END;
+      INC(i)
+    END;
+    v := VAL(CARDINAL, acc);
+    RETURN TRUE
+  END ParseCard;
+
+PROCEDURE ParseInt (s: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
+  VAR i : CARDINAL;
+    neg : BOOLEAN;
+    t : ARRAY [0 .. 63] OF CHAR;
+    c : CARDINAL;
+    lim : LONGCARD;
+  BEGIN
+    v := 0;
+    IF (StrLen(s) = 0) THEN RETURN FALSE END;
+    neg := s[0] = "-";
+    IF neg THEN
+      i := 1;
+      WHILE s[i] # 0C DO
+        IF i - 1 > HIGH(t) THEN RETURN FALSE END;
+        t[i - 1] := s[i]; INC(i)
+      END;
+      IF i - 1 > HIGH(t) THEN RETURN FALSE END;
+      t[i - 1] := 0C
+    ELSE StrCpy(t, s)
+    END;
+    IF ~ParseCard(t, c) THEN RETURN FALSE END;
+    IF neg THEN lim := 80000000H ELSE lim := 7FFFFFFFH END;
+    IF VAL(LONGCARD, c) > lim THEN RETURN FALSE END;
+    IF neg THEN
+      IF VAL(LONGCARD, c) = 80000000H THEN v := -2147483647 - 1
+      ELSE v := -VAL(INTEGER, c)
+      END
+    ELSE v := VAL(INTEGER, c)
+    END;
+    RETURN TRUE
+  END ParseInt;
+
+PROCEDURE ParseReal (s: ARRAY OF CHAR; VAR b: LONGCARD): BOOLEAN;
+  VAR i : CARDINAL;
+    neg, esign : BOOLEAN;
+    m, scale : REAL;
+    e, d : CARDINAL;
+    rv : RealView;
+  BEGIN
+    b := 0H;
+    i := 0; neg := FALSE;
+    IF s[0] = "-" THEN neg := TRUE; INC(i) END;
+    IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
+    m := 0.0;
+    WHILE (s[i] >= "0") & (s[i] <= "9") DO
+      m := m * 10.0 + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0")));
+      INC(i)
+    END;
+    IF s[i] = "." THEN
+      INC(i);
+      IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
+      scale := 10.0;
+      WHILE (s[i] >= "0") & (s[i] <= "9") DO
+        m := m + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0"))) / scale;
+        scale := scale * 10.0;
+        INC(i)
+      END
+    END;
+    IF (s[i] = "E") OR (s[i] = "e") THEN
+      INC(i); esign := FALSE;
+      IF s[i] = "+" THEN INC(i)
+      ELSIF s[i] = "-" THEN esign := TRUE; INC(i)
+      END;
+      IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
+      e := 0;
+      WHILE (s[i] >= "0") & (s[i] <= "9") DO
+        d := VAL(CARDINAL, ORD(s[i]) - ORD("0"));
+        IF e <= 9999 THEN e := e * 10 + d END;
+        INC(i)
+      END;
+      WHILE e > 0 DO
+        IF esign THEN m := m / 10.0 ELSE m := m * 10.0 END;
+        DEC(e)
+      END
+    END;
+    IF s[i] # 0C THEN RETURN FALSE END;
+    IF neg THEN m := -m END;
+    rv.r := m;
+    b := rv.w;
+    RETURN TRUE
+  END ParseReal;
+
+PROCEDURE CharOrd (s: ARRAY OF CHAR): INTEGER;
+  BEGIN
+    IF StrLen(s) >= 2 THEN RETURN ORD(s[1]) END;
+    RETURN 0
+  END CharOrd;
+
+PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: LitStr);
+(* Safe for a and q being the same variable. *)
+  VAR tmp : LitStr;
+    i, j : CARDINAL;
+  BEGIN
+    StrCpy(tmp, a);
+    IF StrLen(tmp) = 0 THEN StrCpy(q, ""); RETURN END;
+    IF tmp[0] = "-" THEN
+      i := 1; j := 0;
+      WHILE (tmp[i] # 0C) & (j < HIGH(q)) DO
+        q[j] := tmp[i]; INC(i); INC(j)
+      END;
+      IF j <= HIGH(q) THEN q[j] := 0C END
+    ELSE
+      StrCpy(q, "-");
+      i := 0; j := StrLen(q);
+      WHILE (tmp[i] # 0C) & (j < HIGH(q)) DO
+        q[j] := tmp[i]; INC(i); INC(j)
+      END;
+      IF j <= HIGH(q) THEN q[j] := 0C END
+    END
+  END NegFold;
+
+PROCEDURE IsLit (s: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN StrLen(s) > 0
+  END IsLit;
+
+(* ---------------- operators ---------------- *)
+
+PROCEDURE Add;
+  BEGIN EmitOp(OPadd) END Add;
+PROCEDURE Sub;
+  BEGIN EmitOp(OPsub) END Sub;
+PROCEDURE MulU;
+  BEGIN EmitOp(OPumul) END MulU;
+PROCEDURE DivU;
+  BEGIN EmitOp(OPudiv) END DivU;
+PROCEDURE ModU;
+  BEGIN EmitOp(OPumod) END ModU;
+PROCEDURE MulI;
+  BEGIN EmitOp(OPimul) END MulI;
+PROCEDURE DivI;
+  BEGIN EmitOp(OPidiv) END DivI;
+PROCEDURE ModI (t: INTEGER);
+(* [a b] -> a MOD b (truncation) via temp t. *)
+  BEGIN
+    StoreTemp(t);
+    EmitOp(OPdup);
+    LoadTemp(t);
+    EmitOp(OPidiv);
+    LoadTemp(t);
+    EmitOp(OPimul);
+    EmitOp(OPsub)
+  END ModI;
+
+PROCEDURE RealAdd;
+  BEGIN EmitOp(OPrAdd) END RealAdd;
+PROCEDURE RealSub;
+  BEGIN EmitOp(OPrSub) END RealSub;
+PROCEDURE RealMul;
+  BEGIN EmitOp(OPrMul) END RealMul;
+PROCEDURE RealDiv;
+  BEGIN EmitOp(OPrDiv) END RealDiv;
+
+PROCEDURE And;
+  BEGIN EmitOp(OPand) END And;
+PROCEDURE Or;
+  BEGIN EmitOp(OPor) END Or;
+PROCEDURE Not;
+  BEGIN EmitOp(OPnot) END Not;
+
+PROCEDURE Power2;
+  BEGIN EmitOp(OPpower2) END Power2;
+
+PROCEDURE FieldMask;
+  BEGIN EmitOp(OPext); EmitOp(04H) END FieldMask;
+
+PROCEDURE BitIn;
+  BEGIN EmitOp(OPbitIn) END BitIn;
+
+PROCEDURE Eq;
+  BEGIN EmitOp(OPeq) END Eq;
+PROCEDURE Neq;
+  BEGIN EmitOp(OPne) END Neq;
+PROCEDURE ULt;
+  BEGIN EmitOp(OPult) END ULt;
+PROCEDURE ULe;
+  BEGIN EmitOp(OPule) END ULe;
+PROCEDURE UGt;
+  BEGIN EmitOp(OPugt) END UGt;
+PROCEDURE UGe;
+  BEGIN EmitOp(OPuge) END UGe;
+PROCEDURE ILt;
+  BEGIN EmitOp(OPilt) END ILt;
+PROCEDURE ILe;
+  BEGIN EmitOp(OPile) END ILe;
+PROCEDURE IGt;
+  BEGIN EmitOp(OPigt) END IGt;
+PROCEDURE IGe;
+  BEGIN EmitOp(OPige) END IGe;
+
+PROCEDURE RealEq;
+(* [r1 r2] -> (r1 = r2): cmp, or, not. *)
+  BEGIN EmitOp(OPrCmp); EmitOp(OPor); EmitOp(OPnot) END RealEq;
+PROCEDURE RealNe;
+(* [r1 r2] -> (r1 # r2): cmp, or. *)
+  BEGIN EmitOp(OPrCmp); EmitOp(OPor) END RealNe;
+PROCEDURE RealLt;
+(* [gt lt] -> lt: swap, drop. *)
+  BEGIN EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop) END RealLt;
+PROCEDURE RealLe;
+(* [gt lt] -> NOT gt: drop, not. *)
+  BEGIN EmitOp(OPext); EmitOp(SUBdrop); EmitOp(OPnot) END RealLe;
+PROCEDURE RealGt;
+(* [gt lt] -> gt: drop. *)
+  BEGIN EmitOp(OPext); EmitOp(SUBdrop) END RealGt;
+PROCEDURE RealGe;
+(* [gt lt] -> NOT lt: swap, drop, not. *)
+  BEGIN
+    EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop); EmitOp(OPnot)
+  END RealGe;
+
+PROCEDURE NegInt;
+  BEGIN EmitOp(OPimm0); EmitOp(OPswap); EmitOp(OPsub) END NegInt;
+PROCEDURE NegReal;
+  BEGIN
+    EmitOp(OPimmW); EmitW64(0H);
+    EmitOp(OPswap); EmitOp(OPrSub)
+  END NegReal;
+PROCEDURE IntToReal;
+  BEGIN EmitOp(OPintToLong); EmitOp(OPlongToReal) END IntToReal;
+
+PROCEDURE Dup;
+  BEGIN EmitOp(OPdup) END Dup;
+PROCEDURE Drop;
+  BEGIN EmitOp(OPext); EmitOp(SUBdrop) END Drop;
+
+(* ---------------- control flow ---------------- *)
+
+PROCEDURE NewLabel (): INTEGER;
+  BEGIN
+    IF nLab > MaxLab THEN RETURN 0 END;
+    labs[nLab] := -1;
+    INC(nLab);
+    RETURN VAL(INTEGER, nLab - 1)
+  END NewLabel;
+
+PROCEDURE DefLabel (id: INTEGER);
+  VAR i : CARDINAL;
+    rel : INTEGER;
+  BEGIN
+    IF (id < 0) OR (id >= VAL(INTEGER, nLab)) THEN RETURN END;
+    labs[id] := VAL(INTEGER, nCode);
+    i := 0;
+    WHILE i < nFix DO
+      IF fixs[i].lab = id THEN
+        rel := labs[id] - VAL(INTEGER, fixs[i].pos + 9);
+        WriteS64At(fixs[i].pos + 1, rel);
+        fixs[i].lab := -1
+      END;
+      INC(i)
+    END
+  END DefLabel;
+
+PROCEDURE Jump (op: CARDINAL; id: INTEGER);
+  VAR pos : CARDINAL;
+    j : CARDINAL;
+  BEGIN
+    pos := nCode;
+    EmitOp(op);
+    IF (id >= 0) & (id < VAL(INTEGER, nLab)) & (labs[id] >= 0) THEN
+      EmitS64(labs[id] - VAL(INTEGER, pos + 9))
+    ELSE
+      FOR j := 0 TO 7 DO EmitByte(0) END;
+      IF (nFix <= MaxFix) & (id >= 0) & (id < VAL(INTEGER, nLab)) THEN
+        fixs[nFix].pos := pos; fixs[nFix].lab := id; INC(nFix)
+      END
+    END
+  END Jump;
+
+PROCEDURE Jmp (id: INTEGER);
+  BEGIN
+    Jump(OPjp, id)
+  END Jmp;
+
+PROCEDURE Jz (id: INTEGER);
+  BEGIN
+    Jump(OPjz, id)
+  END Jz;
+
+PROCEDURE PushLoop (exit: INTEGER);
+  BEGIN
+    IF loopTop <= MaxLoop THEN
+      loopSt[loopTop] := exit; INC(loopTop)
+    END
+  END PushLoop;
+
+PROCEDURE PopLoop;
+  BEGIN
+    IF loopTop > 0 THEN DEC(loopTop) END
+  END PopLoop;
+
+PROCEDURE TopLoop (VAR exit: INTEGER): BOOLEAN;
+  BEGIN
+    IF loopTop = 0 THEN RETURN FALSE END;
+    exit := loopSt[loopTop - 1];
+    RETURN TRUE
+  END TopLoop;
+
+PROCEDURE NoSupEnter;
+  BEGIN
+    INC(noSup)
+  END NoSupEnter;
+
+PROCEDURE NoSupExit;
+  BEGIN
+    IF noSup > 0 THEN DEC(noSup) END
+  END NoSupExit;
+
+PROCEDURE NoSup (): BOOLEAN;
+  BEGIN
+    RETURN noSup > 0
+  END NoSup;
+
+PROCEDURE CopyName (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
+      d[i] := s[i]; INC(i)
+    END;
+    IF i <= HIGH(d) THEN d[i] := 0C END
+  END CopyName;
+
+PROCEDURE NoEmitEnter;
+  BEGIN
+    INC(noEmit)
+  END NoEmitEnter;
+
+PROCEDURE NoEmitExit;
+  BEGIN
+    IF noEmit > 0 THEN DEC(noEmit) END
+  END NoEmitExit;
+
+(* ---------------- image assembly ---------------- *)
+
+PROCEDURE Put32At (off: CARDINAL; v: CARDINAL);
+  BEGIN
+    img[off] := CHR(v MOD 256);
+    img[off + 1] := CHR((v DIV 256) MOD 256);
+    img[off + 2] := CHR((v DIV 65536) MOD 256);
+    img[off + 3] := CHR(v DIV 16777216)
+  END Put32At;
+
+PROCEDURE Put64At (off: CARDINAL; v: LONGCARD);
+  VAR j : CARDINAL;
+  BEGIN
+    FOR j := 0 TO 7 DO
+      img[off + j] := CHR(VAL(CARDINAL, v MOD 256));
+      v := v DIV 256
+    END
+  END Put64At;
+
+PROCEDURE EmitPrint;
+(* proc1: prints the CARDINAL parameter as decimal + CRLF.
+   Uses global temps 0..3 (buffer, count, index, char). *)
+  VAR l1, l2 : INTEGER;
+  BEGIN
+    EmitOpB(OPenter, 250);
+    EmitOpB(OPimmB, 16); EmitOp(0D2H); EmitOpB(OPstoreGlb, 0);
+    EmitOp(OPimm0); EmitOp(OPimm0);
+    EmitOpB(OPstoreGlb, 1); EmitOpB(OPstoreGlb, 2);
+    EmitOp(03H);
+    l1 := NewLabel(); DefLabel(l1);
+    EmitOpB(OPloadGlb, 1); EmitOp(OPinc); EmitOpB(OPstoreGlb, 1);
+    EmitOp(OPdup); EmitOpB(OPimmB, 10); EmitOp(OPumod);
+    EmitOp(OPswap); EmitOpB(OPimmB, 10); EmitOp(OPudiv);
+    EmitOp(OPdup); EmitOp(OPaeq0);
+    Jz(l1);
+    EmitOp(OPext); EmitOp(SUBdrop);
+    l2 := NewLabel(); DefLabel(l2);
+    EmitOpB(OPimmB, 48); EmitOp(OPadd); EmitOpB(OPstoreGlb, 3);
+    EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
+    EmitOp(OPimm0); EmitOpB(OPloadGlb, 3); EmitOp(1DH);
+    EmitOpB(OPloadGlb, 2); EmitOp(OPinc); EmitOpB(OPstoreGlb, 2);
+    EmitOpB(OPloadGlb, 1); EmitOp(OPdec); EmitOpB(OPstoreGlb, 1);
+    EmitOpB(OPloadGlb, 1); EmitOp(OPaeq0);
+    Jz(l2);
+    EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
+    EmitOp(OPimm0); EmitOp(OPimm0); EmitOp(1DH);
+    EmitOpB(OPloadGlb, 0);
+    EmitOpB(OPimmB, 1); EmitOp(OPsys);
+    EmitOpB(OPimmB, 3); EmitOp(0D2H);
+    EmitOp(OPdup); EmitOp(OPimm0); EmitOpB(OPimmB, 13); EmitOp(1DH);
+    EmitOp(OPdup); EmitOpB(OPimmB, 1); EmitOpB(OPimmB, 10); EmitOp(1DH);
+    EmitOp(OPdup); EmitOpB(OPimmB, 2); EmitOp(OPimm0); EmitOp(1DH);
+    EmitOpB(OPimmB, 1); EmitOp(OPsys);
+    EmitOpB(OPfctLeave, 0)
+  END EmitPrint;
+
+PROCEDURE EndModule;
+  VAR i : CARDINAL;
+    codeOff, p1, pt : CARDINAL;
+    exitIdx : INTEGER;
+    sum : CARDINAL;
+    fname : ARRAY [0 .. 127] OF CHAR;
+    f : FileIO.File;
+    ch : CHAR;
+  BEGIN
+    (* epilogue: print ExitCode when the convention applies *)
+    exitIdx := -1;
+    IF SymTab.Lookup("ExitCode")
+       & (SymTab.SymKind("ExitCode") = SymTab.KindVar)
+       & SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
+      exitIdx := FindVar("ExitCode")
+    END;
+    IF exitIdx >= 0 THEN
+      EmitOpB(OPloadGlb, VAL(CARDINAL, exitIdx));
+      EmitOpB(OPprocCall, 1);
+      EmitOp(OPext); EmitOp(SUBdrop)
+    END;
+    EmitOp(OPend);
+    p1 := nCode;
+    EmitPrint;
+    (* assemble the image *)
+    i := 0;
+    WHILE i <= MaxImg DO img[i] := 0C; INC(i) END;
+    img[0] := "M"; img[1] := "C"; img[2] := "6"; img[3] := "4";
+    i := 0;
+    WHILE (i < 16) & (modName[i] # 0C) DO
+      img[HeadSize + DName + i] := modName[i]; INC(i)
+    END;
+    img[HeadSize + DFlags] := CHR(4);
+    img[HeadSize + DVarCount] := CHR(nGlb MOD 256);
+    img[HeadSize + DDepCount] := 0C;
+    codeOff := DVarSizes + nGlb * 8;
+    i := 0;
+    WHILE i < nCode DO
+      img[HeadSize + codeOff + i] := code[i]; INC(i)
+    END;
+    pt := codeOff + nCode;
+    Put64At(HeadSize + DProcs, VAL(LONGCARD, pt));
+    Put64At(HeadSize + pt,
+      VAL(LONGCARD, codeOff) - VAL(LONGCARD, pt));
+    Put64At(HeadSize + pt + 8,
+      VAL(LONGCARD, codeOff + p1) - VAL(LONGCARD, pt + 8));
+    i := 0;
+    WHILE i < nGlb DO
+      Put64At(HeadSize + DVarSizes + i * 8, 8H);
+      INC(i)
+    END;
+    sum := 0;
+    i := HeadSize;
+    WHILE i < HeadSize + pt + 16 DO
+      IF ~((i >= 352) & (i <= 355)) THEN
+        sum := sum + ORD(img[i])
+      END;
+      INC(i)
+    END;
+    Put32At(HeadSize + DChecksum, sum);
+    fname[0] := 0C;
+    StrCpy(fname, modName);
+    i := StrLen(fname);
+    fname[i] := "."; fname[i + 1] := "M"; fname[i + 2] := "C";
+    fname[i + 3] := "D"; fname[i + 4] := 0C;
+    FileIO.Open(f, fname, TRUE);
+    IF FileIO.Okay THEN
+      i := 0;
+      WHILE i < HeadSize + pt + 16 DO
+        ch := img[i];
+        FileIO.Write(f, ch);
+        INC(i)
+      END;
+      FileIO.Close(f)
+    END
+  END EndModule;
+
+BEGIN
+  nCode := 0; nGlb := 0; nInit := 0;
+  nLab := 0; nFix := 0; loopTop := 0; noSup := 0; noEmit := 0;
+  inBody := FALSE;
+  modName[0] := 0C
+END MGen.

SymTab.def

@@ -0,0 +1,178 @@
+DEFINITION MODULE SymTab;
+(* Symbol table with static type checking for the M2c compiler
+   (Modula-2 program modules, procedures arrive in a later phase).
+
+   - flat scopes with levels: globals at level 0, WITH statement
+     bodies push the record's fields as an inner scope (shadowing
+     allowed, duplicates within one level rejected)
+   - every symbol carries a type descriptor index (InvalidType if
+     unknown, e.g. imported names); unknown types suppress follow-on
+     errors to avoid cascades
+   - type descriptors: aliases (one per TYPE declaration, so
+     self-references such as POINTER TO Person resolve), subranges,
+     enumerations, arrays, records (with field lists), sets,
+     pointers, predefined types, string literals
+   - INTEGER, CARDINAL and subranges thereof form one lenient
+     "integer family"; mixed INTEGER/REAL arithmetic is rejected *)
+
+CONST
+  MaxSyms = 256;
+  InvalidType = -1;
+
+  (* symbol kinds *)
+  KindConst  = 0;
+  KindType   = 1;
+  KindVar    = 2;
+  KindImport = 3;
+  KindModule = 4;
+  KindPredef = 5;
+  KindField  = 6;
+
+  (* type classes returned by ClassOf *)
+  ClInvalid = 0;
+  ClInt     = 1;
+  ClReal    = 2;
+  ClChar    = 3;
+  ClBool    = 4;
+  ClEnum    = 5;
+  ClArray   = 6;
+  ClRecord  = 7;
+  ClSet     = 8;
+  ClPtr     = 9;
+  ClStr     = 10;
+
+  (* operator codes for RelCheck *)
+  OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
+  OpLt = 3; OpLe  = 4; OpGt   = 5; OpGe = 6;
+  OpIn = 7;
+  (* operator codes for AddOp / MulOp *)
+  OpAdd = 0; OpSub = 1; OpOr = 2;
+  OpTimes = 0; OpSlash = 1; OpDiv = 2; OpMod = 3; OpAnd = 4;
+
+TYPE
+  Name = ARRAY [0 .. 63] OF CHAR;
+  TypeIndex = INTEGER;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Init;
+(* Clears the table and enters predefined identifiers
+   (INTEGER, CARDINAL, SHORTINT, LONGINT, REAL, LONGREAL, CHAR,
+   BOOLEAN, TRUE, FALSE, NIL). *)
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Enters name at the current scope level (type InvalidType).
+   Returns FALSE on duplicate within the same level. *)
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Like Enter, but remembers the entry for a later FixPending call
+   (used for VAR identifier lists whose type is parsed afterwards).
+   Returns FALSE on duplicate (entry not recorded). *)
+
+PROCEDURE FixPending (t: TypeIndex);
+(* Assigns type t to all pending entries, clears the buffer. *)
+
+PROCEDURE PendCount (): CARDINAL;
+(* Number of entries currently waiting for FixPending. *)
+
+PROCEDURE PendName (i: CARDINAL; VAR n: Name);
+(* Name of the i-th pending entry (empty string if out of range).
+   Used by the backend to emit storage for VAR lists whose
+   type is parsed after the identifiers. *)
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+(* Records a field name for record descriptor rec (type fixed later
+   with FixPendingF). Returns FALSE on duplicate field. *)
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+(* Assigns type t to pending fields owned by rec. *)
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE if name is visible (innermost scope wins). *)
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+(* Type of innermost visible entry, InvalidType if absent. *)
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+(* Sets type of innermost visible entry. *)
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+(* Kind of innermost visible entry, -1 if absent. *)
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+
+PROCEDURE PushScope;
+PROCEDURE PopScope;
+(* WITH statement support: PushRecord pushes a record's fields. *)
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope containing t's fields (as KindField). FALSE if t
+   is not a record type (or invalid). Caller must PopScope after. *)
+
+PROCEDURE PrintTable;
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewAlias (): TypeIndex;
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+PROCEDURE NewEnum (): TypeIndex;
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+PROCEDURE NewRecord (): TypeIndex;
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+PROCEDURE NewStr (): TypeIndex;
+(* Fresh descriptors; base/elem may be InvalidType. InvalidType is
+   returned when the table is full. *)
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+(* Sets an alias target (TYPE declaration completion). *)
+
+PROCEDURE IntType (): TypeIndex;
+PROCEDURE RealType (): TypeIndex;
+PROCEDURE CharType (): TypeIndex;
+PROCEDURE BoolType (): TypeIndex;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+(* Resolves aliases; InvalidType maps to ClInvalid. *)
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+(* INTEGER, CARDINAL or subrange thereof (Invalid suppresses). *)
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+(* Same resolved descriptor (Invalid suppresses). *)
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+
+(* ---------------- predicates used by grammar checks ---------------- *)
+(* All return TRUE if either operand is InvalidType (no cascades). *)
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+(* Assignment compatibility (210). *)
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+(* + - * / (divmod FALSE) or DIV MOD (TRUE); res is result type (211). *)
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+(* Unary + - (part of 211). *)
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+(* BOOLEAN required: NOT/AND/OR operands (212), conditions (214). *)
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+(* = # <> < <= > >= IN (213/222 chosen by caller via op). *)
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+(* = # compatibility, also reused for CASE label matching. *)
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+(* Fresh SET OF elem descriptor for set literals. *)
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+
+END SymTab.

SymTab.mod

@@ -0,0 +1,618 @@
+IMPLEMENTATION MODULE SymTab;
+
+IMPORT FileIO;
+
+CONST
+  MaxTypes  = 256;
+  MaxFields = 512;
+  MaxPend   = 64;
+  MaxMarks  = 16;
+  ResDepth  = 64;
+
+  (* descriptor forms *)
+  FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
+  FRecord = 5; FSet = 6; FPtr = 7; FStr = 8;
+  FInt = 9; FReal = 10; FChar = 11; FBool = 12;
+
+TYPE
+  Symbol = RECORD
+    name : Name;
+    kind : INTEGER;
+    typ  : TypeIndex;
+    lev  : CARDINAL;
+  END;
+  Field = RECORD
+    name  : Name;
+    typ   : TypeIndex;
+    owner : TypeIndex;
+    next  : INTEGER;  (* index of next field of same owner, -1 = end *)
+  END;
+
+VAR
+  syms : ARRAY [0 .. MaxSyms - 1] OF Symbol;
+  nSyms : CARDINAL;
+  curLev : CARDINAL;
+  marks : ARRAY [0 .. MaxMarks - 1] OF CARDINAL;
+  mtop : CARDINAL;
+  pend : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPend : CARDINAL;
+  pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPendF : CARDINAL;
+  tform : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
+  tref : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
+  nTypes : CARDINAL;
+  fields : ARRAY [0 .. MaxFields - 1] OF Field;
+  nFields : CARDINAL;
+  dInt, dCard, dReal, dChar, dBool : TypeIndex;
+
+(* ---------------- strings ---------------- *)
+
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(dest)) & (src[i] # 0C) DO
+      dest[i] := src[i]; INC(i)
+    END;
+    dest[i] := 0C
+  END Assign;
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    LOOP
+      IF a[i] # b[i] THEN RETURN FALSE END;
+      IF a[i] = 0C THEN RETURN TRUE END;
+      INC(i)
+    END
+  END Equal;
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
+    RETURN i
+  END StrLen;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Find (name: ARRAY OF CHAR): INTEGER;
+(* innermost visible index or -1 *)
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE i > 0 DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN VAL(INTEGER, i) END
+    END;
+    RETURN -1
+  END Find;
+
+PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): INTEGER;
+(* index or -1 when full *)
+  BEGIN
+    IF nSyms >= MaxSyms THEN RETURN -1 END;
+    Assign(syms[nSyms].name, name);
+    syms[nSyms].kind := kind;
+    syms[nSyms].typ := InvalidType;
+    syms[nSyms].lev := curLev;
+    INC(nSyms);
+    RETURN VAL(INTEGER, nSyms - 1)
+  END RawEnter;
+
+PROCEDURE DupInLevel (name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE (i > 0) & (syms[i - 1].lev = curLev) DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN TRUE END
+    END;
+    RETURN FALSE
+  END DupInLevel;
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    RETURN RawEnter(name, kind) # -1
+  END Enter;
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  VAR idx : INTEGER;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    idx := RawEnter(name, kind);
+    IF (idx # -1) & (nPend < MaxPend) THEN
+      pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
+    END;
+    RETURN idx # -1
+  END EnterPending;
+
+PROCEDURE FixPending (t: TypeIndex);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPend DO
+      syms[pend[i]].typ := t; INC(i)
+    END;
+    nPend := 0
+  END FixPending;
+
+PROCEDURE PendCount (): CARDINAL;
+  BEGIN
+    RETURN nPend
+  END PendCount;
+
+PROCEDURE PendName (i: CARDINAL; VAR n: Name);
+  BEGIN
+    IF i < nPend THEN Assign(n, syms[pend[i]].name)
+    ELSE n[0] := 0C
+    END
+  END PendName;
+
+PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
+  VAR i : INTEGER;
+  BEGIN
+    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
+    IF tform[rec] # FRecord THEN RETURN -1 END;
+    i := tref[rec];
+    WHILE i # -1 DO
+      IF Equal(fields[i].name, name) THEN RETURN i END;
+      i := fields[i].next
+    END;
+    RETURN -1
+  END FindField;
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    IF FindField(rec, name) # -1 THEN RETURN FALSE END;
+    IF nFields >= MaxFields THEN RETURN FALSE END;
+    Assign(fields[nFields].name, name);
+    fields[nFields].typ := InvalidType;
+    fields[nFields].owner := rec;
+    fields[nFields].next := tref[rec];
+    tref[rec] := VAL(INTEGER, nFields);
+    IF nPendF < MaxPend THEN
+      pendF[nPendF] := nFields; INC(nPendF)
+    END;
+    INC(nFields);
+    RETURN TRUE
+  END FieldPending;
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+  VAR i, j : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPendF DO
+      IF fields[pendF[i]].owner = rec THEN
+        fields[pendF[i]].typ := t;
+        (* remove by swap with last *)
+        j := nPendF - 1;
+        pendF[i] := pendF[j];
+        DEC(nPendF)
+      ELSE
+        INC(i)
+      END
+    END
+  END FixPendingF;
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN Find(name) # -1
+  END Lookup;
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN InvalidType END;
+    RETURN syms[idx].typ
+  END SymType;
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx # -1 THEN syms[idx].typ := t END
+  END SetSymType;
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN -1 END;
+    RETURN syms[idx].kind
+  END SymKind;
+
+PROCEDURE PushScope;
+  BEGIN
+    IF mtop < MaxMarks THEN marks[mtop] := nSyms; INC(mtop) END;
+    INC(curLev)
+  END PushScope;
+
+PROCEDURE PopScope;
+  BEGIN
+    IF mtop > 0 THEN DEC(mtop); nSyms := marks[mtop] END;
+    IF curLev > 0 THEN DEC(curLev) END
+  END PopScope;
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
+  BEGIN
+    IF nTypes >= MaxTypes THEN RETURN InvalidType END;
+    tform[nTypes] := form;
+    tref[nTypes] := ref;
+    INC(nTypes);
+    RETURN VAL(INTEGER, nTypes - 1)
+  END NewDesc;
+
+PROCEDURE NewAlias (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FAlias, InvalidType)
+  END NewAlias;
+
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSub, base)
+  END NewSub;
+
+PROCEDURE NewEnum (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FEnum, InvalidType)
+  END NewEnum;
+
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FArray, elem)
+  END NewArray;
+
+PROCEDURE NewRecord (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FRecord, -1)
+  END NewRecord;
+
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSet, base)
+  END NewSet;
+
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FPtr, base)
+  END NewPtr;
+
+PROCEDURE NewStr (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FStr, InvalidType)
+  END NewStr;
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+  BEGIN
+    IF (t >= 0) & (t < VAL(INTEGER, nTypes)) & (tform[t] = FAlias) THEN
+      tref[t] := base
+    END
+  END SetTarget;
+
+PROCEDURE Resolve (t: TypeIndex): TypeIndex;
+  VAR n : CARDINAL;
+  BEGIN
+    n := 0;
+    WHILE (n < ResDepth) & (t >= 0) & (t < VAL(INTEGER, nTypes))
+          & (tform[t] = FAlias) DO
+      t := tref[t]; INC(n)
+    END;
+    IF (t < 0) OR (t >= VAL(INTEGER, nTypes)) THEN
+      RETURN InvalidType
+    END;
+    RETURN t
+  END Resolve;
+
+PROCEDURE IntType (): TypeIndex;
+  BEGIN RETURN dInt END IntType;
+PROCEDURE RealType (): TypeIndex;
+  BEGIN RETURN dReal END RealType;
+PROCEDURE CharType (): TypeIndex;
+  BEGIN RETURN dChar END CharType;
+PROCEDURE BoolType (): TypeIndex;
+  BEGIN RETURN dBool END BoolType;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN ClInvalid END;
+    CASE tform[r] OF
+      FInt : RETURN ClInt
+    | FReal : RETURN ClReal
+    | FChar : RETURN ClChar
+    | FBool : RETURN ClBool
+    | FEnum : RETURN ClEnum
+    | FArray : RETURN ClArray
+    | FRecord : RETURN ClRecord
+    | FSet : RETURN ClSet
+    | FPtr : RETURN ClPtr
+    | FStr : RETURN ClStr
+    | FSub : RETURN ClassOf(tref[r])
+    ELSE RETURN ClInvalid
+    END
+  END ClassOf;
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+  BEGIN
+    RETURN ClassOf(t) = ClInt
+  END IsIntFamily;
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (a = InvalidType) OR (b = InvalidType) THEN RETURN TRUE END;
+    RETURN Resolve(a) = Resolve(b)
+  END SameType;
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN FindField(Resolve(rec), name) # -1
+  END FieldExists;
+
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+  VAR i : INTEGER;
+  BEGIN
+    i := FindField(Resolve(rec), name);
+    IF i = -1 THEN RETURN InvalidType END;
+    RETURN fields[i].typ
+  END FieldType;
+
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FArray) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END ArrayElem;
+
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FPtr) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END PtrBase;
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope with t's fields; caller must PopScope afterwards. *)
+  VAR r, i : INTEGER;
+  BEGIN
+    r := Resolve(t);
+    IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
+    PushScope;
+    i := tref[r];
+    WHILE i # -1 DO
+      IF Enter(fields[i].name, KindField) THEN
+        SetSymType(fields[i].name, fields[i].typ)
+      END;
+      i := fields[i].next
+    END;
+    RETURN TRUE
+  END PushRecord;
+
+(* ---------------- predicates ---------------- *)
+
+PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
+(* base compatibility for two SET types *)
+  BEGIN
+    IF SameType(a, b) THEN RETURN TRUE END;
+    IF IsIntFamily(a) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(a) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END SetBasesOk;
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+  VAR rs, rd : TypeIndex;
+  BEGIN
+    IF (src = InvalidType) OR (dst = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(src); rd := Resolve(dst);
+    IF rs = rd THEN RETURN TRUE END;
+    IF (rs = InvalidType) OR (rd = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rs] = FSet) & (tform[rd] = FSet) THEN
+      RETURN SetBasesOk(tref[rs], tref[rd])
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClInt) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClStr) & (ClassOf(dst) = ClArray) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END Assignable;
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN
+      res := dInt; RETURN TRUE
+    END;
+    IF ~divmod & (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      res := dReal; RETURN TRUE
+    END;
+    RETURN FALSE
+  END ArithCheck;
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF t = InvalidType THEN RETURN TRUE END;
+    IF IsIntFamily(t) THEN res := dInt; RETURN TRUE END;
+    IF ClassOf(t) = ClReal THEN res := dReal; RETURN TRUE END;
+    RETURN FALSE
+  END UnaryCheck;
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+  BEGIN
+    IF t = InvalidType THEN RETURN TRUE END;
+    RETURN ClassOf(t) = ClBool
+  END BoolCheck;
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+  VAR rl, rr : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF SameType(l, r) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClBool) & (ClassOf(r) = ClBool) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClStr) & (ClassOf(r) = ClStr) THEN
+      RETURN TRUE
+    END;
+    rl := Resolve(l); rr := Resolve(r);
+    IF (rl = InvalidType) OR (rr = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rl] = FSet) & (tform[rr] = FSet) THEN
+      RETURN SetBasesOk(tref[rl], tref[rr])
+    END;
+    RETURN FALSE
+  END EqCheck;
+
+PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClEnum) & SameType(l, r) THEN RETURN TRUE END;
+    RETURN FALSE
+  END OrdCheck;
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+  VAR rs, b : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (set = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(set);
+    IF (rs = InvalidType) OR (tform[rs] # FSet) THEN RETURN FALSE END;
+    b := tref[rs];
+    IF SameType(l, b) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END InCheck;
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF op = OpIn THEN RETURN InCheck(l, r) END;
+    IF (op = OpEq) OR (op = OpNeq1) OR (op = OpNeq2) THEN
+      RETURN EqCheck(l, r)
+    END;
+    RETURN OrdCheck(l, r)
+  END RelCheck;
+
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (first = InvalidType) OR (elem = InvalidType) THEN
+      RETURN TRUE
+    END;
+    IF SameType(first, elem) THEN RETURN TRUE END;
+    IF IsIntFamily(first) & IsIntFamily(elem) THEN RETURN TRUE END;
+    RETURN FALSE
+  END SetElemCheck;
+
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+  VAR e : TypeIndex;
+  BEGIN
+    e := Resolve(elem);
+    IF e = InvalidType THEN e := dInt END;
+    RETURN NewSet(e)
+  END SetFor;
+
+(* ---------------- init ---------------- *)
+
+PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
+  BEGIN
+    IF Enter(name, kind) THEN SetSymType(name, t) END
+  END Predef;
+
+PROCEDURE Init;
+  BEGIN
+    nSyms := 0; curLev := 0; mtop := 0;
+    nPend := 0; nPendF := 0;
+    nTypes := 0; nFields := 0;
+    dInt := NewDesc(FInt, InvalidType);
+    dCard := NewDesc(FInt, InvalidType);
+    dReal := NewDesc(FReal, InvalidType);
+    dChar := NewDesc(FChar, InvalidType);
+    dBool := NewDesc(FBool, InvalidType);
+    Predef("INTEGER", KindPredef, dInt);
+    Predef("CARDINAL", KindPredef, dCard);
+    Predef("SHORTINT", KindPredef, dInt);
+    Predef("LONGINT", KindPredef, dInt);
+    Predef("REAL", KindPredef, dReal);
+    Predef("LONGREAL", KindPredef, dReal);
+    Predef("CHAR", KindPredef, dChar);
+    Predef("BOOLEAN", KindPredef, dBool);
+    Predef("TRUE", KindConst, dBool);
+    Predef("FALSE", KindConst, dBool);
+    Predef("NIL", KindConst, InvalidType)
+  END Init;
+
+(* ---------------- listing ---------------- *)
+
+PROCEDURE WriteKind (kind: INTEGER);
+  BEGIN
+    CASE kind OF
+      KindConst  : FileIO.WriteString(FileIO.StdOut, "CONST")
+    | KindType   : FileIO.WriteString(FileIO.StdOut, "TYPE")
+    | KindVar    : FileIO.WriteString(FileIO.StdOut, "VAR")
+    | KindImport : FileIO.WriteString(FileIO.StdOut, "IMPORT")
+    | KindModule : FileIO.WriteString(FileIO.StdOut, "MODULE")
+    | KindPredef : FileIO.WriteString(FileIO.StdOut, "PREDEF")
+    | KindField  : FileIO.WriteString(FileIO.StdOut, "FIELD")
+    ELSE FileIO.WriteString(FileIO.StdOut, "???")
+    END
+  END WriteKind;
+
+PROCEDURE PrintTable;
+  VAR i : CARDINAL;
+  BEGIN
+    FileIO.WriteLn(FileIO.StdOut);
+    FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
+    FileIO.WriteLn(FileIO.StdOut);
+    i := 0;
+    WHILE i < nSyms DO
+      FileIO.WriteString(FileIO.StdOut, "  ");
+      FileIO.WriteString(FileIO.StdOut, syms[i].name);
+      FileIO.WriteString(FileIO.StdOut, " : ");
+      WriteKind(syms[i].kind);
+      FileIO.WriteString(FileIO.StdOut, " #");
+      FileIO.WriteInt(FileIO.StdOut, syms[i].typ, 1);
+      FileIO.WriteLn(FileIO.StdOut);
+      INC(i)
+    END
+  END PrintTable;
+
+BEGIN
+  Init
+END SymTab.

build.sh

@@ -1,6 +1,6 @@
 #!/bin/sh
 #
-# Builds the M2c compiler (Phase 0: module skeleton).
+# Builds the M2c compiler (step 2: scalars + MC64 backend).
 # Requires GNU Modula-2 (gm2) and the Coco/R CR binary.
 #
 # Usage: ./build.sh   (from the m2c directory)
@@ -17,16 +17,16 @@ echo "=== Deleting all o files ==="
 rm -f ./*.o
 
 echo "=== Compiling the needed modules ==="
-for m in FileIO M2cS M2cP M2c; do
+for m in FileIO SymTab MGen M2cS M2cP M2c; do
   gm2 -fiso -c "$m.mod" || exit 1
 done
 
 echo "=== Phase 1: generating the module list ==="
 gm2 -fiso -fgen-module-list=modules.lst -o /dev/null \
-    M2cS.o M2cP.o FileIO.o M2c.mod || exit 1
+    M2cS.o M2cP.o FileIO.o SymTab.o MGen.o M2c.mod || exit 1
 
 echo "=== Phase 2: compiling main module and linking using the module list ==="
 gm2 -fiso -fuse-list=modules.lst -o M2c \
-    M2cS.o M2cP.o FileIO.o M2c.mod || exit 1
+    M2cS.o M2cP.o FileIO.o SymTab.o MGen.o M2c.mod || exit 1
 
 echo "=== M2c built ==="

compiler.frm

@@ -97,7 +97,25 @@ MODULE -->Grammar;
         CASE nr OF
         -->Errors
         (* add customized cases here *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
         | 202: Msg("module name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("not supported in this phase")
         ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
         END;
         WriteLn(lst)

modules.lst

@@ -61,5 +61,7 @@ RndFile
 TermFile
 FileIO
 M2cS
+SymTab
+MGen
 M2cP
 M2c

run_tests.sh

@@ -1,14 +1,19 @@
 #!/bin/sh
 #
-# Phase-0 test runner for M2c.
+# Step-2 test runner for M2c (scalars + MC64 backend).
 # Usage: ./run_tests.sh   (from the m2c directory, after ./build.sh)
 #
+# Positive tests: compile with M2c, run the newest .MCD under mcint,
+# compare the printed ExitCode value with the expectation.
+#
+
+MCINT="${MCINT:-../mc64/mcint}"
 
 pass=0
 fail=0
 
 expect_ok() {
-  # $1 = test file (no dir)
+  # $1 = test file (no dir) — parse only
   name="$1"
   out=$(./M2c "tests/$name" 2>&1)
   case "$out" in
@@ -42,11 +47,91 @@ expect_fail() {
   fi
 }
 
-echo "=== Phase-0 tests ==="
+expect_run() {
+  # $1 = test file, $2 = expected printed ExitCode value
+  name="$1"
+  want="$2"
+  mod=$(head -n 1 "tests/$name" | cut -d' ' -f2 | cut -d';' -f1)
+  mcd="$mod.MCD"
+  rm -f "$mcd"
+  out=$(./M2c "tests/$name" 2>&1)
+  case "$out" in
+    *"Parsed correctly"*) ;;
+    *)
+      echo "FAIL $name: M2c rejected it: $out"
+      fail=$((fail+1)); return ;;
+  esac
+  if [ ! -f "$mcd" ]; then
+    echo "FAIL $name: no $mcd produced"
+    fail=$((fail+1)); return
+  fi
+  got=$("$MCINT" "$mcd" 2>&1 | head -n 1 | tr -d '\r')
+  if [ "$got" = "$want" ]; then
+    echo "ok   $name -> $got"
+    pass=$((pass+1))
+  else
+    echo "FAIL $name: printed [$got], expected [$want]"
+    fail=$((fail+1))
+  fi
+}
+
+expect_run_none() {
+  # $1 = test file — must compile and run with empty output
+  name="$1"
+  mod=$(head -n 1 "tests/$name" | cut -d' ' -f2 | cut -d';' -f1)
+  mcd="$mod.MCD"
+  rm -f "$mcd"
+  out=$(./M2c "tests/$name" 2>&1)
+  case "$out" in
+    *"Parsed correctly"*) ;;
+    *)
+      echo "FAIL $name: M2c rejected it: $out"
+      fail=$((fail+1)); return ;;
+  esac
+  if [ ! -f "$mcd" ]; then
+    echo "FAIL $name: no $mcd produced"
+    fail=$((fail+1)); return
+  fi
+  got=$("$MCINT" "$mcd" 2>&1 | head -n 1)
+  if [ -z "$got" ]; then
+    echo "ok   $name runs silent"
+    pass=$((pass+1))
+  else
+    echo "FAIL $name: unexpected output [$got]"
+    fail=$((fail+1))
+  fi
+}
+
+echo "=== Phase-0 tests (still green) ==="
 expect_ok ok_minimal.mod
 expect_ok ok_nobegin.mod
 expect_fail bad_mismatch.mod "module name mismatch"
 expect_fail bad_syntax.mod "expected"
 
+echo "=== Step-2 run tests (M2c -> mcint) ==="
+expect_run_none t_min.mod
+expect_run t_arith.mod 7
+expect_run t_const.mod 15
+expect_run t_bool.mod 42
+expect_run t_if.mod 20
+expect_run t_case.mod 103
+expect_run t_while.mod 55
+expect_run t_repeat.mod 55
+expect_run t_loop.mod 7
+expect_run t_for.mod 85
+expect_run t_real.mod 31
+expect_run t_char.mod 97
+expect_run t_enum.mod 1
+expect_run t_full.mod 74
+expect_run t_set.mod 15
+
+echo "=== Step-2 rejection tests ==="
+expect_fail t_bad_asn.mod "incompatible assignment"
+expect_fail t_bad_array.mod "not supported in this phase"
+expect_fail t_bad_with.mod "not supported in this phase"
+expect_fail t_bad_exit.mod "not supported in this phase"
+expect_fail t_bad_const.mod "not supported in this phase"
+expect_fail t_bad_deref.mod "not supported in this phase"
+
 echo "=== $pass passed, $fail failed ==="
 test "$fail" = 0

tests/t_arith.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TArith;
+    2  VAR x, y : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 1 + 2 * 3 - 4 DIV 2;
+    5    y := (x + 10) * 2 MOD 7;
+    6    ExitCode := x + y
+    7  END TArith.
+
+    0 errors
+
+

tests/t_arith.mod

@@ -0,0 +1,7 @@
+MODULE TArith;
+VAR x, y : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 1 + 2 * 3 - 4 DIV 2;
+  y := (x + 10) * 2 MOD 7;
+  ExitCode := x + y
+END TArith.

tests/t_bad_array.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE TBadArr;
+    2  VAR a : ARRAY [1 .. 10] OF INTEGER; x : INTEGER;
+*****                             ^ not supported in this phase
+    3  BEGIN
+    4    x := 1;
+    5    a[x] := 5
+*****    ^ not supported in this phase
+*****      ^ not supported in this phase
+    6  END TBadArr.
+
+    3 errors
+
+

tests/t_bad_array.mod

@@ -0,0 +1,6 @@
+MODULE TBadArr;
+VAR a : ARRAY [1 .. 10] OF INTEGER; x : INTEGER;
+BEGIN
+  x := 1;
+  a[x] := 5
+END TBadArr.

tests/t_bad_asn.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TBadAsn;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 3.14;
+*****         ^ incompatible assignment
+    5    ExitCode := 0
+    6  END TBadAsn.
+
+    1 error
+
+

tests/t_bad_asn.mod

@@ -0,0 +1,6 @@
+MODULE TBadAsn;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 3.14;
+  ExitCode := 0
+END TBadAsn.

tests/t_bad_const.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TBadConst;
+    2  CONST A = 10; B = A + 1;
+*****                        ^ not supported in this phase
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := A
+    6  END TBadConst.
+
+    1 error
+
+

tests/t_bad_const.mod

@@ -0,0 +1,6 @@
+MODULE TBadConst;
+CONST A = 10; B = A + 1;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := A
+END TBadConst.

tests/t_bad_deref.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE TBadDeref;
+    2  VAR p : POINTER TO INTEGER; x : INTEGER;
+*****                     ^ not supported in this phase
+    3  BEGIN
+    4    x := 1;
+    5    x := p^
+*****         ^ not supported in this phase
+    6  END TBadDeref.
+
+    2 errors
+
+

tests/t_bad_deref.mod

@@ -0,0 +1,6 @@
+MODULE TBadDeref;
+VAR p : POINTER TO INTEGER; x : INTEGER;
+BEGIN
+  x := 1;
+  x := p^
+END TBadDeref.

tests/t_bad_exit.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TBadExit;
+    2  VAR ExitCode : INTEGER;
+    3  BEGIN
+    4    ExitCode := 1;
+    5    EXIT
+*****    ^ not supported in this phase
+    6  END TBadExit.
+
+    1 error
+
+

tests/t_bad_exit.mod

@@ -0,0 +1,6 @@
+MODULE TBadExit;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := 1;
+  EXIT
+END TBadExit.

tests/t_bad_with.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE TBadWith;
+    2  TYPE Point = RECORD x, y : INTEGER END;
+    3  VAR p : Point; n : INTEGER;
+*****          ^ not supported in this phase
+    4  BEGIN
+    5    n := 1;
+    6    WITH p DO x := 2 END
+*****         ^ not supported in this phase
+    7  END TBadWith.
+
+    2 errors
+
+

tests/t_bad_with.mod

@@ -0,0 +1,7 @@
+MODULE TBadWith;
+TYPE Point = RECORD x, y : INTEGER END;
+VAR p : Point; n : INTEGER;
+BEGIN
+  n := 1;
+  WITH p DO x := 2 END
+END TBadWith.

tests/t_bool.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE TBool;
+    2  VAR a, b : BOOLEAN; x, y : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 5; y := 10;
+    5    a := (x < y) AND (x # 0);
+    6    b := (NOT a) OR (x = 5);
+    7    IF a AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+    8  END TBool.
+
+    0 errors
+
+

tests/t_bool.mod

@@ -0,0 +1,8 @@
+MODULE TBool;
+VAR a, b : BOOLEAN; x, y : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 5; y := 10;
+  a := (x < y) AND (x # 0);
+  b := (NOT a) OR (x = 5);
+  IF a AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TBool.

tests/t_case.LST

@@ -0,0 +1,21 @@
+Listing:
+
+    1  MODULE TCase;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 7;
+    5    CASE x OF
+    6      1, 2 : ExitCode := 1
+    7    | 3 .. 6 : ExitCode := 2
+    8    | 7 .. 10 : ExitCode := 3
+    9    ELSE ExitCode := 9
+   10    END;
+   11    CASE x + 1 OF
+   12      8 : ExitCode := ExitCode + 100
+   13    ELSE ExitCode := 0
+   14    END
+   15  END TCase.
+
+    0 errors
+
+

tests/t_case.mod

@@ -0,0 +1,15 @@
+MODULE TCase;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 7;
+  CASE x OF
+    1, 2 : ExitCode := 1
+  | 3 .. 6 : ExitCode := 2
+  | 7 .. 10 : ExitCode := 3
+  ELSE ExitCode := 9
+  END;
+  CASE x + 1 OF
+    8 : ExitCode := ExitCode + 100
+  ELSE ExitCode := 0
+  END
+END TCase.

tests/t_char.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TChar;
+    2  VAR c, d : CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    c := 'a';
+    5    d := 'b';
+    6    IF c < d THEN ExitCode := 97 ELSE ExitCode := 98 END
+    7  END TChar.
+
+    0 errors
+
+

tests/t_char.mod

@@ -0,0 +1,7 @@
+MODULE TChar;
+VAR c, d : CHAR; ExitCode : INTEGER;
+BEGIN
+  c := 'a';
+  d := 'b';
+  IF c < d THEN ExitCode := 97 ELSE ExitCode := 98 END
+END TChar.

tests/t_const.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE TConst;
+    2  CONST Max = 10; Neg = -5; Hex = 0AH;
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := Max + Neg + Hex
+    6  END TConst.
+
+    0 errors
+
+

tests/t_const.mod

@@ -0,0 +1,6 @@
+MODULE TConst;
+CONST Max = 10; Neg = -5; Hex = 0AH;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := Max + Neg + Hex
+END TConst.

tests/t_enum.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE TEnum;
+    2  TYPE Color = (red, green, blue);
+    3  VAR c : Color; ExitCode : INTEGER;
+    4  BEGIN
+    5    c := green;
+    6    CASE c OF
+    7      red : ExitCode := 0
+    8    | green : ExitCode := 1
+    9    | blue : ExitCode := 2
+   10    ELSE ExitCode := 9
+   11    END
+   12  END TEnum.
+
+    0 errors
+
+

tests/t_enum.mod

@@ -0,0 +1,12 @@
+MODULE TEnum;
+TYPE Color = (red, green, blue);
+VAR c : Color; ExitCode : INTEGER;
+BEGIN
+  c := green;
+  CASE c OF
+    red : ExitCode := 0
+  | green : ExitCode := 1
+  | blue : ExitCode := 2
+  ELSE ExitCode := 9
+  END
+END TEnum.

tests/t_for.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE TFor;
+    2  VAR k, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    s := 0;
+    5    FOR k := 1 TO 10 DO s := s + k END;
+    6    FOR k := 10 TO 1 BY -2 DO s := s + k END;
+    7    ExitCode := s
+    8  END TFor.
+
+    0 errors
+
+

tests/t_for.mod

@@ -0,0 +1,8 @@
+MODULE TFor;
+VAR k, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  s := 0;
+  FOR k := 1 TO 10 DO s := s + k END;
+  FOR k := 10 TO 1 BY -2 DO s := s + k END;
+  ExitCode := s
+END TFor.

tests/t_full.LST

@@ -0,0 +1,21 @@
+Listing:
+
+    1  MODULE TFull;
+    2  CONST Limit = 20;
+    3  VAR k, n, s : INTEGER; ExitCode : INTEGER;
+    4  BEGIN
+    5    n := 0; s := 0;
+    6    FOR k := 1 TO 10 DO s := s + k END;
+    7    n := s MOD Limit;
+    8    WHILE n < 0 DO n := n + 1 END;
+    9    REPEAT n := n + 1 UNTIL n >= 17;
+   10    LOOP IF n > 100 THEN EXIT END; n := n + 1; IF n >= 19 THEN EXIT END END;
+   11    CASE n OF
+   12      19 : ExitCode := s + n
+   13    ELSE ExitCode := 0
+   14    END
+   15  END TFull.
+
+    0 errors
+
+

tests/t_full.mod

@@ -0,0 +1,15 @@
+MODULE TFull;
+CONST Limit = 20;
+VAR k, n, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  n := 0; s := 0;
+  FOR k := 1 TO 10 DO s := s + k END;
+  n := s MOD Limit;
+  WHILE n < 0 DO n := n + 1 END;
+  REPEAT n := n + 1 UNTIL n >= 17;
+  LOOP IF n > 100 THEN EXIT END; n := n + 1; IF n >= 19 THEN EXIT END END;
+  CASE n OF
+    19 : ExitCode := s + n
+  ELSE ExitCode := 0
+  END
+END TFull.

tests/t_if.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE TIf;
+    2  VAR x : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    x := 2;
+    5    IF x = 1 THEN ExitCode := 10
+    6    ELSIF x = 2 THEN ExitCode := 20
+    7    ELSE ExitCode := 30 END;
+    8    IF x # 2 THEN ExitCode := 99 END
+    9  END TIf.
+
+    0 errors
+
+

tests/t_if.mod

@@ -0,0 +1,9 @@
+MODULE TIf;
+VAR x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 2;
+  IF x = 1 THEN ExitCode := 10
+  ELSIF x = 2 THEN ExitCode := 20
+  ELSE ExitCode := 30 END;
+  IF x # 2 THEN ExitCode := 99 END
+END TIf.

tests/t_loop.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE TLoop;
+    2  VAR i : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 0;
+    5    LOOP
+    6      i := i + 1;
+    7      IF i >= 7 THEN EXIT END
+    8    END;
+    9    ExitCode := i
+   10  END TLoop.
+
+    0 errors
+
+

tests/t_loop.mod

@@ -0,0 +1,10 @@
+MODULE TLoop;
+VAR i : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 0;
+  LOOP
+    i := i + 1;
+    IF i >= 7 THEN EXIT END
+  END;
+  ExitCode := i
+END TLoop.

tests/t_min.LST

@@ -0,0 +1,9 @@
+Listing:
+
+    1  MODULE TMin;
+    2  BEGIN
+    3  END TMin.
+
+    0 errors
+
+

tests/t_min.mod

@@ -0,0 +1,3 @@
+MODULE TMin;
+BEGIN
+END TMin.

tests/t_real.LST

@@ -0,0 +1,17 @@
+Listing:
+
+    1  MODULE TReal;
+    2  CONST Pi = 2.5;
+    3  VAR r, s : REAL; x : INTEGER; ExitCode : INTEGER;
+    4  BEGIN
+    5    x := 3;
+    6    r := x;
+    7    s := 3.5 * 2.0;
+    8    r := r + Pi;
+    9    IF s > r THEN ExitCode := 11 ELSE ExitCode := 12 END;
+   10    IF s = 7.0 THEN ExitCode := ExitCode + 20 END
+   11  END TReal.
+
+    0 errors
+
+

tests/t_real.mod

@@ -0,0 +1,11 @@
+MODULE TReal;
+CONST Pi = 2.5;
+VAR r, s : REAL; x : INTEGER; ExitCode : INTEGER;
+BEGIN
+  x := 3;
+  r := x;
+  s := 3.5 * 2.0;
+  r := r + Pi;
+  IF s > r THEN ExitCode := 11 ELSE ExitCode := 12 END;
+  IF s = 7.0 THEN ExitCode := ExitCode + 20 END
+END TReal.

tests/t_repeat.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TRepeat;
+    2  VAR i, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 0; s := 0;
+    5    REPEAT i := i + 1; s := s + i UNTIL i >= 10;
+    6    ExitCode := s
+    7  END TRepeat.
+
+    0 errors
+
+

tests/t_repeat.mod

@@ -0,0 +1,7 @@
+MODULE TRepeat;
+VAR i, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 0; s := 0;
+  REPEAT i := i + 1; s := s + i UNTIL i >= 10;
+  ExitCode := s
+END TRepeat.

tests/t_set.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE TSet;
+    2  VAR s, t : SET OF [0 .. 7]; ExitCode : INTEGER;
+    3  BEGIN
+    4    s := {1, 2, 3};
+    5    t := {5 .. 7};
+    6    IF (2 IN s) AND (s = {1, 2, 3}) THEN ExitCode := 14 ELSE ExitCode := 0 END;
+    7    IF 6 IN t THEN ExitCode := ExitCode + 1 END
+    8  END TSet.
+
+    0 errors
+
+

tests/t_set.mod

@@ -0,0 +1,8 @@
+MODULE TSet;
+VAR s, t : SET OF [0 .. 7]; ExitCode : INTEGER;
+BEGIN
+  s := {1, 2, 3};
+  t := {5 .. 7};
+  IF (2 IN s) AND (s = {1, 2, 3}) THEN ExitCode := 14 ELSE ExitCode := 0 END;
+  IF 6 IN t THEN ExitCode := ExitCode + 1 END
+END TSet.

tests/t_while.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE TWhile;
+    2  VAR i, s : INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    i := 1; s := 0;
+    5    WHILE i <= 10 DO s := s + i; i := i + 1 END;
+    6    ExitCode := s
+    7  END TWhile.
+
+    0 errors
+
+

tests/t_while.mod

@@ -0,0 +1,7 @@
+MODULE TWhile;
+VAR i, s : INTEGER; ExitCode : INTEGER;
+BEGIN
+  i := 1; s := 0;
+  WHILE i <= 10 DO s := s + i; i := i + 1 END;
+  ExitCode := s
+END TWhile.