Kaynağa Gözat

step5: open arrays, whole copy, strings, I/O, NIL trap; 99/99 tests green

Eric Streit 3 hafta önce
ebeveyn
işleme
6aa1959a3b
98 değiştirilmiş dosya ile 3149 ekleme ve 207 silme
  1. BIN
      ABadAsn.MC4
  2. BIN
      ASubOpen.MC4
  3. BIN
      CBadLen.MC4
  4. BIN
      CCopy.MC4
  5. BIN
      CCopy2.MC4
  6. BIN
      CRec.MC4
  7. BIN
      M2c
  8. 147 24
      M2c.atg
  9. 35 32
      M2c.err
  10. 1897 6
      M2c.lst
  11. 35 32
      M2c.mod
  12. BIN
      M2c.o
  13. 231 80
      M2cP.mod
  14. BIN
      M2cP.o
  15. 25 21
      M2cS.mod
  16. BIN
      M2cS.o
  17. 9 0
      MGen.def
  18. 55 3
      MGen.mod
  19. BIN
      MGen.o
  20. BIN
      OBadHigh.MC4
  21. BIN
      OBadOpen.MC4
  22. BIN
      OChar.MC4
  23. BIN
      OHigh.MC4
  24. BIN
      OOpen.MC4
  25. BIN
      OOpen2.MC4
  26. BIN
      OVal.MC4
  27. BIN
      PBadDispose.MC4
  28. BIN
      PNewArr.MC4
  29. BIN
      RBadAsn.MC4
  30. BIN
      RBadOpen.MC4
  31. BIN
      RCopy2.MC4
  32. BIN
      SBadCmp.MC4
  33. BIN
      SBadOp.MC4
  34. BIN
      SCmp2.MC4
  35. BIN
      SStrEq.MC4
  36. 2 0
      SymTab.def
  37. 31 1
      SymTab.mod
  38. BIN
      SymTab.o
  39. BIN
      TBadArr.MC4
  40. BIN
      VBadVar.MC4
  41. BIN
      WBadInt.MC4
  42. BIN
      WBadStr.MC4
  43. BIN
      WIo.MC4
  44. BIN
      WStr2.MC4
  45. 79 0
      docs/summary_step5.md
  46. 29 0
      run_tests.sh
  47. 20 0
      tests/a_subopen.LST
  48. 14 0
      tests/a_subopen.mod
  49. 12 0
      tests/c_bad_len.LST
  50. 5 0
      tests/c_bad_len.mod
  51. 13 0
      tests/c_copy.LST
  52. 7 0
      tests/c_copy.mod
  53. 13 0
      tests/c_copy2.LST
  54. 7 0
      tests/c_copy2.mod
  55. 14 0
      tests/c_rec.LST
  56. 8 0
      tests/c_rec.mod
  57. 12 0
      tests/o_bad_high.LST
  58. 5 0
      tests/o_bad_high.mod
  59. 19 0
      tests/o_bad_open.LST
  60. 12 0
      tests/o_bad_open.mod
  61. 16 0
      tests/o_char.LST
  62. 10 0
      tests/o_char.mod
  63. 11 0
      tests/o_high.LST
  64. 5 0
      tests/o_high.mod
  65. 19 0
      tests/o_open.LST
  66. 13 0
      tests/o_open.mod
  67. 20 0
      tests/o_open2.LST
  68. 14 0
      tests/o_open2.mod
  69. 19 0
      tests/o_val.LST
  70. 13 0
      tests/o_val.mod
  71. 12 0
      tests/p_bad_dispose.LST
  72. 5 0
      tests/p_bad_dispose.mod
  73. 15 0
      tests/p_newarr.LST
  74. 9 0
      tests/p_newarr.mod
  75. 12 0
      tests/r_bad_open.LST
  76. 5 0
      tests/r_bad_open.mod
  77. 15 0
      tests/r_copy2.LST
  78. 9 0
      tests/r_copy2.mod
  79. 12 0
      tests/s_bad_cmp.LST
  80. 5 0
      tests/s_bad_cmp.mod
  81. 12 0
      tests/s_bad_op.LST
  82. 5 0
      tests/s_bad_op.mod
  83. 16 0
      tests/s_cmp2.LST
  84. 10 0
      tests/s_cmp2.mod
  85. 16 0
      tests/s_streq.LST
  86. 10 0
      tests/s_streq.mod
  87. 4 5
      tests/t_bad_array.LST
  88. 2 3
      tests/t_bad_array.mod
  89. 15 0
      tests/v_bad_var.LST
  90. 8 0
      tests/v_bad_var.mod
  91. 12 0
      tests/w_bad_int.LST
  92. 5 0
      tests/w_bad_int.mod
  93. 12 0
      tests/w_bad_str.LST
  94. 5 0
      tests/w_bad_str.mod
  95. 13 0
      tests/w_io.LST
  96. 7 0
      tests/w_io.mod
  97. 14 0
      tests/w_str2.LST
  98. 8 0
      tests/w_str2.mod

BIN
ABadAsn.MC4


BIN
ASubOpen.MC4


BIN
CBadLen.MC4


BIN
CCopy.MC4


BIN
CCopy2.MC4


BIN
CRec.MC4



+ 147 - 24
M2c.atg

@@ -439,9 +439,10 @@ PRODUCTIONS
                                              idx: ARRAY [0 .. 7] OF
                                                SymTab.TypeIndex;
                                              nc, kk: CARDINAL;
-                                             loA, hiA: INTEGER; .)
+                                             loA, hiA: INTEGER;
+                                             isOpenA: BOOLEAN; .)
     = "ARRAY"
-      SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+      [ SimpleType<s>                     (. IF (s # SymTab.InvalidType)
                                             & (SymTab.ClassOf(s) #
                                                SymTab.ClInt)
                                             & (SymTab.ClassOf(s) #
@@ -449,10 +450,10 @@ PRODUCTIONS
                                             & (SymTab.ClassOf(s) #
                                                SymTab.ClEnum) THEN
                                             SemError(224) END;
-                                           nc := 0;
+                                           nc := 0; isOpenA := FALSE;
                                            idx[nc] := s; INC(nc); .)
-      { ","
-        SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
+        { ","
+          SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
                                             & (SymTab.ClassOf(s2) #
                                                SymTab.ClInt)
                                             & (SymTab.ClassOf(s2) #
@@ -463,8 +464,12 @@ PRODUCTIONS
                                            IF nc <= HIGH(idx) THEN
                                              idx[nc] := s2; INC(nc)
                                            END; .) }
+      |                                   (. nc := 0; isOpenA := TRUE; .) ]
       "OF"
-      Type<e>                           (. t := e;
+      Type<e>                           (. IF isOpenA THEN
+                                           t := SymTab.NewOpen(e)
+                                         ELSE
+                                           t := e;
                                            kk := nc;
                                            WHILE kk > 0 DO
                                              DEC(kk);
@@ -479,7 +484,8 @@ PRODUCTIONS
                                              END;
                                              t := SymTab.NewArrayB(t,
                                                      loA, hiA)
-                                           END; .) .
+                                           END
+                                         END; .) .
   RecordType <VAR t: SymTab.TypeIndex>
     = "RECORD"                          (. t := SymTab.NewRecord(); .)
       FieldSeq<t>
@@ -490,7 +496,11 @@ PRODUCTIONS
   Field <rt: SymTab.TypeIndex>
                                         (. VAR et: SymTab.TypeIndex; .)
     = [ FieldIdents<rt> ":"
-        Type<et>                       (. SymTab.FixPendingF(rt, et); .) ] .
+        Type<et>                       (. IF (et # SymTab.InvalidType)
+                                           & SymTab.IsOpen(et) THEN
+                                           SemError(230)
+                                         END;
+                                         SymTab.FixPendingF(rt, et); .) ] .
   FieldIdents <rt: SymTab.TypeIndex>
                                         (. VAR n: SymTab.Name; .)
     = GetIdent<n>                       (. IF ~SymTab.FieldPending(rt, n)
@@ -523,7 +533,7 @@ PRODUCTIONS
   Stat                                  (. VAR lx: INTEGER; .)
     = [ AssignOrCall | IfStat | CaseStat | WhileStat
       | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat
-      | NewStat | DispStat
+      | NewStat | DispStat | WriteIntStat | WriteStrStat
       | "EXIT"                 (. IF MGen.TopLoop(lx) THEN
                                     MGen.Jmp(lx)
                                   ELSE SemError(230) END; .) ] .
@@ -556,14 +566,12 @@ PRODUCTIONS
                                            END;
                                            IF storable & ~sfx
                                               & (dt # SymTab.InvalidType)
-                                              & (SymTab.ClassOf(dt)
-                                                 = SymTab.ClArray) THEN
-                                             elemDt := SymTab.ArrayElem(dt);
-                                             IF SymTab.ClassOf(elemDt)
-                                                = SymTab.ClChar THEN
-                                               MGen.PushAddr(bn);
-                                               pushedDst := TRUE
-                                             END
+                                              & ((SymTab.ClassOf(dt)
+                                                 = SymTab.ClArray)
+                                                 OR (SymTab.ClassOf(dt)
+                                                    = SymTab.ClRecord)) THEN
+                                             MGen.PushAddr(bn);
+                                             pushedDst := TRUE
                                            END;
                                            IF storable & ~sfx
                                               & ~pushedDst THEN
@@ -583,11 +591,13 @@ PRODUCTIONS
                                          ELSIF pushedDst THEN
                                            IF et = SymTab.InvalidType THEN
                                              MGen.Drop; MGen.Drop
-                                           ELSIF (SymTab.ClassOf(et)
-                                                 # SymTab.ClStr) THEN
-                                             SemError(230);
-                                             MGen.Drop; MGen.Drop
-                                           ELSE
+                                           ELSIF (SymTab.ClassOf(dt)
+                                                  = SymTab.ClArray)
+                                              & (SymTab.ClassOf(
+                                                 SymTab.ArrayElem(dt))
+                                                 = SymTab.ClChar)
+                                              & (SymTab.ClassOf(et)
+                                                 = SymTab.ClStr) THEN
                                              srcBytes :=
                                                MGen.StrLenOf(lxe) + 1;
                                              dstBytes :=
@@ -599,6 +609,15 @@ PRODUCTIONS
                                                MGen.PushBytes(srcBytes);
                                                MGen.CopyBlock
                                              END
+                                           ELSIF ~SymTab.Assignable(et,
+                                                     dt) THEN
+                                             SemError(210);
+                                             MGen.Drop; MGen.Drop
+                                           ELSE
+                                             dstBytes :=
+                                               SymTab.TypeSlots(dt) * 8;
+                                             MGen.PushBytes(dstBytes);
+                                             MGen.CopyBlock
                                            END
                                          ELSIF pushedFld THEN
                                            IF et = SymTab.InvalidType THEN
@@ -627,8 +646,10 @@ PRODUCTIONS
                                                SemError(210);
                                                MGen.Drop; MGen.Drop
                                              ELSE
-                                               SemError(230);
-                                               MGen.Drop; MGen.Drop
+                                               dstBytes :=
+                                                 SymTab.TypeSlots(dt) * 8;
+                                               MGen.PushBytes(dstBytes);
+                                               MGen.CopyBlock
                                              END
                                            ELSE
                                              IF ~SymTab.Assignable(et,
@@ -1107,6 +1128,41 @@ PRODUCTIONS
                                            MGen.PushBytes(slD * 8);
                                            MGen.DeallocOp
                                          END; .) .
+  WriteIntStat                          (. VAR t: SymTab.TypeIndex;
+                                             lx: MGen.LitStr;
+                                             v: BOOLEAN;
+                                             vn: SymTab.Name; .)
+    = "WriteInt"
+      "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
+                                           MGen.Drop
+                                         ELSIF ~SymTab.IsIntFamily(t) THEN
+                                           SemError(210);
+                                           MGen.Drop
+                                         ELSE
+                                           MGen.CallPrint
+                                         END; .) .
+  WriteStrStat                          (. VAR t: SymTab.TypeIndex;
+                                             lx: MGen.LitStr;
+                                             v: BOOLEAN;
+                                             vn: SymTab.Name; .)
+    = "WriteString"
+      "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
+                                           MGen.Drop
+                                         ELSIF (SymTab.ClassOf(t)
+                                                = SymTab.ClStr) THEN
+                                           MGen.PushInt(1);
+                                           MGen.SysCall
+                                         ELSIF (SymTab.ClassOf(t)
+                                                = SymTab.ClArray)
+                                            & (SymTab.ClassOf(
+                                               SymTab.ArrayElem(t))
+                                               = SymTab.ClChar) THEN
+                                           MGen.PushInt(1);
+                                           MGen.SysCall
+                                         ELSE
+                                           SemError(210);
+                                           MGen.Drop
+                                         END; .) .
 
   (* Expressions: Designator without ActualParameters (calls use
      CallTail). Each expression synthesizes its SymTab type in t,
@@ -1482,6 +1538,29 @@ PRODUCTIONS
              t := SymTab.InvalidType;
              MGen.Drop; MGen.Drop; MGen.PushInt(0)
            END
+         ELSIF (t # SymTab.InvalidType)
+            & (t2 # SymTab.InvalidType)
+            & (SymTab.ClassOf(t) = SymTab.ClArray)
+            & (SymTab.ClassOf(t2) = SymTab.ClArray)
+            & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
+            & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
+            & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
+           t := SymTab.BoolType();
+           MGen.PushBytes(SymTab.TypeSlots(t) * 8);
+           MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
+           MGen.StrComp;
+           IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
+           ELSIF (op = SymTab.OpNeq1)
+                 OR (op = SymTab.OpNeq2) THEN MGen.Or
+           ELSIF op = SymTab.OpLt THEN
+             MGen.Swap; MGen.Drop
+           ELSIF op = SymTab.OpLe THEN
+             MGen.Drop; MGen.Not
+           ELSIF op = SymTab.OpGt THEN
+             MGen.Drop
+           ELSE
+             MGen.Swap; MGen.Drop; MGen.Not
+           END
          ELSIF (t # SymTab.InvalidType)
             & (t2 # SymTab.InvalidType)
             & ((SymTab.ClassOf(t) = SymTab.ClArray)
@@ -1672,6 +1751,50 @@ PRODUCTIONS
                                            MGen.CopyName(s, lx);
                                            MGen.EmitString(s)
                                          END; .)
+    | "HIGH"
+      "(" DesignHead<dt, dk, bnF, FALSE, lxD>
+          DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
+      ")"                               (. lx[0] := 0C; v := FALSE;
+                                           IF dt = SymTab.InvalidType THEN
+                                             IF sfxF THEN MGen.Drop END;
+                                             MGen.PushInt(0);
+                                             t := SymTab.InvalidType
+                                           ELSIF SymTab.ClassOf(dt)
+                                                  # SymTab.ClArray THEN
+                                             SemError(217);
+                                             IF sfxF THEN MGen.Drop END;
+                                             MGen.PushInt(0);
+                                             t := SymTab.InvalidType
+                                           ELSIF SymTab.IsOpen(dt) THEN
+                                             IF sfxF THEN MGen.Drop END;
+                                             IF (dk = SymTab.KindParam)
+                                                OR (dk
+                                                 = SymTab.KindVarPar) THEN
+                                               IF SymTab.CurDepth()
+                                                  = SymTab.SymDepth(bnF) THEN
+                                                 MGen.LoadLocal(
+                                                   SymTab.SymSlot(bnF) + 1)
+                                               ELSE
+                                                 MGen.FrameAddr(
+                                                   SymTab.SymSlot(bnF) + 1,
+                                                   VAL(CARDINAL,
+                                                     SymTab.CurDepth() - 1
+                                                     - SymTab.SymDepth(bnF)));
+                                                 MGen.LoadIndir
+                                               END;
+                                               MGen.PushInt(1);
+                                               MGen.Sub;
+                                               t := SymTab.IntType()
+                                             ELSE
+                                               MGen.PushInt(0);
+                                               t := SymTab.InvalidType
+                                             END
+                                           ELSE
+                                             IF sfxF THEN MGen.Drop END;
+                                             MGen.PushInt(
+                                               SymTab.ArrayHi(dt));
+                                             t := SymTab.IntType()
+                                           END; .)
     | DesignHead<dt, dk, bnF, TRUE, lxD>
       DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
                                         (. t := dt;

+ 35 - 32
M2c.err

@@ -49,35 +49,38 @@
 | 48: Msg("'RETURN' expected")
 | 49: Msg("'NEW' expected")
 | 50: Msg("'DISPOSE' expected")
-| 51: Msg("'^' expected")
-| 52: Msg("'#' expected")
-| 53: Msg("'<>' expected")
-| 54: Msg("'<' expected")
-| 55: Msg("'<=' expected")
-| 56: Msg("'>' expected")
-| 57: Msg("'>=' expected")
-| 58: Msg("'IN' expected")
-| 59: Msg("'+' expected")
-| 60: Msg("'OR' expected")
-| 61: Msg("'*' expected")
-| 62: Msg("'/' expected")
-| 63: Msg("'DIV' expected")
-| 64: Msg("'MOD' expected")
-| 65: Msg("'AND' expected")
-| 66: Msg("'&' expected")
-| 67: Msg("'NOT' expected")
-| 68: Msg("'~' expected")
-| 69: Msg("'{' expected")
-| 70: Msg("'}' expected")
-| 71: Msg("not expected")
-| 72: Msg("invalid MulOp")
-| 73: Msg("invalid Fact")
-| 74: Msg("invalid AddOp")
-| 75: Msg("invalid Rel")
-| 76: Msg("invalid ByLit")
-| 77: Msg("invalid AssignOrCall")
-| 78: Msg("invalid SimpleType")
-| 79: Msg("invalid Type")
-| 80: Msg("invalid ProcedureDecl")
-| 81: Msg("invalid Declaration")
-| 82: Msg("invalid Import")
+| 51: Msg("'WriteInt' expected")
+| 52: Msg("'WriteString' expected")
+| 53: Msg("'^' expected")
+| 54: Msg("'#' expected")
+| 55: Msg("'<>' expected")
+| 56: Msg("'<' expected")
+| 57: Msg("'<=' expected")
+| 58: Msg("'>' expected")
+| 59: Msg("'>=' expected")
+| 60: Msg("'IN' expected")
+| 61: Msg("'+' expected")
+| 62: Msg("'OR' expected")
+| 63: Msg("'*' expected")
+| 64: Msg("'/' expected")
+| 65: Msg("'DIV' expected")
+| 66: Msg("'MOD' expected")
+| 67: Msg("'AND' expected")
+| 68: Msg("'&' expected")
+| 69: Msg("'HIGH' expected")
+| 70: Msg("'NOT' expected")
+| 71: Msg("'~' expected")
+| 72: Msg("'{' expected")
+| 73: Msg("'}' expected")
+| 74: Msg("not expected")
+| 75: Msg("invalid MulOp")
+| 76: Msg("invalid Fact")
+| 77: Msg("invalid AddOp")
+| 78: Msg("invalid Rel")
+| 79: Msg("invalid ByLit")
+| 80: Msg("invalid AssignOrCall")
+| 81: Msg("invalid SimpleType")
+| 82: Msg("invalid Type")
+| 83: Msg("invalid ProcedureDecl")
+| 84: Msg("invalid Declaration")
+| 85: Msg("invalid Import")

+ 1897 - 6
M2c.lst

@@ -15,15 +15,1906 @@ Undefined nonterminals:   -- none --
 Unreachable nonterminals: -- none --
 Circular derivations:     -- none --
 Underivable nonterminals: -- none --
-LL(1) conditions:         --  ok  --
+LL(1) conditions:
+ LL(1) error in ArrayType: "OF" is the start & successor of a deletable structure
+
+Listing:
+
+    1  COMPILER M2c
+    2  (* Modula-2 program modules with procedures and composites, MC64 backend
+    3     (see MGen for details).
+    4  
+    5     - program module only, no DEFINITION / IMPLEMENTATION split
+    6     - no local modules, no EXPORT, no PRIORITY
+    7     - procedures: declarations (nested), value and VAR parameters,
+    8       functions with RETURN, recursion, FORWARD headings;
+    9       no procedure types/variables, no cones
+   10     - composites (Phase 3): fixed ARRAYs (bounds, 1D/multi-D indexing,
+   11       unchecked, byte-packed CHAR/BOOLEAN), RECORDs (field offsets,
+   12       .field, WITH incl. nested), SETs (+ union, - difference,
+   13       * intersection, inclusive .. ranges), POINTERs (NEW/DISPOSE via
+   14       VM ALLOCATE, ^, NIL), strings (ARRAY OF CHAR literal assign).
+   15       Open arrays deferred; whole array/record copy deferred except
+   16       string literals; VAR actuals must be simple (no a[i]/p^/fields
+   17       as VAR actuals, 233); value composite params rejected (230);
+   18       composite function returns rejected (unchecked, avoid wrong LEAVE).
+   19     - statements: assignment, procedure call, IF, CASE, WHILE,
+   20       REPEAT, LOOP/EXIT, FOR, WITH, RETURN, NEW, DISPOSE
+   21     - symbol table (SymTab) with static type checking: error codes
+   22       200/201/202 and 210-224 (as before), plus 231 (procedure
+   23       forward mismatch or missing body), 232 (bad RETURN), 233
+   24       (invalid procedure call); same lenient rules (single pass,
+   25       declare-before-use, except POINTER bases may be same-scope
+   26       aliases with structural pointer compatibility in Assignable;
+   27       INTEGER, CARDINAL and subranges form one
+   28       integer family; no mixed INTEGER/REAL arithmetic; INTEGER
+   29       assigns to REAL; 1-character literal is CHAR; InvalidType
+   30       suppresses follow-on errors)
+   31     - backend (MGen): single-module MC64 image <ModName>.MC4,
+   32       runnable with mcint. Procedures take table entries 1..N
+   33       (0 = module body), run with ENTER frames, called via ED
+   34       (global), EC (directly nested) or EE (display walk); actuals
+   35       evaluate left-to-right into temps, then push reversed.
+   36       Lowered: scalar + composite globals/frame vars (multi-slot,
+   37       byte sizes, field/element offsets), CONST literals,
+   38       SET masks with literals/ranges/IN/=/#/+-/*; full scalar +
+   39       composite expressions (scaled indexing via IdxScale, field
+   40       via FieldAdd, deref via 41H/60H, byte ops 0DH/1DH for CHAR);
+   41       control flow via E0/E1 jumps; composite assign via
+   42       StoreIndir0/StoreByte (scalar elems) and copy_block (strings).
+   43       The rest parses and type-checks
+   44       but gets error 230: open arrays, whole array/record copy
+   45       (except string literals), value composite params/returns,
+   46       non-literal CONST expressions and BY steps,
+   47       EXIT outside LOOP, imported names used as values.
+   48     - test convention (the language has no I/O): a global
+   49         VAR ExitCode : INTEGER;
+   50       is printed as decimal + CRLF through an embedded helper;
+   51       without it the program just ends.
+   52     - known semantic edges: INTEGER DIV/MOD truncate toward zero;
+   53       CARDINAL past MAXINT compares as signed; AND/OR are eager;
+   54       REAL widens to binary64; unchecked ARRAY indexing (no DA/DB);
+   55       NIL dereference reads 0 (no static check, no VM trap yet);
+   56       CHAR/BOOLEAN arrays byte-packed (1 byte/elem, slots over-
+   57       allocated 8x); at most 64 procedures, 64 actuals
+   58       per call, 16 names per FP-section, 8-deep nested calls,
+   59       8-deep WITH, 1024 slots max per type. *)
+   60  
+   61  IMPORT SymTab, MGen;
+   62  
+   63  CHARACTERS
+   64    eol      = CHR(13) .
+   65    letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+   66    digit    = "0123456789" .
+   67    hexDigit = digit + "ABCDEF" .
+   68    noQuote1 = ANY - "'" - eol .
+   69    noQuote2 = ANY - '"' - eol .
+   70  
+   71  IGNORE CHR(9) .. CHR(13)
+   72  
+   73  COMMENTS
+   74    FROM "(*" TO "*)" NESTED
+   75  
+   76  TOKENS
+   77    ident   = letter { letter | digit } .
+   78    integer = digit { digit }
+   79            | digit { digit } CONTEXT("..")
+   80            | digit { hexDigit } "H" .
+   81    real    = digit { digit } "." { digit }
+   82              [ "E" [ "+" | "-" ] digit { digit } ] .
+   83    string  = "'" { noQuote1 } "'"
+   84            | '"' { noQuote2 } '"' .
+   85  
+   86  PRODUCTIONS
+   87    M2c                                   (. VAR m1, m2: SymTab.Name; .)
+   88      = "MODULE"
+   89        GetIdent<m1>                      (. SymTab.Init; MGen.OpenModule(m1);
+   90                                             IF ~SymTab.Enter(m1, SymTab.KindModule)
+   91                                             THEN SemError(200) END .)
+   92        ";"
+   93        { Import } Block<FALSE> GetIdent<m2>
+   94                                          (. IF ~SymTab.Equal(m1, m2)
+   95                                             THEN SemError(202) END .)
+   96        "."                               (. IF SymTab.AnyForward() THEN
+   97                                             SemError(231)
+   98                                           END;
+   99                                           MGen.EndModule;
+  100                                           SymTab.PrintTable; .) .
+  101    Import                                (. VAR n: SymTab.Name; .)
+  102      = "FROM"
+  103        GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+  104                                             THEN SemError(200) END .)
+  105        "IMPORT"
+  106        ImportList ";"
+  107      | "IMPORT"
+  108        ImportList ";" .
+  109    ImportList                            (. VAR n: SymTab.Name; .)
+  110      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
+  111                                             THEN SemError(200) END .)
+  112        { ","
+  113          GetIdent<n>                     (. IF ~SymTab.Enter(n, SymTab.KindImport)
+  114                                             THEN SemError(200) END .) } .
+  115    Block <isProc: BOOLEAN>               (. VAR began: BOOLEAN; .)
+  116      =                                   (. began := FALSE; .)
+  117        { Declaration }
+  118        [ "BEGIN"                         (. began := TRUE;
+  119                                             IF isProc THEN
+  120                                               MGen.ProcEntry(
+  121                                                 SymTab.CurProc(),
+  122                                                 SymTab.ProcNLocals())
+  123                                             ELSE MGen.BeginBody
+  124                                             END; .)
+  125          StatSeq ]
+  126        "END"                             (. IF isProc THEN
+  127                                             IF ~began THEN
+  128                                               MGen.ProcEntry(
+  129                                                 SymTab.CurProc(),
+  130                                                 SymTab.ProcNLocals())
+  131                                             END;
+  132                                             IF SymTab.InFunction() THEN
+  133                                               MGen.PushInt(0)
+  134                                             END;
+  135                                             MGen.Leave(SymTab.CurNPar(),
+  136                                               SymTab.InFunction())
+  137                                           END; .) .
+  138    Declaration = "CONST"
+  139                            {
+  140                              ConstDecl ";" }
+  141                | "TYPE"
+  142                            {
+  143                              TypeDecl ";" }
+  144                | "VAR"
+  145                            {
+  146                              VarDecl ";" }
+  147                | ProcedureDecl ";" .
+  148    ConstDecl                             (. VAR n: SymTab.Name;
+  149                                               t: SymTab.TypeIndex;
+  150                                               lx: MGen.LitStr;
+  151                                               cls: INTEGER; .)
+  152      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindConst)
+  153                                             THEN SemError(200) END .)
+  154        "="                               (. MGen.NoEmitEnter; .)
+  155        ConstExpr<t, lx>                  (. SymTab.SetSymType(n, t);
+  156                                             cls := SymTab.ClassOf(t);
+  157                                             IF cls = SymTab.ClStr THEN
+  158                                               SemError(230)
+  159                                             ELSIF ~MGen.IsLit(lx) THEN
+  160                                               SemError(230)
+  161                                             END;
+  162                                             MGen.DeclConst(n, lx, t);
+  163                                             MGen.NoEmitExit; .) .
+  164    ConstExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
+  165                                          (. VAR vD: BOOLEAN;
+  166                                               vnD: SymTab.Name; .)
+  167      = Expr<t, lx, vD, vnD> .
+  168    TypeDecl                              (. VAR n: SymTab.Name;
+  169                                               t0, t1: SymTab.TypeIndex; .)
+  170      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindType)
+  171                                             THEN SemError(200) END;
+  172                                             t0 := SymTab.NewAlias();
+  173                                             SymTab.SetSymType(n, t0); .)
+  174        "="
+  175        Type<t1>                          (. IF t1 = t0 THEN SemError(223);
+  176                                               SymTab.SetTarget(t0,
+  177                                                 SymTab.InvalidType)
+  178                                             ELSE SymTab.SetTarget(t0, t1) END; .) .
+  179    VarDecl                               (. VAR t: SymTab.TypeIndex;
+  180                                               i: CARDINAL;
+  181                                               nm: SymTab.Name;
+  182                                               cls: INTEGER;
+  183                                               sl: CARDINAL; .)
+  184      = VarIdents ":"
+  185        Type<t>                           (. cls := SymTab.ClassOf(t);
+  186                                             IF (cls # SymTab.ClInt)
+  187                                                & (cls # SymTab.ClReal)
+  188                                                & (cls # SymTab.ClBool)
+  189                                                & (cls # SymTab.ClChar)
+  190                                                & (cls # SymTab.ClEnum)
+  191                                                & (cls # SymTab.ClSet)
+  192                                                & (cls # SymTab.ClArray)
+  193                                                & (cls # SymTab.ClRecord)
+  194                                                & (cls # SymTab.ClPtr) THEN
+  195                                               SemError(230)
+  196                                             END;
+  197                                             sl := SymTab.TypeSlots(t);
+  198                                             IF sl = 0 THEN
+  199                                               SemError(230);
+  200                                               sl := 1
+  201                                             END;
+  202                                             i := 0;
+  203                                             WHILE i < SymTab.PendCount() DO
+  204                                               SymTab.PendName(i, nm);
+  205                                               IF SymTab.SymDepth(nm) = 0 THEN
+  206                                                 MGen.DeclVarSized(nm, sl)
+  207                                               END;
+  208                                               INC(i)
+  209                                             END;
+  210                                             SymTab.FixPending(t); .) .
+  211    VarIdents                             (. VAR n: SymTab.Name; .)
+  212      = GetIdent<n>                       (. IF ~SymTab.EnterPending(n,
+  213                                               SymTab.KindVar)
+  214                                             THEN SemError(200) END .)
+  215        { ","
+  216          GetIdent<n>                     (. IF ~SymTab.EnterPending(n,
+  217                                               SymTab.KindVar)
+  218                                             THEN SemError(200) END .) } .
+  219    ProcedureDecl                         (. VAR n, m: SymTab.Name;
+  220                                               rt: SymTab.TypeIndex;
+  221                                               hasR, ok: BOOLEAN;
+  222                                               endL: INTEGER; .)
+  223      = "PROCEDURE"                       (. hasR := FALSE; .)
+  224        GetIdent<n>                       (. IF SymTab.IsForward(n) THEN
+  225                                               SymTab.ReuseProc(n)
+  226                                             ELSIF ~SymTab.EnterProc(n) THEN
+  227                                               SemError(200)
+  228                                             END;
+  229                                             SymTab.OpenProcScope;
+  230                                             endL := MGen.NewLabel();
+  231                                             MGen.Jmp(endL); .)
+  232        [ "(" FormalParams ")" ]
+  233        [ ":" QualIdent<rt>               (. hasR := TRUE; .) ]
+  234                                          (. IF hasR THEN
+  235                                               ok := SymTab.SetProcRet(rt)
+  236                                             ELSE
+  237                                               ok := SymTab.SetProcRet(
+  238                                                       SymTab.InvalidType)
+  239                                             END;
+  240                                             IF ~ok THEN SemError(231) END;
+  241                                             IF ~SymTab.VerifyProc() THEN
+  242                                               SemError(231)
+  243                                             END; .)
+  244        ";"
+  245        ( Block<TRUE> GetIdent<m>         (. IF ~SymTab.Equal(n, m) THEN
+  246                                             SemError(202) END;
+  247                                             MGen.DefLabel(endL);
+  248                                             SymTab.CloseProc; .)
+  249        | "FORWARD"                     (. SymTab.SetForward;
+  250                                             SymTab.CloseProc;
+  251                                             MGen.DefLabel(endL); .) ) .
+  252    FormalParams = FPSection { ";" FPSection } .
+  253    FPSection                             (. VAR isV: BOOLEAN;
+  254                                               nn, i: CARDINAL;
+  255                                               pn: ARRAY [0 .. 15] OF SymTab.Name;
+  256                                               n: SymTab.Name;
+  257                                               t: SymTab.TypeIndex; .)
+  258      =                                   (. isV := FALSE; nn := 0; .)
+  259        [ "VAR"                           (. isV := TRUE; .) ]
+  260        GetIdent<n>                       (. IF nn <= HIGH(pn) THEN
+  261                                               MGen.CopyName(n, pn[nn])
+  262                                             END;
+  263                                             INC(nn); .)
+  264        { "," GetIdent<n>                 (. IF nn <= HIGH(pn) THEN
+  265                                               MGen.CopyName(n, pn[nn])
+  266                                             END;
+  267                                             INC(nn); .) }
+  268        ":" Type<t>                       (. IF ~isV
+  269                                                & (t # SymTab.InvalidType)
+  270                                                & (SymTab.TypeSlots(t) > 1) THEN
+  271                                               SemError(230)
+  272                                             END;
+  273                                             i := 0;
+  274                                             WHILE i < nn DO
+  275                                               IF i <= HIGH(pn) THEN
+  276                                                 IF ~SymTab.EnterParam(
+  277                                                      pn[i], isV, t) THEN
+  278                                                   SemError(200)
+  279                                                 END
+  280                                               END;
+  281                                               INC(i)
+  282                                             END; .) .
+  283    QualIdent <VAR t: SymTab.TypeIndex>
+  284                                          (. VAR n, m: SymTab.Name; .)
+  285      = GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+  286                                               SemError(201);
+  287                                               t := SymTab.InvalidType
+  288                                             ELSIF (SymTab.SymKind(n) #
+  289                                                    SymTab.KindType)
+  290                                               & (SymTab.SymKind(n) #
+  291                                                  SymTab.KindPredef)
+  292                                               & (SymTab.SymKind(n) #
+  293                                                  SymTab.KindImport) THEN
+  294                                               SemError(221);
+  295                                               t := SymTab.InvalidType
+  296                                             ELSE t := SymTab.SymType(n) END; .)
+  297        { "."
+  298          GetIdent<m>                     (. t := SymTab.InvalidType; .) } .
+  299  
+  300    (* Types: ProcedureType removed; subrange factored for LL(1) *)
+  301    Type <VAR t: SymTab.TypeIndex>
+  302      = SimpleType<t> | ArrayType<t> | RecordType<t>
+  303      | SetType<t> | PointerType<t> .
+  304    SimpleType <VAR t: SymTab.TypeIndex>
+  305                                          (. VAR t1, t2: SymTab.TypeIndex;
+  306                                               lx1, lx2: MGen.LitStr;
+  307                                               vD: BOOLEAN;
+  308                                               vnD: SymTab.Name;
+  309                                               loI, hiI: INTEGER;
+  310                                               lok, hik: BOOLEAN; .)
+  311      = QualIdent<t> [ "["
+  312                        (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE;
+  313                           loI := 0; hiI := -1; .)
+  314                        ConstExpr<t1, lx1> (. IF (t1 # SymTab.InvalidType)
+  315                                              & (SymTab.ClassOf(t1) #
+  316                                                 SymTab.ClInt)
+  317                                              & (SymTab.ClassOf(t1) #
+  318                                                 SymTab.ClChar)
+  319                                              & (SymTab.ClassOf(t1) #
+  320                                                 SymTab.ClEnum) THEN
+  321                                              SemError(224) END; .)
+  322                        ".."
+  323                        ConstExpr<t2, lx2> (. IF (t2 # SymTab.InvalidType)
+  324                                              & (SymTab.ClassOf(t2) #
+  325                                                 SymTab.ClInt)
+  326                                              & (SymTab.ClassOf(t2) #
+  327                                                 SymTab.ClChar)
+  328                                              & (SymTab.ClassOf(t2) #
+  329                                                 SymTab.ClEnum) THEN
+  330                                              SemError(224) END; .)
+  331                        "]"
+  332                                       (. IF (t1 # SymTab.InvalidType)
+  333                                           & (t2 # SymTab.InvalidType) THEN
+  334                                             IF MGen.IsLit(lx1) THEN
+  335                                               IF SymTab.ClassOf(t1)
+  336                                                  = SymTab.ClChar THEN
+  337                                                 loI := MGen.CharOrd(lx1);
+  338                                                 lok := TRUE
+  339                                               ELSIF MGen.ParseInt(lx1, loI) THEN
+  340                                                 lok := TRUE
+  341                                               END
+  342                                             END;
+  343                                             IF MGen.IsLit(lx2) THEN
+  344                                               IF SymTab.ClassOf(t2)
+  345                                                  = SymTab.ClChar THEN
+  346                                                 hiI := MGen.CharOrd(lx2);
+  347                                                 hik := TRUE
+  348                                               ELSIF MGen.ParseInt(lx2, hiI) THEN
+  349                                                 hik := TRUE
+  350                                               END
+  351                                             END
+  352                                           END;
+  353                                          IF lok & hik THEN
+  354                                            t := SymTab.NewSubB(t1, loI, hiI)
+  355                                          ELSE
+  356                                            t := SymTab.NewSub(t1);
+  357                                            IF (t1 # SymTab.InvalidType)
+  358                                               & (t2 # SymTab.InvalidType) THEN
+  359                                              SemError(230)
+  360                                            END
+  361                                          END;
+  362                                          MGen.NoEmitExit; .) ]
+  363      | "["                               (. MGen.NoEmitEnter; lok := FALSE;
+  364                                             hik := FALSE; loI := 0; hiI := -1; .)
+  365        ConstExpr<t1, lx1>                (. IF (t1 # SymTab.InvalidType)
+  366                                              & (SymTab.ClassOf(t1) #
+  367                                                 SymTab.ClInt)
+  368                                              & (SymTab.ClassOf(t1) #
+  369                                                 SymTab.ClChar)
+  370                                              & (SymTab.ClassOf(t1) #
+  371                                                 SymTab.ClEnum) THEN
+  372                                              SemError(224) END; .)
+  373        ".."
+  374        ConstExpr<t2, lx2>                (. IF (t2 # SymTab.InvalidType)
+  375                                              & (SymTab.ClassOf(t2) #
+  376                                                 SymTab.ClInt)
+  377                                              & (SymTab.ClassOf(t2) #
+  378                                                 SymTab.ClChar)
+  379                                              & (SymTab.ClassOf(t2) #
+  380                                                 SymTab.ClEnum) THEN
+  381                                              SemError(224) END; .)
+  382        "]"                               (. IF (t1 # SymTab.InvalidType)
+  383                                             & (t2 # SymTab.InvalidType) THEN
+  384                                               IF MGen.IsLit(lx1) THEN
+  385                                                 IF SymTab.ClassOf(t1)
+  386                                                    = SymTab.ClChar THEN
+  387                                                   loI := MGen.CharOrd(lx1);
+  388                                                   lok := TRUE
+  389                                                 ELSIF MGen.ParseInt(lx1,
+  390                                                           loI) THEN
+  391                                                   lok := TRUE
+  392                                                 END
+  393                                               END;
+  394                                               IF MGen.IsLit(lx2) THEN
+  395                                                 IF SymTab.ClassOf(t2)
+  396                                                    = SymTab.ClChar THEN
+  397                                                   hiI := MGen.CharOrd(lx2);
+  398                                                   hik := TRUE
+  399                                                 ELSIF MGen.ParseInt(lx2,
+  400                                                           hiI) THEN
+  401                                                   hik := TRUE
+  402                                                 END
+  403                                               END
+  404                                             END;
+  405                                            IF lok & hik THEN
+  406                                              t := SymTab.NewSubB(t1, loI, hiI)
+  407                                            ELSE
+  408                                              t := SymTab.NewSub(t1);
+  409                                              IF (t1 # SymTab.InvalidType)
+  410                                                 & (t2 # SymTab.InvalidType) THEN
+  411                                                SemError(230)
+  412                                              END
+  413                                            END;
+  414                                             MGen.NoEmitExit; .)
+  415      | Enum<t> .
+  416    Enum <VAR t: SymTab.TypeIndex>
+  417                                          (. VAR n: SymTab.Name;
+  418                                               ord: INTEGER; .)
+  419      = "("                               (. t := SymTab.NewEnum();
+  420                                             ord := 0; .)
+  421        GetIdent<n>                       (. IF ~SymTab.Enter(n,
+  422                                               SymTab.KindConst)
+  423                                             THEN SemError(200) END;
+  424                                             SymTab.SetSymType(n, t);
+  425                                             SymTab.EnumAdd(t);
+  426                                             MGen.DeclConstInt(n, ord);
+  427                                             INC(ord); .)
+  428        { ","
+  429          GetIdent<n>                     (. IF ~SymTab.Enter(n,
+  430                                               SymTab.KindConst)
+  431                                             THEN SemError(200) END;
+  432                                             SymTab.SetSymType(n, t);
+  433                                             SymTab.EnumAdd(t);
+  434                                             MGen.DeclConstInt(n, ord);
+  435                                             INC(ord); .) }
+  436        ")" .
+  437    ArrayType <VAR t: SymTab.TypeIndex>
+  438                                          (. VAR s, s2, e: SymTab.TypeIndex;
+  439                                               idx: ARRAY [0 .. 7] OF
+  440                                                 SymTab.TypeIndex;
+  441                                               nc, kk: CARDINAL;
+  442                                               loA, hiA: INTEGER;
+  443                                               isOpenA: BOOLEAN; .)
+  444      = "ARRAY"
+  445        [ SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+  446                                              & (SymTab.ClassOf(s) #
+  447                                                 SymTab.ClInt)
+  448                                              & (SymTab.ClassOf(s) #
+  449                                                 SymTab.ClChar)
+  450                                              & (SymTab.ClassOf(s) #
+  451                                                 SymTab.ClEnum) THEN
+  452                                              SemError(224) END;
+  453                                             nc := 0; isOpenA := FALSE;
+  454                                             idx[nc] := s; INC(nc); .)
+  455          { ","
+  456            SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
+  457                                              & (SymTab.ClassOf(s2) #
+  458                                                 SymTab.ClInt)
+  459                                              & (SymTab.ClassOf(s2) #
+  460                                                 SymTab.ClChar)
+  461                                              & (SymTab.ClassOf(s2) #
+  462                                                 SymTab.ClEnum) THEN
+  463                                              SemError(224) END;
+  464                                             IF nc <= HIGH(idx) THEN
+  465                                               idx[nc] := s2; INC(nc)
+  466                                             END; .) }
+  467        |                                   (. nc := 0; isOpenA := TRUE; .) ]
+  468        "OF"
+  469        Type<e>                           (. IF isOpenA THEN
+  470                                             t := SymTab.NewOpen(e)
+  471                                           ELSE
+  472                                             t := e;
+  473                                             kk := nc;
+  474                                             WHILE kk > 0 DO
+  475                                               DEC(kk);
+  476                                               loA := SymTab.TypeLo(idx[kk]);
+  477                                               hiA := SymTab.TypeHi(idx[kk]);
+  478                                               IF SymTab.TypeLen(idx[kk]) = 0 THEN
+  479                                                 IF idx[kk]
+  480                                                    # SymTab.InvalidType THEN
+  481                                                   SemError(230)
+  482                                                 END;
+  483                                                 loA := 0; hiA := -1
+  484                                               END;
+  485                                               t := SymTab.NewArrayB(t,
+  486                                                       loA, hiA)
+  487                                             END
+  488                                           END; .) .
+  489    RecordType <VAR t: SymTab.TypeIndex>
+  490      = "RECORD"                          (. t := SymTab.NewRecord(); .)
+  491        FieldSeq<t>
+  492        "END" .
+  493    FieldSeq <rt: SymTab.TypeIndex>
+  494      = Field<rt> { ";"
+  495                    Field<rt> } .
+  496    Field <rt: SymTab.TypeIndex>
+  497                                          (. VAR et: SymTab.TypeIndex; .)
+  498      = [ FieldIdents<rt> ":"
+  499          Type<et>                       (. IF (et # SymTab.InvalidType)
+  500                                             & SymTab.IsOpen(et) THEN
+  501                                             SemError(230)
+  502                                           END;
+  503                                           SymTab.FixPendingF(rt, et); .) ] .
+  504    FieldIdents <rt: SymTab.TypeIndex>
+  505                                          (. VAR n: SymTab.Name; .)
+  506      = GetIdent<n>                       (. IF ~SymTab.FieldPending(rt, n)
+  507                                             THEN SemError(200) END .)
+  508        { ","
+  509          GetIdent<n>                     (. IF ~SymTab.FieldPending(rt, n)
+  510                                             THEN SemError(200) END .) } .
+  511    SetType <VAR t: SymTab.TypeIndex>
+  512                                          (. VAR s: SymTab.TypeIndex; .)
+  513      = "SET"
+  514        "OF"
+  515        SimpleType<s>                     (. IF (s # SymTab.InvalidType)
+  516                                              & (SymTab.ClassOf(s) #
+  517                                                 SymTab.ClInt)
+  518                                              & (SymTab.ClassOf(s) #
+  519                                                 SymTab.ClChar)
+  520                                              & (SymTab.ClassOf(s) #
+  521                                                 SymTab.ClEnum) THEN
+  522                                              SemError(224) END;
+  523                                             t := SymTab.NewSet(s); .) .
+  524    PointerType <VAR t: SymTab.TypeIndex>
+  525                                          (. VAR b: SymTab.TypeIndex; .)
+  526      = "POINTER"
+  527        "TO"
+  528        Type<b>                           (. t := SymTab.NewPtr(b); .) .
+  529  
+  530    (* Statements: RETURN added; calls via AssignOrCall *)
+  531    StatSeq    = Stat { ";"
+  532                       Stat } .
+  533    Stat                                  (. VAR lx: INTEGER; .)
+  534      = [ AssignOrCall | IfStat | CaseStat | WhileStat
+  535        | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat
+  536        | NewStat | DispStat | WriteIntStat | WriteStrStat
+  537        | "EXIT"                 (. IF MGen.TopLoop(lx) THEN
+  538                                      MGen.Jmp(lx)
+  539                                    ELSE SemError(230) END; .) ] .
+  540    AssignOrCall                          (. VAR dt, et: SymTab.TypeIndex;
+  541                                               dk: INTEGER;
+  542                                               bn: SymTab.Name;
+  543                                               lxD, lxe: MGen.LitStr;
+  544                                               vE: BOOLEAN;
+  545                                               vnE: SymTab.Name;
+  546                                               sfx: BOOLEAN;
+  547                                               okC: BOOLEAN;
+  548                                               isR, conv,
+  549                                               storable, pushedDst,
+  550                                               pushedFld: BOOLEAN;
+  551                                               dstBytes, srcBytes: CARDINAL;
+  552                                               elemDt: SymTab.TypeIndex; .)
+  553      =                                   (. sfx := FALSE; pushedDst := FALSE;
+  554                                             pushedFld := FALSE; .)
+  555        DesignHead<dt, dk, bn, FALSE, lxD>
+  556        ( DesignTail<dt, dk, bn, FALSE, lxD, sfx> ":="
+  557                                          (. storable :=
+  558                                               (dk = SymTab.KindVar)
+  559                                               OR (dk = SymTab.KindParam)
+  560                                               OR (dk = SymTab.KindVarPar);
+  561                                             IF (dk = SymTab.KindField)
+  562                                                & (~sfx)
+  563                                                & (dt # SymTab.InvalidType) THEN
+  564                                               MGen.WithAddr(bn);
+  565                                               pushedFld := TRUE
+  566                                             END;
+  567                                             IF storable & ~sfx
+  568                                                & (dt # SymTab.InvalidType)
+  569                                                & ((SymTab.ClassOf(dt)
+  570                                                   = SymTab.ClArray)
+  571                                                   OR (SymTab.ClassOf(dt)
+  572                                                      = SymTab.ClRecord)) THEN
+  573                                               MGen.PushAddr(bn);
+  574                                               pushedDst := TRUE
+  575                                             END;
+  576                                             IF storable & ~sfx
+  577                                                & ~pushedDst THEN
+  578                                               IF (dt # SymTab.InvalidType)
+  579                                                  & (SymTab.TypeSlots(dt)
+  580                                                     > 1) THEN
+  581                                               ELSE MGen.StoreSetup(bn)
+  582                                               END
+  583                                             END; .)
+  584          Expr<et, lxe, vE, vnE>                                                  (. IF (dt # SymTab.InvalidType)
+  585                                             & (dk # SymTab.KindVar)
+  586                                             & (dk # SymTab.KindParam)
+  587                                             & (dk # SymTab.KindVarPar)
+  588                                             & (dk # SymTab.KindField)
+  589                                             & (dk # SymTab.KindImport) THEN
+  590                                             SemError(210)
+  591                                           ELSIF pushedDst THEN
+  592                                             IF et = SymTab.InvalidType THEN
+  593                                               MGen.Drop; MGen.Drop
+  594                                             ELSIF (SymTab.ClassOf(dt)
+  595                                                    = SymTab.ClArray)
+  596                                                & (SymTab.ClassOf(
+  597                                                   SymTab.ArrayElem(dt))
+  598                                                   = SymTab.ClChar)
+  599                                                & (SymTab.ClassOf(et)
+  600                                                   = SymTab.ClStr) THEN
+  601                                               srcBytes :=
+  602                                                 MGen.StrLenOf(lxe) + 1;
+  603                                               dstBytes :=
+  604                                                 SymTab.TypeSlots(dt) * 8;
+  605                                               IF srcBytes > dstBytes THEN
+  606                                                 SemError(210);
+  607                                                 MGen.Drop; MGen.Drop
+  608                                               ELSE
+  609                                                 MGen.PushBytes(srcBytes);
+  610                                                 MGen.CopyBlock
+  611                                               END
+  612                                             ELSIF ~SymTab.Assignable(et,
+  613                                                       dt) THEN
+  614                                               SemError(210);
+  615                                               MGen.Drop; MGen.Drop
+  616                                             ELSE
+  617                                               dstBytes :=
+  618                                                 SymTab.TypeSlots(dt) * 8;
+  619                                               MGen.PushBytes(dstBytes);
+  620                                               MGen.CopyBlock
+  621                                             END
+  622                                           ELSIF pushedFld THEN
+  623                                             IF et = SymTab.InvalidType THEN
+  624                                               MGen.Drop; MGen.Drop
+  625                                             ELSIF (SymTab.TypeSlots(dt) > 1) THEN
+  626                                               IF (SymTab.ClassOf(dt)
+  627                                                  = SymTab.ClArray)
+  628                                                  & (SymTab.ClassOf(
+  629                                                     SymTab.ArrayElem(dt))
+  630                                                     = SymTab.ClChar)
+  631                                                  & (SymTab.ClassOf(et)
+  632                                                     = SymTab.ClStr) THEN
+  633                                                 srcBytes :=
+  634                                                   MGen.StrLenOf(lxe) + 1;
+  635                                                 dstBytes :=
+  636                                                   SymTab.TypeSlots(dt) * 8;
+  637                                                 IF srcBytes > dstBytes THEN
+  638                                                   SemError(210);
+  639                                                   MGen.Drop; MGen.Drop
+  640                                                 ELSE
+  641                                                   MGen.PushBytes(srcBytes);
+  642                                                   MGen.CopyBlock
+  643                                                 END
+  644                                               ELSIF ~SymTab.Assignable(et,
+  645                                                         dt) THEN
+  646                                                 SemError(210);
+  647                                                 MGen.Drop; MGen.Drop
+  648                                               ELSE
+  649                                                 dstBytes :=
+  650                                                   SymTab.TypeSlots(dt) * 8;
+  651                                                 MGen.PushBytes(dstBytes);
+  652                                                 MGen.CopyBlock
+  653                                               END
+  654                                             ELSE
+  655                                               IF ~SymTab.Assignable(et,
+  656                                                         dt) THEN
+  657                                                 SemError(210);
+  658                                                 MGen.Drop; MGen.Drop
+  659                                               ELSE
+  660                                                 isR :=
+  661                                                   (SymTab.ClassOf(dt)
+  662                                                    = SymTab.ClReal);
+  663                                                 conv := isR
+  664                                                   & SymTab.IsIntFamily(et);
+  665                                                 IF conv THEN
+  666                                                   MGen.IntToReal
+  667                                                 END;
+  668                                                 IF (SymTab.ClassOf(dt)
+  669                                                    = SymTab.ClChar)
+  670                                                    OR (SymTab.ClassOf(dt)
+  671                                                       = SymTab.ClBool) THEN
+  672                                                   MGen.StoreByte
+  673                                                 ELSE MGen.StoreIndir0
+  674                                                 END
+  675                                               END
+  676                                             END
+  677                                           ELSIF (dt # SymTab.InvalidType)
+  678                                             & ~sfx
+  679                                             & (SymTab.TypeSlots(dt) > 1) THEN
+  680                                             IF ~SymTab.Assignable(et, dt) THEN
+  681                                               SemError(210)
+  682                                             ELSE SemError(230)
+  683                                             END
+  684                                           ELSIF ~SymTab.Assignable(et, dt) THEN
+  685                                             SemError(210) END;
+  686                                           IF dk = SymTab.KindImport THEN
+  687                                             SemError(230)
+  688                                           END;
+  689                                           isR := (dt # SymTab.InvalidType)
+  690                                                  & ~pushedDst
+  691                                                  & ~pushedFld
+  692                                                  & (SymTab.ClassOf(dt)
+  693                                                     = SymTab.ClReal);
+  694                                           conv := isR
+  695                                                   & SymTab.IsIntFamily(et);
+  696                                           IF pushedDst THEN
+  697                                           ELSIF pushedFld THEN
+  698                                           ELSIF (dt # SymTab.InvalidType)
+  699                                              & sfx THEN
+  700                                             IF conv THEN
+  701                                               MGen.IntToReal
+  702                                             END;
+  703                                             IF (SymTab.ClassOf(dt)
+  704                                                = SymTab.ClChar)
+  705                                                OR (SymTab.ClassOf(dt)
+  706                                                   = SymTab.ClBool) THEN
+  707                                               MGen.StoreByte
+  708                                             ELSE MGen.StoreIndir0
+  709                                             END
+  710                                           ELSIF storable & ~sfx THEN
+  711                                             IF (dt # SymTab.InvalidType)
+  712                                                & (SymTab.TypeSlots(dt)
+  713                                                   > 1) THEN
+  714                                               MGen.Drop
+  715                                             ELSE
+  716                                               IF conv THEN
+  717                                                 MGen.IntToReal
+  718                                               END;
+  719                                               MGen.StoreFinish(bn)
+  720                                             END
+  721                                           ELSE MGen.Drop
+  722                                           END; .)
+  723        | CallTail<bn, sfx, FALSE, okC, FALSE>
+  724        |                             (. MGen.ActBegin(bn);
+  725                                         IF MGen.ActEnd(bn, FALSE, FALSE) # 0 THEN
+  726                                           SemError(233)
+  727                                         END; .) ) .
+  728    CallTail <pn: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN;
+  729              VAR ok: BOOLEAN; hasDead: BOOLEAN>
+  730                                          (. VAR t: SymTab.TypeIndex;
+  731                                               lx: MGen.LitStr;
+  732                                               v: BOOLEAN;
+  733                                               vn: SymTab.Name; .)
+  734      = "("                               (. ok := FALSE;
+  735                                             IF hasDead THEN MGen.Drop END;
+  736                                             MGen.ActBegin(pn); .)
+  737        [ Expr<t, lx, v, vn>              (. IF MGen.ActValue(t, v, vn) # 0 THEN
+  738                                             SemError(233)
+  739                                           END; .)
+  740          { "," Expr<t, lx, v, vn>        (. IF MGen.ActValue(t, v, vn) # 0 THEN
+  741                                             SemError(233)
+  742                                           END; .) } ]
+  743        ")"                               (. IF MGen.ActEnd(pn, sfx, inExpr) # 0
+  744                                           THEN SemError(233)
+  745                                           ELSE ok := TRUE
+  746                                           END; .) .
+  747    IfStat                                (. VAR t: SymTab.TypeIndex;
+  748                                               lxC: MGen.LitStr;
+  749                                               vC: BOOLEAN;
+  750                                               vnC: SymTab.Name;
+  751                                               elseL, endL: INTEGER;
+  752                                               hasElse: BOOLEAN; .)
+  753      = "IF"
+  754        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
+  755                                             SemError(214) END;
+  756                                             elseL := MGen.NewLabel();
+  757                                             endL := MGen.NewLabel();
+  758                                             MGen.Jz(elseL);
+  759                                             hasElse := FALSE; .)
+  760        "THEN"
+  761        StatSeq
+  762        { "ELSIF"                         (. MGen.Jmp(endL);
+  763                                             MGen.DefLabel(elseL); .)
+  764          Expr<t, lxC, vC, vnC>           (. IF ~SymTab.BoolCheck(t) THEN
+  765                                             SemError(214) END;
+  766                                             elseL := MGen.NewLabel();
+  767                                             MGen.Jz(elseL); .)
+  768          "THEN"
+  769          StatSeq }
+  770        [ "ELSE"                          (. MGen.Jmp(endL);
+  771                                             MGen.DefLabel(elseL);
+  772                                             hasElse := TRUE; .)
+  773          StatSeq ]
+  774        "END"                             (. IF ~hasElse THEN
+  775                                             MGen.DefLabel(elseL)
+  776                                           END;
+  777                                           MGen.DefLabel(endL); .) .
+  778    CaseStat                              (. VAR st: SymTab.TypeIndex;
+  779                                               lxS: MGen.LitStr;
+  780                                               vS: BOOLEAN;
+  781                                               vnS: SymTab.Name;
+  782                                               tmp, endL: INTEGER; .)
+  783      = "CASE"
+  784        Expr<st, lxS, vS, vnS>            (. tmp := MGen.TempGlobal();
+  785                                             MGen.StoreTemp(tmp);
+  786                                             endL := MGen.NewLabel(); .)
+  787        "OF"
+  788        Case<st, tmp, endL> { "|"
+  789                   Case<st, tmp, endL> }
+  790        [ "ELSE"
+  791          StatSeq ]
+  792        "END"                             (. MGen.DefLabel(endL); .) .
+  793    Case <sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER>
+  794                                          (. VAR lB, lN: INTEGER; .)
+  795      = [ LabelList<sel, tmp, lB, lN> ":" (. MGen.DefLabel(lB); .)
+  796          StatSeq                         (. MGen.Jmp(endL);
+  797                                             MGen.DefLabel(lN); .) ] .
+  798    LabelList <sel: SymTab.TypeIndex; tmp: INTEGER;
+  799               VAR lB: INTEGER; VAR lN: INTEGER>
+  800      =                                   (. lB := MGen.NewLabel();
+  801                                             lN := MGen.NewLabel(); .)
+  802        Labels<sel, tmp, lB> { ","
+  803                      Labels<sel, tmp, lB> }
+  804                                          (. MGen.Jmp(lN); .) .
+  805    Labels <sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER>
+  806                                          (. VAR t, t2: SymTab.TypeIndex;
+  807                                               lx1, lx2: MGen.LitStr;
+  808                                               v1, v2: BOOLEAN;
+  809                                               vn1, vn2: SymTab.Name;
+  810                                               ta, tb, chunk: INTEGER;
+  811                                               r, hasRange: BOOLEAN; .)
+  812      = ConstExpr<t, lx1>                 (. IF ~SymTab.EqCheck(t, sel) THEN
+  813                                             SemError(213) END;
+  814                                             r := (SymTab.ClassOf(sel)
+  815                                                   = SymTab.ClReal)
+  816                                                  & (SymTab.ClassOf(t)
+  817                                                     = SymTab.ClReal);
+  818                                             ta := MGen.TempGlobal();
+  819                                             MGen.StoreTemp(ta);
+  820                                             hasRange := FALSE; .)
+  821        [ ".."
+  822          ConstExpr<t2, lx2>              (. IF ~SymTab.EqCheck(t2, sel) THEN
+  823                                             SemError(213) END;
+  824                                             tb := MGen.TempGlobal();
+  825                                             MGen.StoreTemp(tb);
+  826                                             hasRange := TRUE; .) ]
+  827                                          (. IF hasRange THEN
+  828                                               MGen.LoadTemp(tmp);
+  829                                               MGen.LoadTemp(ta);
+  830                                               IF r THEN MGen.RealGe
+  831                                               ELSE MGen.IGe END;
+  832                                               MGen.LoadTemp(tmp);
+  833                                               MGen.LoadTemp(tb);
+  834                                               IF r THEN MGen.RealLe
+  835                                               ELSE MGen.ILe END;
+  836                                               MGen.And
+  837                                             ELSE
+  838                                               MGen.LoadTemp(tmp);
+  839                                               MGen.LoadTemp(ta);
+  840                                               IF r THEN MGen.RealEq
+  841                                               ELSE MGen.Eq END
+  842                                             END;
+  843                                             chunk := MGen.NewLabel();
+  844                                             MGen.Jz(chunk);
+  845                                             MGen.Jmp(bodyL);
+  846                                             MGen.DefLabel(chunk); .) .
+  847    WhileStat                             (. VAR t: SymTab.TypeIndex;
+  848                                               lxC: MGen.LitStr;
+  849                                               vC: BOOLEAN;
+  850                                               vnC: SymTab.Name;
+  851                                               topL, endL: INTEGER; .)
+  852      = "WHILE"                           (. topL := MGen.NewLabel();
+  853                                             endL := MGen.NewLabel();
+  854                                             MGen.DefLabel(topL); .)
+  855        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
+  856                                             SemError(214) END;
+  857                                             MGen.Jz(endL); .)
+  858        "DO"
+  859        StatSeq
+  860        "END"                             (. MGen.Jmp(topL);
+  861                                             MGen.DefLabel(endL); .) .
+  862    RepeatStat                            (. VAR t: SymTab.TypeIndex;
+  863                                               lxC: MGen.LitStr;
+  864                                               vC: BOOLEAN;
+  865                                               vnC: SymTab.Name;
+  866                                               topL: INTEGER; .)
+  867      = "REPEAT"                          (. topL := MGen.NewLabel();
+  868                                             MGen.DefLabel(topL); .)
+  869        StatSeq
+  870        "UNTIL"
+  871        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
+  872                                             SemError(214) END;
+  873                                             MGen.Jz(topL); .) .
+  874    LoopStat                              (. VAR topL, exitL: INTEGER; .)
+  875      = "LOOP"                            (. topL := MGen.NewLabel();
+  876                                             exitL := MGen.NewLabel();
+  877                                             MGen.DefLabel(topL);
+  878                                             MGen.PushLoop(exitL); .)
+  879        StatSeq
+  880        "END"                             (. MGen.Jmp(topL);
+  881                                             MGen.DefLabel(exitL);
+  882                                             MGen.PopLoop; .) .
+  883    ForStat                               (. VAR n, lv: SymTab.Name;
+  884                                               fk: INTEGER;
+  885                                               lo, hi: SymTab.TypeIndex;
+  886                                               lxLo, lxHi: MGen.LitStr;
+  887                                               vLo, vHi: BOOLEAN;
+  888                                               vnLo, vnHi: SymTab.Name;
+  889                                               byV, ht: INTEGER;
+  890                                               lTop, lChk, lEnd: INTEGER;
+  891                                               neg, storable: BOOLEAN; .)
+  892      = "FOR"
+  893        GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
+  894                                              SemError(201);
+  895                                              fk := -1
+  896                                            ELSIF (SymTab.SymKind(n) #
+  897                                                   SymTab.KindVar)
+  898                                              & (SymTab.SymKind(n) #
+  899                                                 SymTab.KindParam)
+  900                                              & (SymTab.SymKind(n) #
+  901                                                 SymTab.KindVarPar)
+  902                                              & (SymTab.SymKind(n) #
+  903                                                 SymTab.KindField) THEN
+  904                                              SemError(220);
+  905                                              fk := -1
+  906                                            ELSIF (SymTab.SymType(n) #
+  907                                                   SymTab.InvalidType)
+  908                                              & ~SymTab.IsIntFamily(
+  909                                                  SymTab.SymType(n)) THEN
+  910                                              SemError(220);
+  911                                              fk := -1
+  912                                            ELSE
+  913                                              fk := SymTab.SymKind(n)
+  914                                            END;
+  915                                            MGen.CopyName(n, lv);
+  916                                            storable := (fk = SymTab.KindVar)
+  917                                              OR (fk = SymTab.KindParam)
+  918                                              OR (fk = SymTab.KindVarPar);
+  919                                            IF storable THEN
+  920                                              MGen.StoreSetup(lv)
+  921                                            END; .)
+  922        ":="
+  923        Expr<lo, lxLo, vLo, vnLo>         (. IF (lo # SymTab.InvalidType)
+  924                                             & ~SymTab.IsIntFamily(lo) THEN
+  925                                             SemError(220) END;
+  926                                             IF storable THEN
+  927                                               MGen.StoreFinish(lv)
+  928                                             ELSE MGen.Drop
+  929                                             END; .)
+  930        "TO"
+  931        Expr<hi, lxHi, vHi, vnHi>         (. IF (hi # SymTab.InvalidType)
+  932                                             & ~SymTab.IsIntFamily(hi) THEN
+  933                                             SemError(220) END;
+  934                                             ht := MGen.TempGlobal();
+  935                                             MGen.StoreTemp(ht);
+  936                                             byV := 1; neg := FALSE; .)
+  937        [ "BY"
+  938          ByLit<byV>                      (. neg := byV < 0; .) ]
+  939        "DO"                              (. lTop := MGen.NewLabel();
+  940                                             lChk := MGen.NewLabel();
+  941                                             lEnd := MGen.NewLabel();
+  942                                             MGen.Jmp(lChk);
+  943                                             MGen.DefLabel(lTop); .)
+  944        StatSeq
+  945        "END"                             (. MGen.PushVar(lv);
+  946                                             MGen.PushInt(byV);
+  947                                             MGen.Add;
+  948                                             IF storable THEN
+  949                                               MGen.StoreFinish(lv)
+  950                                             ELSE MGen.Drop
+  951                                             END;
+  952                                             MGen.DefLabel(lChk);
+  953                                             MGen.PushVar(lv);
+  954                                             MGen.LoadTemp(ht);
+  955                                             IF neg THEN MGen.IGe
+  956                                             ELSE MGen.ILe END;
+  957                                             MGen.Jz(lEnd);
+  958                                             MGen.Jmp(lTop);
+  959                                             MGen.DefLabel(lEnd); .) .
+  960    ByLit <VAR v: INTEGER>                (. VAR s: ARRAY [0 .. 255] OF CHAR; .)
+  961      = integer                           (. LexString(s);
+  962                                             IF ~MGen.ParseInt(s, v) THEN
+  963                                               v := 1
+  964                                             END; .)
+  965      | "-" integer                       (. LexString(s);
+  966                                             IF MGen.ParseInt(s, v) THEN
+  967                                               v := -v
+  968                                             ELSE v := -1
+  969                                             END; .) .
+  970    WithStat                              (. VAR dt: SymTab.TypeIndex;
+  971                                               dk: INTEGER;
+  972                                               bnW: SymTab.Name;
+  973                                               lxW: MGen.LitStr;
+  974                                               sfxW: BOOLEAN;
+  975                                               pushed: BOOLEAN; .)
+  976      = "WITH"
+  977        DesignHead<dt, dk, bnW, FALSE, lxW>
+  978        DesignTail<dt, dk, bnW, FALSE, lxW, sfxW>
+  979                                        (. pushed := FALSE;
+  980                                             IF dt = SymTab.InvalidType THEN
+  981                                               IF sfxW THEN MGen.Drop END
+  982                                             ELSIF SymTab.ClassOf(dt)
+  983                                                    # SymTab.ClRecord THEN
+  984                                               SemError(215);
+  985                                               IF sfxW THEN MGen.Drop END
+  986                                             ELSE
+  987                                               IF ~sfxW THEN
+  988                                                 IF (dk
+  989                                                    = SymTab.KindVar)
+  990                                                    OR (dk
+  991                                                       = SymTab.KindParam)
+  992                                                    OR (dk
+  993                                                    = SymTab.KindVarPar) THEN
+  994                                                   MGen.PushAddr(bnW)
+  995                                                 ELSIF dk
+  996                                                   = SymTab.KindField THEN
+  997                                                   MGen.WithAddr(bnW)
+  998                                                 ELSE MGen.PushInt(0)
+  999                                                 END
+ 1000                                               END;
+ 1001                                               MGen.WithEnter(dt);
+ 1002                                               pushed :=
+ 1003                                                 SymTab.PushRecord(dt);
+ 1004                                               IF ~pushed THEN
+ 1005                                                 SemError(215)
+ 1006                                               END
+ 1007                                             END; .)
+ 1008        "DO"
+ 1009        StatSeq
+ 1010        "END"                             (. IF pushed THEN
+ 1011                                               SymTab.PopScope;
+ 1012                                               MGen.WithExit
+ 1013                                             END; .) .
+ 1014    ReturnStat                            (. VAR t: SymTab.TypeIndex;
+ 1015                                               lx: MGen.LitStr;
+ 1016                                               v: BOOLEAN;
+ 1017                                               vn: SymTab.Name;
+ 1018                                               hasE, doRet, conv: BOOLEAN; .)
+ 1019      = "RETURN"                          (. hasE := FALSE; .)
+ 1020        [ Expr<t, lx, v, vn>              (. hasE := TRUE;
+ 1021                                             doRet := FALSE;
+ 1022                                             IF ~SymTab.InProc() THEN
+ 1023                                               SemError(232)
+ 1024                                             ELSIF ~SymTab.InFunction() THEN
+ 1025                                               SemError(232)
+ 1026                                             ELSIF ~SymTab.Assignable(
+ 1027                                                       t, SymTab.CurRet()) THEN
+ 1028                                               SemError(232)
+ 1029                                             ELSE doRet := TRUE
+ 1030                                             END;
+ 1031                                             conv := doRet
+ 1032                                                     & SymTab.IsIntFamily(t)
+ 1033                                                     & (SymTab.ClassOf(
+ 1034                                                          SymTab.CurRet())
+ 1035                                                        = SymTab.ClReal);
+ 1036                                             IF doRet THEN
+ 1037                                               IF conv THEN
+ 1038                                                 MGen.IntToReal
+ 1039                                               END;
+ 1040                                               MGen.Leave(
+ 1041                                                 SymTab.CurNPar(), TRUE)
+ 1042                                             ELSE MGen.Drop
+ 1043                                             END; .) ]
+ 1044                                           (. IF ~hasE THEN
+ 1045                                               IF ~SymTab.InProc() THEN
+ 1046                                                 SemError(232)
+ 1047                                               ELSIF SymTab.InFunction() THEN
+ 1048                                                 SemError(232)
+ 1049                                               ELSE MGen.Leave(
+ 1050                                                 SymTab.CurNPar(), FALSE)
+ 1051                                               END
+ 1052                                             END; .) .
+ 1053    NewStat                               (. VAR dt: SymTab.TypeIndex;
+ 1054                                               dk: INTEGER;
+ 1055                                               bnN: SymTab.Name;
+ 1056                                               lxN: MGen.LitStr;
+ 1057                                               sfxN: BOOLEAN;
+ 1058                                               baseT: SymTab.TypeIndex;
+ 1059                                               slN: CARDINAL; .)
+ 1060      = "NEW"
+ 1061        "(" DesignHead<dt, dk, bnN, FALSE, lxN>
+ 1062            DesignTail<dt, dk, bnN, FALSE, lxN, sfxN>
+ 1063        ")"                               (. IF dt = SymTab.InvalidType THEN
+ 1064                                             IF sfxN THEN MGen.Drop END
+ 1065                                           ELSIF SymTab.ClassOf(dt)
+ 1066                                                  # SymTab.ClPtr THEN
+ 1067                                             SemError(219);
+ 1068                                             IF sfxN THEN MGen.Drop END
+ 1069                                           ELSE
+ 1070                                             baseT := SymTab.PtrBase(dt);
+ 1071                                             slN := SymTab.TypeSlots(baseT);
+ 1072                                             IF slN = 0 THEN
+ 1073                                               SemError(230);
+ 1074                                               slN := 1
+ 1075                                             END;
+ 1076                                             IF ~sfxN THEN
+ 1077                                               IF (dk = SymTab.KindVar)
+ 1078                                                  OR (dk
+ 1079                                                      = SymTab.KindParam)
+ 1080                                                  OR (dk
+ 1081                                                   = SymTab.KindVarPar) THEN
+ 1082                                                 MGen.PushAddr(bnN)
+ 1083                                               ELSIF dk
+ 1084                                                 = SymTab.KindField THEN
+ 1085                                                 MGen.WithAddr(bnN)
+ 1086                                               ELSE MGen.PushInt(0)
+ 1087                                               END
+ 1088                                             END;
+ 1089                                             MGen.PushBytes(slN * 8);
+ 1090                                             MGen.AllocOp
+ 1091                                           END; .) .
+ 1092    DispStat                              (. VAR dt: SymTab.TypeIndex;
+ 1093                                               dk: INTEGER;
+ 1094                                               bnD: SymTab.Name;
+ 1095                                               lxD: MGen.LitStr;
+ 1096                                               sfxD: BOOLEAN;
+ 1097                                               baseT: SymTab.TypeIndex;
+ 1098                                               slD: CARDINAL; .)
+ 1099      = "DISPOSE"
+ 1100        "(" DesignHead<dt, dk, bnD, FALSE, lxD>
+ 1101            DesignTail<dt, dk, bnD, FALSE, lxD, sfxD>
+ 1102        ")"                               (. IF dt = SymTab.InvalidType THEN
+ 1103                                             IF sfxD THEN MGen.Drop END
+ 1104                                           ELSIF SymTab.ClassOf(dt)
+ 1105                                                  # SymTab.ClPtr THEN
+ 1106                                             SemError(219);
+ 1107                                             IF sfxD THEN MGen.Drop END
+ 1108                                           ELSE
+ 1109                                             baseT := SymTab.PtrBase(dt);
+ 1110                                             slD := SymTab.TypeSlots(baseT);
+ 1111                                             IF slD = 0 THEN
+ 1112                                               SemError(230);
+ 1113                                               slD := 1
+ 1114                                             END;
+ 1115                                             IF ~sfxD THEN
+ 1116                                               IF (dk = SymTab.KindVar)
+ 1117                                                  OR (dk
+ 1118                                                      = SymTab.KindParam)
+ 1119                                                  OR (dk
+ 1120                                                   = SymTab.KindVarPar) THEN
+ 1121                                                 MGen.PushAddr(bnD)
+ 1122                                               ELSIF dk
+ 1123                                                 = SymTab.KindField THEN
+ 1124                                                 MGen.WithAddr(bnD)
+ 1125                                               ELSE MGen.PushInt(0)
+ 1126                                               END
+ 1127                                             END;
+ 1128                                             MGen.PushBytes(slD * 8);
+ 1129                                             MGen.DeallocOp
+ 1130                                           END; .) .
+ 1131    WriteIntStat                          (. VAR t: SymTab.TypeIndex;
+ 1132                                               lx: MGen.LitStr;
+ 1133                                               v: BOOLEAN;
+ 1134                                               vn: SymTab.Name; .)
+ 1135      = "WriteInt"
+ 1136        "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
+ 1137                                             MGen.Drop
+ 1138                                           ELSIF ~SymTab.IsIntFamily(t) THEN
+ 1139                                             SemError(210);
+ 1140                                             MGen.Drop
+ 1141                                           ELSE
+ 1142                                             MGen.CallPrint
+ 1143                                           END; .) .
+ 1144    WriteStrStat                          (. VAR t: SymTab.TypeIndex;
+ 1145                                               lx: MGen.LitStr;
+ 1146                                               v: BOOLEAN;
+ 1147                                               vn: SymTab.Name; .)
+ 1148      = "WriteString"
+ 1149        "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
+ 1150                                             MGen.Drop
+ 1151                                           ELSIF (SymTab.ClassOf(t)
+ 1152                                                  = SymTab.ClStr) THEN
+ 1153                                             MGen.PushInt(1);
+ 1154                                             MGen.SysCall
+ 1155                                           ELSIF (SymTab.ClassOf(t)
+ 1156                                                  = SymTab.ClArray)
+ 1157                                              & (SymTab.ClassOf(
+ 1158                                                 SymTab.ArrayElem(t))
+ 1159                                                 = SymTab.ClChar) THEN
+ 1160                                             MGen.PushInt(1);
+ 1161                                             MGen.SysCall
+ 1162                                           ELSE
+ 1163                                             SemError(210);
+ 1164                                             MGen.Drop
+ 1165                                           END; .) .
+ 1166  
+ 1167    (* Expressions: Designator without ActualParameters (calls use
+ 1168       CallTail). Each expression synthesizes its SymTab type in t,
+ 1169       the source text in lx for single literals ("" otherwise), and
+ 1170       whether it is a plain variable (v/vn) for VAR actuals.
+ 1171       Values travel on the MC64 stack. *)
+ 1172    DesignHead <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+ 1173                VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr>
+ 1174                                          (. VAR n: SymTab.Name;
+ 1175                                               cls: INTEGER; .)
+ 1176      = GetIdent<n>                       (. MGen.CopyName(n, bn);
+ 1177                                             lx[0] := 0C;
+ 1178                                             IF ~SymTab.Lookup(n) THEN
+ 1179                                               SemError(201);
+ 1180                                               t := SymTab.InvalidType; k := -1;
+ 1181                                               IF doLoad THEN
+ 1182                                                 MGen.PushInt(0)
+ 1183                                               END
+ 1184                                             ELSE
+ 1185                                               t := SymTab.SymType(n);
+ 1186                                               k := SymTab.SymKind(n);
+ 1187                                               IF k = SymTab.KindConst THEN
+ 1188                                                 IF SymTab.Equal(n, "TRUE") THEN
+ 1189                                                   t := SymTab.BoolType();
+ 1190                                                   MGen.CopyName("TRUE", lx);
+ 1191                                                   IF doLoad THEN
+ 1192                                                     MGen.PushInt(1)
+ 1193                                                   END
+ 1194                                                 ELSIF SymTab.Equal(n,
+ 1195                                                         "FALSE") THEN
+ 1196                                                   t := SymTab.BoolType();
+ 1197                                                   MGen.CopyName("FALSE", lx);
+ 1198                                                   IF doLoad THEN
+ 1199                                                     MGen.PushInt(0)
+ 1200                                                   END
+ 1201                                                 ELSE
+ 1202                                                   cls :=
+ 1203                                                     SymTab.ClassOf(t);
+ 1204                                                   IF (t #
+ 1205                                                       SymTab.InvalidType)
+ 1206                                                      & (cls # SymTab.ClStr)
+ 1207                                                      & ((cls = SymTab.ClInt)
+ 1208                                                      OR (cls = SymTab.ClReal)
+ 1209                                                      OR (cls = SymTab.ClBool)
+ 1210                                                      OR (cls = SymTab.ClChar)
+ 1211                                                      OR (cls
+ 1212                                                          = SymTab.ClEnum)) THEN
+ 1213                                                     IF doLoad THEN
+ 1214                                                       MGen.LoadVar(n)
+ 1215                                                     END
+ 1216                                                   ELSIF doLoad THEN
+ 1217                                                     MGen.PushInt(0)
+ 1218                                                   END
+ 1219                                                 END
+ 1220                                                ELSIF (k = SymTab.KindVar)
+ 1221                                                   OR (k = SymTab.KindParam)
+ 1222                                                   OR (k
+ 1223                                                       = SymTab.KindVarPar) THEN
+ 1224                                                  cls := SymTab.ClassOf(t);
+ 1225                                                  IF (cls = SymTab.ClInt)
+ 1226                                                     OR (cls = SymTab.ClReal)
+ 1227                                                     OR (cls = SymTab.ClBool)
+ 1228                                                     OR (cls = SymTab.ClChar)
+ 1229                                                     OR (cls
+ 1230                                                         = SymTab.ClEnum)
+ 1231                                                     OR (cls
+ 1232                                                         = SymTab.ClSet)
+ 1233                                                     OR (cls
+ 1234                                                         = SymTab.ClPtr) THEN
+ 1235                                                    IF doLoad THEN
+ 1236                                                      MGen.PushVar(n)
+ 1237                                                    END
+ 1238                                                  ELSIF (cls
+ 1239                                                         = SymTab.ClArray)
+ 1240                                                     OR (cls
+ 1241                                                         = SymTab.ClRecord) THEN
+ 1242                                                    IF doLoad THEN
+ 1243                                                      MGen.PushAddr(n)
+ 1244                                                    END
+ 1245                                                  ELSIF t
+ 1246                                                    = SymTab.InvalidType THEN
+ 1247                                                    IF doLoad THEN
+ 1248                                                      MGen.PushInt(0)
+ 1249                                                    END
+ 1250                                                  ELSE SemError(230);
+ 1251                                                    IF doLoad THEN
+ 1252                                                      MGen.PushInt(0)
+ 1253                                                    END
+ 1254                                                  END
+ 1255                                               ELSE
+ 1256                                                 IF doLoad THEN
+ 1257                                                   IF k = SymTab.KindField THEN
+ 1258                                                     MGen.WithAddr(n);
+ 1259                                                     cls := SymTab.ClassOf(t);
+ 1260                                                     IF (t
+ 1261                                                        = SymTab.InvalidType)
+ 1262                                                        OR (cls
+ 1263                                                           = SymTab.ClArray)
+ 1264                                                        OR (cls
+ 1265                                                           = SymTab.ClRecord) THEN
+ 1266                                                     ELSE
+ 1267                                                       IF (cls
+ 1268                                                          = SymTab.ClChar)
+ 1269                                                          OR (cls
+ 1270                                                             = SymTab.ClBool) THEN
+ 1271                                                         MGen.LoadByte
+ 1272                                                       ELSE MGen.LoadIndir
+ 1273                                                       END
+ 1274                                                     END
+ 1275                                                   ELSE MGen.PushInt(0)
+ 1276                                                   END
+ 1277                                                 END;
+ 1278                                                 IF k = SymTab.KindField THEN
+ 1279                                                 ELSIF k
+ 1280                                                       = SymTab.KindImport THEN
+ 1281                                                   SemError(230)
+ 1282                                                 END
+ 1283                                               END
+ 1284                                             END; .) .
+ 1285    DesignTail <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+ 1286                VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr;
+ 1287                VAR sfx: BOOLEAN>
+ 1288                                          (. VAR m: SymTab.Name;
+ 1289                                               it: SymTab.TypeIndex;
+ 1290                                               lxI: MGen.LitStr;
+ 1291                                               vI: BOOLEAN;
+ 1292                                               vnI: SymTab.Name;
+ 1293                                               loA: INTEGER;
+ 1294                                               elemT: SymTab.TypeIndex;
+ 1295                                               esl, ebytes: CARDINAL;
+ 1296                                               firstT: BOOLEAN;
+ 1297                                               clsI: INTEGER; .)
+ 1298      =                                   (. sfx := FALSE; .)
+ 1299        { "."                             (. firstT := ~sfx;
+ 1300                                             sfx := TRUE; lx[0] := 0C;
+ 1301                                             IF ~doLoad & firstT THEN
+ 1302                                               IF (k = SymTab.KindVar)
+ 1303                                                  OR (k = SymTab.KindParam)
+ 1304                                                  OR (k
+ 1305                                                      = SymTab.KindVarPar) THEN
+ 1306                                                 MGen.PushAddr(bn)
+ 1307                                               ELSIF k
+ 1308                                                 = SymTab.KindField THEN
+ 1309                                                 MGen.WithAddr(bn)
+ 1310                                               ELSE MGen.PushInt(0)
+ 1311                                               END
+ 1312                                             END; .)
+ 1313          GetIdent<m>                     (. IF t = SymTab.InvalidType THEN
+ 1314                                               IF ~doLoad & firstT THEN
+ 1315                                                 MGen.Drop
+ 1316                                               ELSIF doLoad THEN
+ 1317                                                 MGen.Drop; MGen.PushInt(0)
+ 1318                                               END
+ 1319                                             ELSIF SymTab.ClassOf(t) #
+ 1320                                                   SymTab.ClRecord THEN
+ 1321                                               SemError(215);
+ 1322                                               t := SymTab.InvalidType;
+ 1323                                               IF doLoad THEN
+ 1324                                                 MGen.Drop; MGen.PushInt(0)
+ 1325                                               ELSIF firstT THEN
+ 1326                                                 MGen.Drop
+ 1327                                               END
+ 1328                                             ELSIF ~SymTab.FieldExists(t, m) THEN
+ 1329                                               SemError(216);
+ 1330                                               t := SymTab.InvalidType;
+ 1331                                               IF doLoad THEN
+ 1332                                                 MGen.Drop; MGen.PushInt(0)
+ 1333                                               ELSIF firstT THEN
+ 1334                                                 MGen.Drop
+ 1335                                               END
+ 1336                                             ELSE
+ 1337                                               loA := SymTab.FieldOffset(t, m);
+ 1338                                               elemT := SymTab.FieldType(t, m);
+ 1339                                               IF loA < 0 THEN
+ 1340                                                 SemError(216);
+ 1341                                                 t := SymTab.InvalidType;
+ 1342                                                 IF doLoad THEN
+ 1343                                                   MGen.Drop; MGen.PushInt(0)
+ 1344                                                 ELSIF firstT THEN
+ 1345                                                   MGen.Drop
+ 1346                                                 END
+ 1347                                               ELSE
+ 1348                                                 MGen.FieldAdd(
+ 1349                                                   VAL(CARDINAL, loA));
+ 1350                                                 t := elemT
+ 1351                                               END
+ 1352                                             END; .)
+ 1353        | "["                             (. firstT := ~sfx;
+ 1354                                             sfx := TRUE; lx[0] := 0C;
+ 1355                                             IF ~doLoad & firstT THEN
+ 1356                                               IF (k = SymTab.KindVar)
+ 1357                                                  OR (k = SymTab.KindParam)
+ 1358                                                  OR (k
+ 1359                                                      = SymTab.KindVarPar) THEN
+ 1360                                                 MGen.PushAddr(bn)
+ 1361                                               ELSIF k
+ 1362                                                 = SymTab.KindField THEN
+ 1363                                                 MGen.WithAddr(bn)
+ 1364                                               ELSE MGen.PushInt(0)
+ 1365                                               END
+ 1366                                             END; .)
+ 1367          Expr<it, lxI, vI, vnI>          (. IF t = SymTab.InvalidType THEN
+ 1368                                             MGen.Drop;
+ 1369                                             IF doLoad THEN
+ 1370                                               MGen.Drop; MGen.PushInt(0)
+ 1371                                             ELSE
+ 1372                                               IF ~firstT THEN
+ 1373                                               ELSE MGen.Drop
+ 1374                                               END
+ 1375                                             END
+ 1376                                           ELSIF SymTab.ClassOf(t) #
+ 1377                                                   SymTab.ClArray THEN
+ 1378                                             SemError(217);
+ 1379                                             t := SymTab.InvalidType;
+ 1380                                             MGen.Drop;
+ 1381                                             IF doLoad THEN
+ 1382                                               MGen.Drop; MGen.PushInt(0)
+ 1383                                             ELSE
+ 1384                                               IF ~firstT THEN
+ 1385                                               ELSE MGen.Drop
+ 1386                                               END
+ 1387                                             END
+ 1388                                           ELSE
+ 1389                                             clsI := SymTab.ClassOf(it);
+ 1390                                             IF (it
+ 1391                                                # SymTab.InvalidType)
+ 1392                                                & (clsI # SymTab.ClInt)
+ 1393                                                & (clsI # SymTab.ClChar)
+ 1394                                                & (clsI # SymTab.ClEnum)
+ 1395                                                & (clsI
+ 1396                                                   # SymTab.ClBool) THEN
+ 1397                                               SemError(218);
+ 1398                                               t := SymTab.InvalidType;
+ 1399                                               MGen.Drop;
+ 1400                                               IF doLoad THEN
+ 1401                                                 MGen.Drop; MGen.PushInt(0)
+ 1402                                               ELSE
+ 1403                                                 IF ~firstT THEN
+ 1404                                                 ELSE MGen.Drop
+ 1405                                                 END
+ 1406                                               END
+ 1407                                             ELSE
+ 1408                                               loA := SymTab.ArrayLo(t);
+ 1409                                               elemT := SymTab.ArrayElem(t);
+ 1410                                               esl := SymTab.TypeSlots(elemT);
+ 1411                                               IF esl = 0 THEN
+ 1412                                                 SemError(230);
+ 1413                                                 esl := 1
+ 1414                                               END;
+ 1415                                               IF (SymTab.ClassOf(elemT)
+ 1416                                                  = SymTab.ClChar)
+ 1417                                                  OR (SymTab.ClassOf(elemT)
+ 1418                                                     = SymTab.ClBool) THEN
+ 1419                                                 ebytes := 1
+ 1420                                               ELSE ebytes := esl * 8
+ 1421                                               END;
+ 1422                                               MGen.IdxScale(loA, ebytes);
+ 1423                                               t := elemT
+ 1424                                             END
+ 1425                                           END; .)
+ 1426          { ","
+ 1427            Expr<it, lxI, vI, vnI>        (. IF t = SymTab.InvalidType THEN
+ 1428                                             MGen.Drop;
+ 1429                                             IF doLoad THEN
+ 1430                                               MGen.Drop; MGen.PushInt(0);
+ 1431                                               t := SymTab.InvalidType
+ 1432                                             END
+ 1433                                           ELSIF SymTab.ClassOf(t) #
+ 1434                                                   SymTab.ClArray THEN
+ 1435                                             SemError(217);
+ 1436                                             t := SymTab.InvalidType;
+ 1437                                             MGen.Drop;
+ 1438                                             IF doLoad THEN
+ 1439                                               MGen.Drop; MGen.PushInt(0)
+ 1440                                             END
+ 1441                                           ELSE
+ 1442                                             clsI := SymTab.ClassOf(it);
+ 1443                                             IF (it
+ 1444                                                # SymTab.InvalidType)
+ 1445                                                & (clsI # SymTab.ClInt)
+ 1446                                                & (clsI # SymTab.ClChar)
+ 1447                                                & (clsI # SymTab.ClEnum)
+ 1448                                                & (clsI
+ 1449                                                   # SymTab.ClBool) THEN
+ 1450                                               SemError(218);
+ 1451                                               t := SymTab.InvalidType;
+ 1452                                               MGen.Drop;
+ 1453                                               IF doLoad THEN
+ 1454                                                 MGen.Drop; MGen.PushInt(0)
+ 1455                                               END
+ 1456                                             ELSE
+ 1457                                               loA := SymTab.ArrayLo(t);
+ 1458                                               elemT := SymTab.ArrayElem(t);
+ 1459                                               esl := SymTab.TypeSlots(elemT);
+ 1460                                               IF esl = 0 THEN
+ 1461                                                 SemError(230);
+ 1462                                                 esl := 1
+ 1463                                               END;
+ 1464                                               IF (SymTab.ClassOf(elemT)
+ 1465                                                  = SymTab.ClChar)
+ 1466                                                  OR (SymTab.ClassOf(elemT)
+ 1467                                                     = SymTab.ClBool) THEN
+ 1468                                                 ebytes := 1
+ 1469                                               ELSE ebytes := esl * 8
+ 1470                                               END;
+ 1471                                               MGen.IdxScale(loA, ebytes);
+ 1472                                               t := elemT
+ 1473                                             END
+ 1474                                           END; .) }
+ 1475          "]"
+ 1476        | "^"                             (. firstT := ~sfx;
+ 1477                                             sfx := TRUE; lx[0] := 0C;
+ 1478                                             IF ~doLoad & firstT THEN
+ 1479                                               IF (k = SymTab.KindVar)
+ 1480                                                  OR (k = SymTab.KindParam)
+ 1481                                                  OR (k
+ 1482                                                      = SymTab.KindVarPar) THEN
+ 1483                                                 MGen.PushAddr(bn)
+ 1484                                               ELSIF k
+ 1485                                                 = SymTab.KindField THEN
+ 1486                                                 MGen.WithAddr(bn)
+ 1487                                               ELSE MGen.PushInt(0)
+ 1488                                               END
+ 1489                                             END; .)
+ 1490                                          (. IF t = SymTab.InvalidType THEN
+ 1491                                               IF doLoad THEN
+ 1492                                                 MGen.Drop; MGen.PushInt(0)
+ 1493                                               ELSIF firstT THEN
+ 1494                                                 MGen.Drop
+ 1495                                               END
+ 1496                                             ELSIF SymTab.ClassOf(t) #
+ 1497                                                   SymTab.ClPtr THEN
+ 1498                                               SemError(219);
+ 1499                                               t := SymTab.InvalidType;
+ 1500                                               IF doLoad THEN
+ 1501                                                 MGen.Drop; MGen.PushInt(0)
+ 1502                                               ELSIF firstT THEN
+ 1503                                                 MGen.Drop
+ 1504                                               END
+ 1505                                             ELSE
+ 1506                                               elemT := SymTab.PtrBase(t);
+ 1507                                               t := elemT;
+ 1508                                               IF doLoad THEN
+ 1509                                                 IF ~(firstT
+ 1510                                                    & ((k
+ 1511                                                        = SymTab.KindVar)
+ 1512                                                    OR (k
+ 1513                                                        = SymTab.KindParam)
+ 1514                                                    OR (k
+ 1515                                                        = SymTab.KindVarPar)))
+ 1516                                                 THEN
+ 1517                                                   MGen.LoadIndir
+ 1518                                                 END
+ 1519                                               ELSE
+ 1520                                                 MGen.LoadIndir
+ 1521                                               END
+ 1522                                             END; .) } .
+ 1523    Expr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1524          VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1525                                          (. VAR t2: SymTab.TypeIndex;
+ 1526                                               tc, op: INTEGER;
+ 1527                                               lx2: MGen.LitStr;
+ 1528                                               v2: BOOLEAN;
+ 1529                                               vn2: SymTab.Name;
+ 1530                                               r: BOOLEAN; .)
+ 1531      = SimExpr<t, lx, v, vn> [ Rel<op> SimExpr<t2, lx2, v2, vn2>
+ 1532        (. lx[0] := 0C; v := FALSE;
+ 1533           IF op = SymTab.OpIn THEN
+ 1534             IF SymTab.InCheck(t, t2) THEN
+ 1535               t := SymTab.BoolType();
+ 1536               MGen.BitIn
+ 1537             ELSE SemError(222);
+ 1538               t := SymTab.InvalidType;
+ 1539               MGen.Drop; MGen.Drop; MGen.PushInt(0)
+ 1540             END
+ 1541           ELSIF (t # SymTab.InvalidType)
+ 1542              & (t2 # SymTab.InvalidType)
+ 1543              & (SymTab.ClassOf(t) = SymTab.ClArray)
+ 1544              & (SymTab.ClassOf(t2) = SymTab.ClArray)
+ 1545              & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
+ 1546              & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
+ 1547              & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
+ 1548             t := SymTab.BoolType();
+ 1549             MGen.PushBytes(SymTab.TypeSlots(t) * 8);
+ 1550             MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
+ 1551             MGen.StrComp;
+ 1552             IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
+ 1553             ELSIF (op = SymTab.OpNeq1)
+ 1554                   OR (op = SymTab.OpNeq2) THEN MGen.Or
+ 1555             ELSIF op = SymTab.OpLt THEN
+ 1556               MGen.Swap; MGen.Drop
+ 1557             ELSIF op = SymTab.OpLe THEN
+ 1558               MGen.Drop; MGen.Not
+ 1559             ELSIF op = SymTab.OpGt THEN
+ 1560               MGen.Drop
+ 1561             ELSE
+ 1562               MGen.Swap; MGen.Drop; MGen.Not
+ 1563             END
+ 1564           ELSIF (t # SymTab.InvalidType)
+ 1565              & (t2 # SymTab.InvalidType)
+ 1566              & ((SymTab.ClassOf(t) = SymTab.ClArray)
+ 1567                 OR (SymTab.ClassOf(t) = SymTab.ClRecord)
+ 1568                 OR (SymTab.ClassOf(t2) = SymTab.ClArray)
+ 1569                 OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN
+ 1570             SemError(213); t := SymTab.InvalidType;
+ 1571             MGen.Drop; MGen.Drop; MGen.PushInt(0)
+ 1572           ELSE
+ 1573             tc := SymTab.ClassOf(t);
+ 1574             IF SymTab.RelCheck(t, t2, op) THEN
+ 1575               t := SymTab.BoolType()
+ 1576             ELSE SemError(213); t := SymTab.InvalidType END;
+ 1577             IF t # SymTab.InvalidType THEN
+ 1578               r := tc = SymTab.ClReal;
+ 1579               IF r THEN
+ 1580                 IF op = SymTab.OpEq THEN MGen.RealEq
+ 1581                 ELSIF (op = SymTab.OpNeq1)
+ 1582                       OR (op = SymTab.OpNeq2) THEN MGen.RealNe
+ 1583                 ELSIF op = SymTab.OpLt THEN MGen.RealLt
+ 1584                 ELSIF op = SymTab.OpLe THEN MGen.RealLe
+ 1585                 ELSIF op = SymTab.OpGt THEN MGen.RealGt
+ 1586                 ELSE MGen.RealGe END
+ 1587               ELSE
+ 1588                 IF op = SymTab.OpEq THEN MGen.Eq
+ 1589                 ELSIF (op = SymTab.OpNeq1)
+ 1590                       OR (op = SymTab.OpNeq2) THEN MGen.Neq
+ 1591                 ELSIF op = SymTab.OpLt THEN MGen.ILt
+ 1592                 ELSIF op = SymTab.OpLe THEN MGen.ILe
+ 1593                 ELSIF op = SymTab.OpGt THEN MGen.IGt
+ 1594                 ELSE MGen.IGe END
+ 1595               END
+ 1596             ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0)
+ 1597             END
+ 1598           END; .) ] .
+ 1599    Rel <VAR op: INTEGER>
+ 1600      = "="                     (. op := SymTab.OpEq; .)
+ 1601      | "#"                     (. op := SymTab.OpNeq1; .)
+ 1602      | "<>"                    (. op := SymTab.OpNeq2; .)
+ 1603      | "<"                     (. op := SymTab.OpLt; .)
+ 1604      | "<="                    (. op := SymTab.OpLe; .)
+ 1605      | ">"                     (. op := SymTab.OpGt; .)
+ 1606      | ">="                    (. op := SymTab.OpGe; .)
+ 1607      | "IN"                    (. op := SymTab.OpIn; .) .
+ 1608    SimExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1609             VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1610                                          (. VAR t2, res2: SymTab.TypeIndex;
+ 1611                                               op: INTEGER;
+ 1612                                               lx2: MGen.LitStr;
+ 1613                                               v2: BOOLEAN;
+ 1614                                               vn2: SymTab.Name;
+ 1615                                               neg, isR: BOOLEAN; .)
+ 1616      =                                   (. neg := FALSE; .)
+ 1617        [ "+" | "-"                       (. neg := TRUE; .) ]
+ 1618        Term<t, lx, v, vn>                (. IF neg THEN
+ 1619                                             v := FALSE;
+ 1620                                             IF MGen.IsLit(lx) THEN
+ 1621                                               MGen.NegFold(lx, lx)
+ 1622                                             ELSE lx[0] := 0C
+ 1623                                             END;
+ 1624                                             IF SymTab.ClassOf(t)
+ 1625                                                = SymTab.ClReal THEN
+ 1626                                               MGen.NegReal
+ 1627                                             ELSE MGen.NegInt
+ 1628                                             END
+ 1629                                           END; .)
+ 1630        { AddOp<op> Term<t2, lx2, v2, vn2>
+ 1631        (. lx[0] := 0C; v := FALSE;
+ 1632           IF op = SymTab.OpOr THEN
+ 1633             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+ 1634               t := SymTab.BoolType()
+ 1635             ELSE SemError(212); t := SymTab.InvalidType END;
+ 1636             MGen.Or
+ 1637           ELSIF (t # SymTab.InvalidType)
+ 1638              & (t2 # SymTab.InvalidType)
+ 1639              & (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1640              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1641             IF op = SymTab.OpAdd THEN
+ 1642               MGen.Or
+ 1643             ELSE
+ 1644               MGen.PushBits(0FFFFFFFFFFFFFFFFH);
+ 1645               MGen.BitXor;
+ 1646               MGen.And
+ 1647             END
+ 1648           ELSE
+ 1649             IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
+ 1650             ELSE SemError(211); t := SymTab.InvalidType END;
+ 1651             isR := (t # SymTab.InvalidType)
+ 1652                    & (SymTab.ClassOf(t) = SymTab.ClReal);
+ 1653             IF op = SymTab.OpAdd THEN
+ 1654               IF isR THEN MGen.RealAdd ELSE MGen.Add END
+ 1655             ELSE
+ 1656               IF isR THEN MGen.RealSub ELSE MGen.Sub END
+ 1657             END
+ 1658           END; .) } .
+ 1659    AddOp <VAR op: INTEGER>
+ 1660      = "+"                     (. op := SymTab.OpAdd; .)
+ 1661      | "-"                     (. op := SymTab.OpSub; .)
+ 1662      | "OR"                    (. op := SymTab.OpOr; .) .
+ 1663    Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1664          VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1665                                          (. VAR t2, res2: SymTab.TypeIndex;
+ 1666                                               op: INTEGER;
+ 1667                                               lx2: MGen.LitStr;
+ 1668                                               v2: BOOLEAN;
+ 1669                                               vn2: SymTab.Name;
+ 1670                                               isR: BOOLEAN;
+ 1671                                               mt: INTEGER; .)
+ 1672      = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
+ 1673        (. lx[0] := 0C; v := FALSE;
+ 1674           IF op = SymTab.OpAnd THEN
+ 1675             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+ 1676               t := SymTab.BoolType()
+ 1677             ELSE SemError(212); t := SymTab.InvalidType END;
+ 1678             MGen.And
+ 1679           ELSIF (op = SymTab.OpTimes)
+ 1680              & (t # SymTab.InvalidType)
+ 1681              & (t2 # SymTab.InvalidType)
+ 1682              & (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1683              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1684             MGen.And
+ 1685           ELSE
+ 1686             IF SymTab.ArithCheck(t, t2,
+ 1687                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+ 1688                  res2) THEN t := res2
+ 1689             ELSE SemError(211); t := SymTab.InvalidType END;
+ 1690             isR := (t # SymTab.InvalidType)
+ 1691                    & (SymTab.ClassOf(t) = SymTab.ClReal);
+ 1692             IF op = SymTab.OpTimes THEN
+ 1693               IF isR THEN MGen.RealMul ELSE MGen.MulU END
+ 1694             ELSIF op = SymTab.OpSlash THEN
+ 1695               IF isR THEN MGen.RealDiv ELSE MGen.DivI END
+ 1696             ELSIF op = SymTab.OpDiv THEN
+ 1697               MGen.DivI
+ 1698             ELSE
+ 1699               mt := MGen.TempGlobal();
+ 1700               MGen.ModI(mt)
+ 1701             END
+ 1702           END; .) } .
+ 1703    MulOp <VAR op: INTEGER>
+ 1704      = "*"                     (. op := SymTab.OpTimes; .)
+ 1705      | "/"                     (. op := SymTab.OpSlash; .)
+ 1706      | "DIV"                   (. op := SymTab.OpDiv; .)
+ 1707      | "MOD"                   (. op := SymTab.OpMod; .)
+ 1708      | "AND"                   (. op := SymTab.OpAnd; .)
+ 1709      | "&"                     (. op := SymTab.OpAnd; .) .
+ 1710    Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1711          VAR v: BOOLEAN; VAR vn: SymTab.Name>
+ 1712                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
+ 1713                                               t2, et, dt, st: SymTab.TypeIndex;
+ 1714                                               dk: INTEGER;
+ 1715                                               bnF: SymTab.Name;
+ 1716                                               lxD, lx2: MGen.LitStr;
+ 1717                                               v2: BOOLEAN;
+ 1718                                               vn2: SymTab.Name;
+ 1719                                               vi: INTEGER;
+ 1720                                               c: CARDINAL;
+ 1721                                               b: LONGCARD;
+ 1722                                               sfxF: BOOLEAN;
+ 1723                                               okF: BOOLEAN; .)
+ 1724      = integer                         (. LexString(s);
+ 1725                                           MGen.CopyName(s, lx);
+ 1726                                           v := FALSE;
+ 1727                                           IF MGen.ParseInt(s, vi) THEN
+ 1728                                             MGen.PushInt(vi)
+ 1729                                           ELSIF MGen.ParseCard(s, c) THEN
+ 1730                                             MGen.PushBits(
+ 1731                                               VAL(LONGCARD, c))
+ 1732                                           ELSE MGen.PushInt(0)
+ 1733                                           END;
+ 1734                                           t := SymTab.IntType(); .)
+ 1735      | real                            (. LexString(s);
+ 1736                                           MGen.CopyName(s, lx);
+ 1737                                           v := FALSE;
+ 1738                                           IF MGen.ParseReal(s, b) THEN
+ 1739                                             MGen.PushBits(b)
+ 1740                                           ELSE MGen.PushBits(0H)
+ 1741                                           END;
+ 1742                                           t := SymTab.RealType(); .)
+ 1743      | string                          (. LexString(s);
+ 1744                                           v := FALSE;
+ 1745                                           IF SymTab.StrLen(s) <= 3 THEN
+ 1746                                             t := SymTab.CharType();
+ 1747                                             MGen.CopyName(s, lx);
+ 1748                                             MGen.PushInt(
+ 1749                                               MGen.CharOrd(s))
+ 1750                                           ELSE t := SymTab.NewStr();
+ 1751                                             MGen.CopyName(s, lx);
+ 1752                                             MGen.EmitString(s)
+ 1753                                           END; .)
+ 1754      | "HIGH"
+ 1755        "(" DesignHead<dt, dk, bnF, FALSE, lxD>
+ 1756            DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
+ 1757        ")"                               (. lx[0] := 0C; v := FALSE;
+ 1758                                             IF dt = SymTab.InvalidType THEN
+ 1759                                               IF sfxF THEN MGen.Drop END;
+ 1760                                               MGen.PushInt(0);
+ 1761                                               t := SymTab.InvalidType
+ 1762                                             ELSIF SymTab.ClassOf(dt)
+ 1763                                                    # SymTab.ClArray THEN
+ 1764                                               SemError(217);
+ 1765                                               IF sfxF THEN MGen.Drop END;
+ 1766                                               MGen.PushInt(0);
+ 1767                                               t := SymTab.InvalidType
+ 1768                                             ELSIF SymTab.IsOpen(dt) THEN
+ 1769                                               IF sfxF THEN MGen.Drop END;
+ 1770                                               IF (dk = SymTab.KindParam)
+ 1771                                                  OR (dk
+ 1772                                                   = SymTab.KindVarPar) THEN
+ 1773                                                 IF SymTab.CurDepth()
+ 1774                                                    = SymTab.SymDepth(bnF) THEN
+ 1775                                                   MGen.LoadLocal(
+ 1776                                                     SymTab.SymSlot(bnF) + 1)
+ 1777                                                 ELSE
+ 1778                                                   MGen.FrameAddr(
+ 1779                                                     SymTab.SymSlot(bnF) + 1,
+ 1780                                                     VAL(CARDINAL,
+ 1781                                                       SymTab.CurDepth() - 1
+ 1782                                                       - SymTab.SymDepth(bnF)));
+ 1783                                                   MGen.LoadIndir
+ 1784                                                 END;
+ 1785                                                 MGen.PushInt(1);
+ 1786                                                 MGen.Sub;
+ 1787                                                 t := SymTab.IntType()
+ 1788                                               ELSE
+ 1789                                                 MGen.PushInt(0);
+ 1790                                                 t := SymTab.InvalidType
+ 1791                                               END
+ 1792                                             ELSE
+ 1793                                               IF sfxF THEN MGen.Drop END;
+ 1794                                               MGen.PushInt(
+ 1795                                                 SymTab.ArrayHi(dt));
+ 1796                                               t := SymTab.IntType()
+ 1797                                             END; .)
+ 1798      | DesignHead<dt, dk, bnF, TRUE, lxD>
+ 1799        DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
+ 1800                                          (. t := dt;
+ 1801                                             MGen.CopyName(lxD, lx);
+ 1802                                             IF sfxF
+ 1803                                                & (t # SymTab.InvalidType)
+ 1804                                                & (SymTab.ClassOf(t)
+ 1805                                                   # SymTab.ClArray)
+ 1806                                                & (SymTab.ClassOf(t)
+ 1807                                                   # SymTab.ClRecord) THEN
+ 1808                                               IF (SymTab.ClassOf(t)
+ 1809                                                  = SymTab.ClChar)
+ 1810                                                  OR (SymTab.ClassOf(t)
+ 1811                                                     = SymTab.ClBool) THEN
+ 1812                                                 MGen.LoadByte
+ 1813                                               ELSE MGen.LoadIndir
+ 1814                                               END
+ 1815                                             END;
+ 1816                                             v := ~sfxF
+ 1817                                                  & ((dk = SymTab.KindVar)
+ 1818                                                  OR (dk = SymTab.KindParam)
+ 1819                                                  OR (dk
+ 1820                                                      = SymTab.KindVarPar));
+ 1821                                             MGen.CopyName(bnF, vn); .)
+ 1822        [ CallTail<bnF, sfxF, TRUE, okF, TRUE>
+ 1823                                          (. IF okF THEN
+ 1824                                               IF SymTab.SymKind(bnF)
+ 1825                                                  = SymTab.KindProc THEN
+ 1826                                                 t := SymTab.ProcRet(bnF)
+ 1827                                               ELSE
+ 1828                                                 t := SymTab.InvalidType
+ 1829                                               END
+ 1830                                             ELSE t := SymTab.InvalidType
+ 1831                                             END;
+ 1832                                             lx[0] := 0C; v := FALSE; .) ]
+ 1833      | "("
+ 1834        Expr<et, lx, v, vn> ")"         (. t := et; .)
+ 1835      | ( "NOT" | "~" )
+ 1836        Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE;
+ 1837                                           IF SymTab.BoolCheck(t2) THEN
+ 1838                                             t := SymTab.BoolType()
+ 1839                                           ELSE SemError(212);
+ 1840                                             t := SymTab.InvalidType END;
+ 1841                                           MGen.Not; .)
+ 1842      | SetLit<st>                      (. lx[0] := 0C; v := FALSE;
+ 1843                                           t := st; .) .
+ 1844    SetLit <VAR t: SymTab.TypeIndex>
+ 1845                                          (. VAR first, et: SymTab.TypeIndex;
+ 1846                                               lxE, lxE2: MGen.LitStr;
+ 1847                                               vE, vE2: BOOLEAN;
+ 1848                                               vnE, vnE2: SymTab.Name;
+ 1849                                               hasR: BOOLEAN; .)
+ 1850      = "{"
+ 1851                                  (. MGen.PushInt(0);
+ 1852                                     t := SymTab.SetFor(SymTab.IntType()); .)
+ 1853        [ Elem<et, lxE, lxE2, hasR>   (. first := et;
+ 1854                                         t := SymTab.SetFor(et);
+ 1855                                         IF hasR THEN
+ 1856                                           MGen.PushInt(1); MGen.Add;
+ 1857                                           MGen.FieldMask
+ 1858                                         ELSE MGen.Power2 END;
+ 1859                                         MGen.Or; .)
+ 1860          { ","
+ 1861            Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
+ 1862                                         SemError(222) END;
+ 1863                                         IF hasR THEN
+ 1864                                           MGen.PushInt(1); MGen.Add;
+ 1865                                           MGen.FieldMask
+ 1866                                         ELSE MGen.Power2 END;
+ 1867                                         MGen.Or; .) } ]
+ 1868        "}" .
+ 1869    Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
+ 1870          VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
+ 1871                                          (. VAR t2: SymTab.TypeIndex;
+ 1872                                               vD, vD2: BOOLEAN;
+ 1873                                               vnD, vnD2: SymTab.Name; .)
+ 1874      = Expr<t, lx, vD, vnD>              (. hasR := FALSE;
+ 1875                                             lx2[0] := 0C; .)
+ 1876        [ ".."
+ 1877          Expr<t2, lx2, vD2, vnD2>        (. IF ~SymTab.SetElemCheck(t, t2) THEN
+ 1878                                             SemError(222) END;
+ 1879                                             hasR := TRUE; .) ] .
+ 1880  
+ 1881    GetIdent <VAR n: SymTab.Name>
+ 1882      = ident                           (. LexName(n); .) .
+ 1883  
+ 1884  END M2c.
+
+    0 errors
+
 
 Statistics:
 
-  nr of terminals:        72 (limit   400)
-  nr of non-terminals:    54 (limit   210)
-  nr of pragmas:           0 (limit   428)
-  nr of symbolnodes:     126 (limit   500)
-  nr of graphnodes:      522 (limit  1500)
+  nr of terminals:        75 (limit   400)
+  nr of non-terminals:    56 (limit   210)
+  nr of pragmas:           0 (limit   425)
+  nr of symbolnodes:     131 (limit   500)
+  nr of graphnodes:      547 (limit  1500)
   nr of conditionsets:     7 (limit   100)
   nr of charactersets:     9 (limit   250)
 

+ 35 - 32
M2c.mod

@@ -146,38 +146,41 @@ MODULE M2c;
         | 48: Msg("'RETURN' expected")
         | 49: Msg("'NEW' expected")
         | 50: Msg("'DISPOSE' expected")
-        | 51: Msg("'^' expected")
-        | 52: Msg("'#' expected")
-        | 53: Msg("'<>' expected")
-        | 54: Msg("'<' expected")
-        | 55: Msg("'<=' expected")
-        | 56: Msg("'>' expected")
-        | 57: Msg("'>=' expected")
-        | 58: Msg("'IN' expected")
-        | 59: Msg("'+' expected")
-        | 60: Msg("'OR' expected")
-        | 61: Msg("'*' expected")
-        | 62: Msg("'/' expected")
-        | 63: Msg("'DIV' expected")
-        | 64: Msg("'MOD' expected")
-        | 65: Msg("'AND' expected")
-        | 66: Msg("'&' expected")
-        | 67: Msg("'NOT' expected")
-        | 68: Msg("'~' expected")
-        | 69: Msg("'{' expected")
-        | 70: Msg("'}' expected")
-        | 71: Msg("not expected")
-        | 72: Msg("invalid MulOp")
-        | 73: Msg("invalid Fact")
-        | 74: Msg("invalid AddOp")
-        | 75: Msg("invalid Rel")
-        | 76: Msg("invalid ByLit")
-        | 77: Msg("invalid AssignOrCall")
-        | 78: Msg("invalid SimpleType")
-        | 79: Msg("invalid Type")
-        | 80: Msg("invalid ProcedureDecl")
-        | 81: Msg("invalid Declaration")
-        | 82: Msg("invalid Import")
+        | 51: Msg("'WriteInt' expected")
+        | 52: Msg("'WriteString' expected")
+        | 53: Msg("'^' expected")
+        | 54: Msg("'#' expected")
+        | 55: Msg("'<>' expected")
+        | 56: Msg("'<' expected")
+        | 57: Msg("'<=' expected")
+        | 58: Msg("'>' expected")
+        | 59: Msg("'>=' expected")
+        | 60: Msg("'IN' expected")
+        | 61: Msg("'+' expected")
+        | 62: Msg("'OR' expected")
+        | 63: Msg("'*' expected")
+        | 64: Msg("'/' expected")
+        | 65: Msg("'DIV' expected")
+        | 66: Msg("'MOD' expected")
+        | 67: Msg("'AND' expected")
+        | 68: Msg("'&' expected")
+        | 69: Msg("'HIGH' expected")
+        | 70: Msg("'NOT' expected")
+        | 71: Msg("'~' expected")
+        | 72: Msg("'{' expected")
+        | 73: Msg("'}' expected")
+        | 74: Msg("not expected")
+        | 75: Msg("invalid MulOp")
+        | 76: Msg("invalid Fact")
+        | 77: Msg("invalid AddOp")
+        | 78: Msg("invalid Rel")
+        | 79: Msg("invalid ByLit")
+        | 80: Msg("invalid AssignOrCall")
+        | 81: Msg("invalid SimpleType")
+        | 82: Msg("invalid Type")
+        | 83: Msg("invalid ProcedureDecl")
+        | 84: Msg("invalid Declaration")
+        | 85: Msg("invalid Import")
         
         (* add customized cases here *)
         | 200: Msg("duplicate identifier")


+ 231 - 80
M2cP.mod

@@ -9,7 +9,7 @@ IMPORT SymTab, MGen;
 
 
 CONST 
-  maxT = 71;
+  maxT = 74;
   minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
   setsize     = 16;  (* sets are stored in 16 bits *)
 
@@ -138,6 +138,8 @@ PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                        VAR sfx: BOOLEAN); FORWARD;
 PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                        VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); FORWARD;
+PROCEDURE WriteStrStat; FORWARD;
+PROCEDURE WriteIntStat; FORWARD;
 PROCEDURE DispStat; FORWARD;
 PROCEDURE NewStat; FORWARD;
 PROCEDURE ReturnStat; FORWARD;
@@ -206,7 +208,7 @@ PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
     vnE, vnE2: SymTab.Name;
     hasR: BOOLEAN;
   BEGIN
-    Expect(69);
+    Expect(72);
     MGen.PushInt(0);
     t := SymTab.SetFor(SymTab.IntType());;
     IF In(symSet[1], sym) THEN
@@ -230,31 +232,31 @@ PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
         MGen.Or;;
       END;
     END;
-    Expect(70);
+    Expect(73);
   END SetLit;
 
 PROCEDURE MulOp (VAR op: INTEGER);
   BEGIN
     CASE sym OF
-      61 :
+      63 :
         Get;
         op := SymTab.OpTimes;;
-    | 62 :
+    | 64 :
         Get;
         op := SymTab.OpSlash;;
-    | 63 :
+    | 65 :
         Get;
         op := SymTab.OpDiv;;
-    | 64 :
+    | 66 :
         Get;
         op := SymTab.OpMod;;
-    | 65 :
+    | 67 :
         Get;
         op := SymTab.OpAnd;;
-    | 66 :
+    | 68 :
         Get;
         op := SymTab.OpAnd;;
-    ELSE SynError(72);
+    ELSE SynError(75);
     END;
   END MulOp;
 
@@ -310,6 +312,53 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
           MGen.CopyName(s, lx);
           MGen.EmitString(s)
         END;;
+    | 69 :
+        Get;
+        Expect(19);
+        DesignHead(dt, dk, bnF, FALSE, lxD);
+        DesignTail(dt, dk, bnF, FALSE, lxD, sfxF);
+        Expect(20);
+        lx[0] := 0C; v := FALSE;
+        IF dt = SymTab.InvalidType THEN
+          IF sfxF THEN MGen.Drop END;
+          MGen.PushInt(0);
+          t := SymTab.InvalidType
+        ELSIF SymTab.ClassOf(dt)
+               # SymTab.ClArray THEN
+          SemError(217);
+          IF sfxF THEN MGen.Drop END;
+          MGen.PushInt(0);
+          t := SymTab.InvalidType
+        ELSIF SymTab.IsOpen(dt) THEN
+          IF sfxF THEN MGen.Drop END;
+          IF (dk = SymTab.KindParam)
+             OR (dk
+              = SymTab.KindVarPar) THEN
+            IF SymTab.CurDepth()
+               = SymTab.SymDepth(bnF) THEN
+              MGen.LoadLocal(
+                SymTab.SymSlot(bnF) + 1)
+            ELSE
+              MGen.FrameAddr(
+                SymTab.SymSlot(bnF) + 1,
+                VAL(CARDINAL,
+                  SymTab.CurDepth() - 1
+                  - SymTab.SymDepth(bnF)));
+              MGen.LoadIndir
+            END;
+            MGen.PushInt(1);
+            MGen.Sub;
+            t := SymTab.IntType()
+          ELSE
+            MGen.PushInt(0);
+            t := SymTab.InvalidType
+          END
+        ELSE
+          IF sfxF THEN MGen.Drop END;
+          MGen.PushInt(
+            SymTab.ArrayHi(dt));
+          t := SymTab.IntType()
+        END;;
     | 1 :
         DesignHead(dt, dk, bnF, TRUE, lxD);
         DesignTail(dt, dk, bnF, TRUE, lxD, sfxF);
@@ -353,8 +402,8 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         Expr(et, lx, v, vn);
         Expect(20);
         t := et;;
-    | 67, 68 :
-        IF (sym = 67) THEN
+    | 70, 71 :
+        IF (sym = 70) THEN
           Get;
         ELSE
           Get;
@@ -366,26 +415,26 @@ PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
         ELSE SemError(212);
           t := SymTab.InvalidType END;
         MGen.Not;;
-    | 69 :
+    | 72 :
         SetLit(st);
         lx[0] := 0C; v := FALSE;
         t := st;;
-    ELSE SynError(73);
+    ELSE SynError(76);
     END;
   END Fact;
 
 PROCEDURE AddOp (VAR op: INTEGER);
   BEGIN
-    IF (sym = 59) THEN
+    IF (sym = 61) THEN
       Get;
       op := SymTab.OpAdd;;
     ELSIF (sym = 46) THEN
       Get;
       op := SymTab.OpSub;;
-    ELSIF (sym = 60) THEN
+    ELSIF (sym = 62) THEN
       Get;
       op := SymTab.OpOr;;
-    ELSE SynError(74);
+    ELSE SynError(77);
     END;
   END AddOp;
 
@@ -442,28 +491,28 @@ PROCEDURE Rel (VAR op: INTEGER);
       16 :
         Get;
         op := SymTab.OpEq;;
-    | 52 :
+    | 54 :
         Get;
         op := SymTab.OpNeq1;;
-    | 53 :
+    | 55 :
         Get;
         op := SymTab.OpNeq2;;
-    | 54 :
+    | 56 :
         Get;
         op := SymTab.OpLt;;
-    | 55 :
+    | 57 :
         Get;
         op := SymTab.OpLe;;
-    | 56 :
+    | 58 :
         Get;
         op := SymTab.OpGt;;
-    | 57 :
+    | 59 :
         Get;
         op := SymTab.OpGe;;
-    | 58 :
+    | 60 :
         Get;
         op := SymTab.OpIn;;
-    ELSE SynError(75);
+    ELSE SynError(78);
     END;
   END Rel;
 
@@ -477,8 +526,8 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     neg, isR: BOOLEAN;
   BEGIN
     neg := FALSE;;
-    IF (sym = 46) OR (sym = 59) THEN
-      IF (sym = 59) THEN
+    IF (sym = 46) OR (sym = 61) THEN
+      IF (sym = 61) THEN
         Get;
       ELSE
         Get;
@@ -498,7 +547,7 @@ PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
     ELSE MGen.NegInt
     END
     END;;
-    WHILE (sym = 46) OR (sym = 59) OR (sym = 60) DO
+    WHILE (sym = 46) OR (sym = 61) OR (sym = 62) DO
       AddOp(op);
       Term(t2, lx2, v2, vn2);
       lx[0] := 0C; v := FALSE;
@@ -549,7 +598,7 @@ PROCEDURE ByLit (VAR v: INTEGER);
         v := -v
       ELSE v := -1
       END;;
-    ELSE SynError(76);
+    ELSE SynError(79);
     END;
   END ByLit;
 
@@ -674,7 +723,7 @@ PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
     clsI: INTEGER;
   BEGIN
     sfx := FALSE;;
-    WHILE (sym = 7) OR (sym = 22) OR (sym = 51) DO
+    WHILE (sym = 7) OR (sym = 22) OR (sym = 53) DO
       IF (sym = 7) THEN
         Get;
         firstT := ~sfx;
@@ -1031,6 +1080,55 @@ PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
     END;;
   END DesignHead;
 
+PROCEDURE WriteStrStat;
+  VAR t: SymTab.TypeIndex;
+    lx: MGen.LitStr;
+    v: BOOLEAN;
+    vn: SymTab.Name;
+  BEGIN
+    Expect(52);
+    Expect(19);
+    Expr(t, lx, v, vn);
+    Expect(20);
+    IF t = SymTab.InvalidType THEN
+    MGen.Drop
+    ELSIF (SymTab.ClassOf(t)
+         = SymTab.ClStr) THEN
+    MGen.PushInt(1);
+    MGen.SysCall
+    ELSIF (SymTab.ClassOf(t)
+         = SymTab.ClArray)
+     & (SymTab.ClassOf(
+        SymTab.ArrayElem(t))
+        = SymTab.ClChar) THEN
+    MGen.PushInt(1);
+    MGen.SysCall
+    ELSE
+    SemError(210);
+    MGen.Drop
+    END;;
+  END WriteStrStat;
+
+PROCEDURE WriteIntStat;
+  VAR t: SymTab.TypeIndex;
+    lx: MGen.LitStr;
+    v: BOOLEAN;
+    vn: SymTab.Name;
+  BEGIN
+    Expect(51);
+    Expect(19);
+    Expr(t, lx, v, vn);
+    Expect(20);
+    IF t = SymTab.InvalidType THEN
+    MGen.Drop
+    ELSIF ~SymTab.IsIntFamily(t) THEN
+    SemError(210);
+    MGen.Drop
+    ELSE
+    MGen.CallPrint
+    END;;
+  END WriteIntStat;
+
 PROCEDURE DispStat;
   VAR dt: SymTab.TypeIndex;
     dk: INTEGER;
@@ -1449,7 +1547,7 @@ PROCEDURE AssignOrCall;
     sfx := FALSE; pushedDst := FALSE;
     pushedFld := FALSE;;
     DesignHead(dt, dk, bn, FALSE, lxD);
-    IF (sym = 7) OR (sym = 22) OR (sym = 32) OR (sym = 51) THEN
+    IF (sym = 7) OR (sym = 22) OR (sym = 32) OR (sym = 53) THEN
       DesignTail(dt, dk, bn, FALSE, lxD, sfx);
       Expect(32);
       storable :=
@@ -1464,14 +1562,12 @@ PROCEDURE AssignOrCall;
       END;
       IF storable & ~sfx
          & (dt # SymTab.InvalidType)
-         & (SymTab.ClassOf(dt)
-            = SymTab.ClArray) THEN
-        elemDt := SymTab.ArrayElem(dt);
-        IF SymTab.ClassOf(elemDt)
-           = SymTab.ClChar THEN
-          MGen.PushAddr(bn);
-          pushedDst := TRUE
-        END
+         & ((SymTab.ClassOf(dt)
+            = SymTab.ClArray)
+            OR (SymTab.ClassOf(dt)
+               = SymTab.ClRecord)) THEN
+        MGen.PushAddr(bn);
+        pushedDst := TRUE
       END;
       IF storable & ~sfx
          & ~pushedDst THEN
@@ -1492,11 +1588,13 @@ PROCEDURE AssignOrCall;
       ELSIF pushedDst THEN
       IF et = SymTab.InvalidType THEN
       MGen.Drop; MGen.Drop
-      ELSIF (SymTab.ClassOf(et)
-      # SymTab.ClStr) THEN
-      SemError(230);
-      MGen.Drop; MGen.Drop
-      ELSE
+      ELSIF (SymTab.ClassOf(dt)
+      = SymTab.ClArray)
+      & (SymTab.ClassOf(
+      SymTab.ArrayElem(dt))
+      = SymTab.ClChar)
+      & (SymTab.ClassOf(et)
+      = SymTab.ClStr) THEN
       srcBytes :=
       MGen.StrLenOf(lxe) + 1;
       dstBytes :=
@@ -1508,6 +1606,15 @@ PROCEDURE AssignOrCall;
       MGen.PushBytes(srcBytes);
       MGen.CopyBlock
       END
+      ELSIF ~SymTab.Assignable(et,
+      dt) THEN
+      SemError(210);
+      MGen.Drop; MGen.Drop
+      ELSE
+      dstBytes :=
+      SymTab.TypeSlots(dt) * 8;
+      MGen.PushBytes(dstBytes);
+      MGen.CopyBlock
       END
       ELSIF pushedFld THEN
       IF et = SymTab.InvalidType THEN
@@ -1536,8 +1643,10 @@ PROCEDURE AssignOrCall;
       SemError(210);
       MGen.Drop; MGen.Drop
       ELSE
-      SemError(230);
-      MGen.Drop; MGen.Drop
+      dstBytes :=
+      SymTab.TypeSlots(dt) * 8;
+      MGen.PushBytes(dstBytes);
+      MGen.CopyBlock
       END
       ELSE
       IF ~SymTab.Assignable(et,
@@ -1615,7 +1724,7 @@ PROCEDURE AssignOrCall;
       IF MGen.ActEnd(bn, FALSE, FALSE) # 0 THEN
         SemError(233)
       END;;
-    ELSE SynError(77);
+    ELSE SynError(80);
     END;
   END AssignOrCall;
 
@@ -1646,6 +1755,10 @@ PROCEDURE Stat;
           NewStat;
       | 50 :
           DispStat;
+      | 51 :
+          WriteIntStat;
+      | 52 :
+          WriteStrStat;
       | 31 :
           Get;
           IF MGen.TopLoop(lx) THEN
@@ -1676,6 +1789,10 @@ PROCEDURE Field (rt: SymTab.TypeIndex);
       FieldIdents(rt);
       Expect(17);
       Type(et);
+      IF (et # SymTab.InvalidType)
+       & SymTab.IsOpen(et) THEN
+       SemError(230)
+      END;
       SymTab.FixPendingF(rt, et);;
     END;
   END Field;
@@ -1758,36 +1875,46 @@ PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
       SymTab.TypeIndex;
     nc, kk: CARDINAL;
     loA, hiA: INTEGER;
+    isOpenA: BOOLEAN;
   BEGIN
     Expect(25);
-    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;
-    nc := 0;
-    idx[nc] := s; INC(nc);;
-    WHILE (sym = 10) DO
-      Get;
-      SimpleType(s2);
-      IF (s2 # SymTab.InvalidType)
-       & (SymTab.ClassOf(s2) #
+    IF (sym = 1) OR (sym = 19) OR (sym = 22) OR (sym = 26) THEN
+      IF (sym = 1) OR (sym = 19) OR (sym = 22) THEN
+        SimpleType(s);
+        IF (s # SymTab.InvalidType)
+        & (SymTab.ClassOf(s) #
           SymTab.ClInt)
-       & (SymTab.ClassOf(s2) #
+        & (SymTab.ClassOf(s) #
           SymTab.ClChar)
-       & (SymTab.ClassOf(s2) #
+        & (SymTab.ClassOf(s) #
           SymTab.ClEnum) THEN
-       SemError(224) END;
-      IF nc <= HIGH(idx) THEN
-        idx[nc] := s2; INC(nc)
-      END;;
+        SemError(224) END;
+        nc := 0; isOpenA := FALSE;
+        idx[nc] := s; INC(nc);;
+        WHILE (sym = 10) DO
+          Get;
+          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;
+          IF nc <= HIGH(idx) THEN
+          idx[nc] := s2; INC(nc)
+          END;;
+        END;
+      ELSE
+        nc := 0; isOpenA := TRUE;;
+      END;
     END;
     Expect(26);
     Type(e);
+    IF isOpenA THEN
+    t := SymTab.NewOpen(e)
+    ELSE
     t := e;
     kk := nc;
     WHILE kk > 0 DO
@@ -1803,6 +1930,7 @@ PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
       END;
       t := SymTab.NewArrayB(t,
               loA, hiA)
+    END
     END;;
   END ArrayType;
 
@@ -1931,7 +2059,7 @@ PROCEDURE SimpleType (VAR t: SymTab.TypeIndex);
       MGen.NoEmitExit;;
     ELSIF (sym = 19) THEN
       Enum(t);
-    ELSE SynError(78);
+    ELSE SynError(81);
     END;
   END SimpleType;
 
@@ -2039,7 +2167,7 @@ PROCEDURE Type (VAR t: SymTab.TypeIndex);
       SetType(t);
     ELSIF (sym = 29) THEN
       PointerType(t);
-    ELSE SynError(79);
+    ELSE SynError(82);
     END;
   END Type;
 
@@ -2065,6 +2193,29 @@ PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
           t := SymTab.InvalidType;
           MGen.Drop; MGen.Drop; MGen.PushInt(0)
         END
+      ELSIF (t # SymTab.InvalidType)
+         & (t2 # SymTab.InvalidType)
+         & (SymTab.ClassOf(t) = SymTab.ClArray)
+         & (SymTab.ClassOf(t2) = SymTab.ClArray)
+         & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
+         & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
+         & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
+        t := SymTab.BoolType();
+        MGen.PushBytes(SymTab.TypeSlots(t) * 8);
+        MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
+        MGen.StrComp;
+        IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
+        ELSIF (op = SymTab.OpNeq1)
+              OR (op = SymTab.OpNeq2) THEN MGen.Or
+        ELSIF op = SymTab.OpLt THEN
+          MGen.Swap; MGen.Drop
+        ELSIF op = SymTab.OpLe THEN
+          MGen.Drop; MGen.Not
+        ELSIF op = SymTab.OpGt THEN
+          MGen.Drop
+        ELSE
+          MGen.Swap; MGen.Drop; MGen.Not
+        END
       ELSIF (t # SymTab.InvalidType)
          & (t2 # SymTab.InvalidType)
          & ((SymTab.ClassOf(t) = SymTab.ClArray)
@@ -2160,7 +2311,7 @@ PROCEDURE ProcedureDecl;
       SymTab.SetForward;
         SymTab.CloseProc;
         MGen.DefLabel(endL);;
-    ELSE SynError(80);
+    ELSE SynError(83);
     END;
   END ProcedureDecl;
 
@@ -2274,7 +2425,7 @@ PROCEDURE Declaration;
     ELSIF (sym = 18) THEN
       ProcedureDecl;
       Expect(6);
-    ELSE SynError(81);
+    ELSE SynError(84);
     END;
   END Declaration;
 
@@ -2340,7 +2491,7 @@ PROCEDURE Import;
       Get;
       ImportList;
       Expect(6);
-    ELSE SynError(82);
+    ELSE SynError(85);
     END;
   END Import;
 
@@ -2393,13 +2544,13 @@ BEGIN
   symSet[ 1, 0] := BITSET{1, 2, 3, 4};
   symSet[ 1, 1] := BITSET{3};
   symSet[ 1, 2] := BITSET{14};
-  symSet[ 1, 3] := BITSET{11};
-  symSet[ 1, 4] := BITSET{3, 4, 5};
+  symSet[ 1, 3] := BITSET{13};
+  symSet[ 1, 4] := BITSET{5, 6, 7, 8};
   symSet[ 2, 0] := BITSET{};
   symSet[ 2, 1] := BITSET{};
   symSet[ 2, 2] := BITSET{};
-  symSet[ 2, 3] := BITSET{13, 14, 15};
-  symSet[ 2, 4] := BITSET{0, 1, 2};
+  symSet[ 2, 3] := BITSET{15};
+  symSet[ 2, 4] := BITSET{0, 1, 2, 3, 4};
   symSet[ 3, 0] := BITSET{6, 12};
   symSet[ 3, 1] := BITSET{};
   symSet[ 3, 2] := BITSET{3, 4, 6, 10};
@@ -2408,12 +2559,12 @@ BEGIN
   symSet[ 4, 0] := BITSET{1};
   symSet[ 4, 1] := BITSET{15};
   symSet[ 4, 2] := BITSET{1, 5, 7, 9, 11, 12, 15};
-  symSet[ 4, 3] := BITSET{0, 1, 2};
+  symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4};
   symSet[ 4, 4] := BITSET{};
   symSet[ 5, 0] := BITSET{};
   symSet[ 5, 1] := BITSET{0};
   symSet[ 5, 2] := BITSET{};
-  symSet[ 5, 3] := BITSET{4, 5, 6, 7, 8, 9, 10};
+  symSet[ 5, 3] := BITSET{6, 7, 8, 9, 10, 11, 12};
   symSet[ 5, 4] := BITSET{};
   symSet[ 6, 0] := BITSET{11, 12, 13, 14, 15};
   symSet[ 6, 1] := BITSET{2};


+ 25 - 21
M2cS.mod

@@ -5,7 +5,7 @@ IMPLEMENTATION MODULE M2cS;
 IMPORT FileIO, Storage;
 
 CONST
-  noSYMB  = 71; (*error token code*)
+  noSYMB  = 74; (*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,7 +102,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
   PROCEDURE CheckLiteral;
     BEGIN
       CASE CurrentCh(bp0) OF
-        "A": IF Equal("AND") THEN sym := 65; 
+        "A": IF Equal("AND") THEN sym := 67; 
              ELSIF Equal("ARRAY") THEN sym := 25; 
              END
       | "B": IF Equal("BEGIN") THEN sym := 11; 
@@ -112,7 +112,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
              ELSIF Equal("CONST") THEN sym := 13; 
              END
       | "D": IF Equal("DISPOSE") THEN sym := 50; 
-             ELSIF Equal("DIV") THEN sym := 63; 
+             ELSIF Equal("DIV") THEN sym := 65; 
              ELSIF Equal("DO") THEN sym := 40; 
              END
       | "E": IF Equal("ELSE") THEN sym := 36; 
@@ -124,20 +124,22 @@ PROCEDURE Get (VAR sym: CARDINAL);
              ELSIF Equal("FORWARD") THEN sym := 21; 
              ELSIF Equal("FROM") THEN sym := 8; 
              END
+      | "H": IF Equal("HIGH") THEN sym := 69; 
+             END
       | "I": IF Equal("IF") THEN sym := 33; 
              ELSIF Equal("IMPORT") THEN sym := 9; 
-             ELSIF Equal("IN") THEN sym := 58; 
+             ELSIF Equal("IN") THEN sym := 60; 
              END
       | "L": IF Equal("LOOP") THEN sym := 43; 
              END
-      | "M": IF Equal("MOD") THEN sym := 64; 
+      | "M": IF Equal("MOD") THEN sym := 66; 
              ELSIF Equal("MODULE") THEN sym := 5; 
              END
       | "N": IF Equal("NEW") THEN sym := 49; 
-             ELSIF Equal("NOT") THEN sym := 67; 
+             ELSIF Equal("NOT") THEN sym := 70; 
              END
       | "O": IF Equal("OF") THEN sym := 26; 
-             ELSIF Equal("OR") THEN sym := 60; 
+             ELSIF Equal("OR") THEN sym := 62; 
              END
       | "P": IF Equal("POINTER") THEN sym := 29; 
              ELSIF Equal("PROCEDURE") THEN sym := 18; 
@@ -158,6 +160,8 @@ PROCEDURE Get (VAR sym: CARDINAL);
              END
       | "W": IF Equal("WHILE") THEN sym := 39; 
              ELSIF Equal("WITH") THEN sym := 47; 
+             ELSIF Equal("WriteInt") THEN sym := 51; 
+             ELSIF Equal("WriteString") THEN sym := 52; 
              END
       ELSE
       END
@@ -243,25 +247,25 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | 24: sym := 32; RETURN
       | 25: sym := 38; RETURN
       | 26: sym := 46; RETURN
-      | 27: sym := 51; RETURN
-      | 28: sym := 52; RETURN
+      | 27: sym := 53; RETURN
+      | 28: sym := 54; RETURN
       | 29: IF (ch = ">") THEN state := 30; 
             ELSIF (ch = "=") THEN state := 31; 
-            ELSE sym := 54; RETURN
+            ELSE sym := 56; RETURN
             END;
-      | 30: sym := 53; RETURN
-      | 31: sym := 55; RETURN
+      | 30: sym := 55; RETURN
+      | 31: sym := 57; RETURN
       | 32: IF (ch = "=") THEN state := 33; 
-            ELSE sym := 56; RETURN
+            ELSE sym := 58; RETURN
             END;
-      | 33: sym := 57; RETURN
-      | 34: sym := 59; RETURN
-      | 35: sym := 61; RETURN
-      | 36: sym := 62; RETURN
-      | 37: sym := 66; RETURN
-      | 38: sym := 68; RETURN
-      | 39: sym := 69; RETURN
-      | 40: sym := 70; RETURN
+      | 33: sym := 59; RETURN
+      | 34: sym := 61; RETURN
+      | 35: sym := 63; RETURN
+      | 36: sym := 64; RETURN
+      | 37: sym := 68; RETURN
+      | 38: sym := 71; RETURN
+      | 39: sym := 72; RETURN
+      | 40: sym := 73; RETURN
       | 41: sym := 0; ch := 0C; DEC(bp); RETURN
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       END


+ 9 - 0
MGen.def

@@ -243,6 +243,15 @@ PROCEDURE WithDepth (): CARDINAL;
 PROCEDURE WithAddr (name: ARRAY OF CHAR);
 (* Pushes field address for visible WITH field (or push-0 if absent). *)
 
+PROCEDURE PrintNum (): CARDINAL;
+(* Number of the embedded decimal-print helper (maxNum+1). *)
+
+PROCEDURE CallPrint;
+(* Calls the print helper (expects value on stack), drops result. *)
+
+PROCEDURE SysCall;
+(* C3H SYSTEM host call (pops id+param; see spec 9.3). *)
+
 (* ---- procedures (see §5.2) ---- *)
 
 PROCEDURE ProcEntry (num: INTEGER; nLoc: CARDINAL);

+ 55 - 3
MGen.mod

@@ -67,6 +67,7 @@ TYPE
   ActFrame = RECORD
     n : CARDINAL;
     tmps : ARRAY [0 .. MaxActN] OF INTEGER;
+    lens : ARRAY [0 .. MaxActN] OF INTEGER;
     known : BOOLEAN;
     nf : CARDINAL;
     pn : ARRAY [0 .. 63] OF CHAR;
@@ -435,7 +436,9 @@ PROCEDURE PushAddr (name: ARRAY OF CHAR);
        & (k # SymTab.KindVarPar) THEN
       EmitOp(OPimm0); RETURN
     END;
-    IF k = SymTab.KindVarPar THEN
+    IF (k = SymTab.KindVarPar)
+       OR ((k = SymTab.KindParam)
+           & SymTab.IsOpen(SymTab.SymType(name))) THEN
       IF D = d THEN LoadLocal(sl)
       ELSE
         np := VAL(CARDINAL, D - 1 - d);
@@ -578,6 +581,7 @@ PROCEDURE ActFrameIdx (): CARDINAL;
 
 PROCEDURE ActBegin (pn: ARRAY OF CHAR);
   VAR fr : CARDINAL;
+    k : CARDINAL;
   BEGIN
     fr := actTop;
     IF fr > MaxActDepth THEN fr := MaxActDepth
@@ -585,6 +589,10 @@ PROCEDURE ActBegin (pn: ARRAY OF CHAR);
     END;
     StrCpy(actSt[fr].pn, pn);
     actSt[fr].n := 0;
+    k := 0;
+    WHILE k <= MaxActN DO
+      actSt[fr].lens[k] := -1; INC(k)
+    END;
     actSt[fr].known := SymTab.Lookup(pn)
       & (SymTab.SymKind(pn) = SymTab.KindProc);
     IF actSt[fr].known THEN actSt[fr].nf := SymTab.ProcNPar(pn)
@@ -611,7 +619,31 @@ PROCEDURE ActValue (t: INTEGER; v: BOOLEAN;
     IF actSt[fr].known & (i < actSt[fr].nf) THEN
       ftyp := SymTab.ParamType(actSt[fr].pn, i);
       fv := SymTab.ParamIsVar(actSt[fr].pn, i);
-      IF fv THEN
+      IF SymTab.IsOpen(ftyp) THEN
+        IF (t = SymTab.InvalidType)
+           OR SymTab.IsOpen(t)
+           OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN
+          err := 1
+        ELSIF ~SymTab.SameType(SymTab.ArrayElem(t),
+                               SymTab.ArrayElem(ftyp)) THEN
+          err := 1
+        ELSIF fv & ~v THEN
+          err := 1
+        END;
+        IF (t # SymTab.InvalidType)
+           & (SymTab.ClassOf(t) = SymTab.ClArray)
+           & ~SymTab.IsOpen(t) THEN
+          PushInt(VAL(INTEGER, SymTab.ArrayLen(t)))
+        ELSE
+          PushInt(0)
+        END;
+        actSt[fr].lens[i] := TempGlobal();
+        StoreTemp(actSt[fr].lens[i]);
+        IF fv THEN
+          EmitOp(OPext); EmitOp(SUBdrop);
+          PushAddr(vn)
+        END
+      ELSIF fv THEN
         IF ~v THEN err := 1
         ELSIF ~SymTab.SameType(t, ftyp) THEN err := 1
         END;
@@ -656,7 +688,15 @@ PROCEDURE ActEnd (pn: ARRAY OF CHAR; sfx, inExpr: BOOLEAN): INTEGER;
     i := actSt[fr].n;
     WHILE i > 0 DO
       DEC(i);
-      IF i <= MaxActN THEN LoadTemp(actSt[fr].tmps[i]) END
+      IF i <= MaxActN THEN
+        IF (actSt[fr].lens[i] >= 0)
+           & SymTab.IsOpen(SymTab.ParamType(pn, i)) THEN
+          LoadTemp(actSt[fr].lens[i]);
+          LoadTemp(actSt[fr].tmps[i])
+        ELSE
+          LoadTemp(actSt[fr].tmps[i])
+        END
+      END
     END;
     num := SymTab.ProcNum(pn);
     F := SymTab.CurDepth();
@@ -1082,6 +1122,18 @@ PROCEDURE WithAddr (name: ARRAY OF CHAR);
     IF ~found THEN PushInt(0) END
   END WithAddr;
 
+PROCEDURE PrintNum (): CARDINAL;
+  BEGIN RETURN maxNum + 1 END PrintNum;
+
+PROCEDURE CallPrint;
+  BEGIN
+    EmitOpB(OPprocCall, maxNum + 1);
+    EmitOp(OPext); EmitOp(SUBdrop)
+  END CallPrint;
+
+PROCEDURE SysCall;
+  BEGIN EmitOp(OPsys) END SysCall;
+
 (* ---------------- control flow ---------------- *)
 
 PROCEDURE NewLabel (): INTEGER;


BIN
OBadHigh.MC4


BIN
OBadOpen.MC4


BIN
OChar.MC4


BIN
OHigh.MC4


BIN
OOpen.MC4


BIN
OOpen2.MC4


BIN
OVal.MC4


BIN
PBadDispose.MC4


BIN
PNewArr.MC4


BIN
RBadAsn.MC4


BIN
RBadOpen.MC4


BIN
RCopy2.MC4


BIN
SBadCmp.MC4


BIN
SBadOp.MC4


BIN
SCmp2.MC4


BIN
SStrEq.MC4


+ 2 - 0
SymTab.def

@@ -123,6 +123,8 @@ PROCEDURE NewEnum (): TypeIndex;
 PROCEDURE EnumAdd (t: TypeIndex);
 PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
 PROCEDURE NewArrayB (elem: TypeIndex; lo, hi: INTEGER): TypeIndex;
+PROCEDURE NewOpen (elem: TypeIndex): TypeIndex;
+PROCEDURE IsOpen (t: TypeIndex): BOOLEAN;
 PROCEDURE NewRecord (): TypeIndex;
 PROCEDURE NewSet (base: TypeIndex): TypeIndex;
 PROCEDURE NewPtr (base: TypeIndex): TypeIndex;

+ 31 - 1
SymTab.mod

@@ -66,6 +66,7 @@ VAR
   tLo : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
   tHi : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
   tNext : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
+  tOpen : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
   nTypes : CARDINAL;
   fields : ARRAY [0 .. MaxFields - 1] OF Field;
   nFields : CARDINAL;
@@ -375,6 +376,7 @@ PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
     tLo[nTypes] := 0;
     tHi[nTypes] := -1;
     tNext[nTypes] := 0;
+    tOpen[nTypes] := FALSE;
     INC(nTypes);
     RETURN VAL(INTEGER, nTypes - 1)
   END NewDesc;
@@ -436,6 +438,30 @@ PROCEDURE NewArrayB (elem: TypeIndex; lo, hi: INTEGER): TypeIndex;
     RETURN t
   END NewArrayB;
 
+PROCEDURE NewOpen (elem: TypeIndex): TypeIndex;
+  VAR t : TypeIndex;
+  BEGIN
+    t := NewDesc(FArray, elem);
+    IF t # InvalidType THEN
+      tLo[t] := 0; tHi[t] := -1; tOpen[t] := TRUE
+    END;
+    RETURN t
+  END NewOpen;
+
+PROCEDURE IsOpen (t: TypeIndex): BOOLEAN;
+  VAR r : TypeIndex;
+  BEGIN
+    r := t;
+    IF (r >= 0) & (r < VAL(INTEGER, nTypes)) & (tform[r] = FAlias) THEN
+      r := tref[r]
+    END;
+    IF (r = InvalidType) OR (r < 0) OR (r >= VAL(INTEGER, nTypes)) THEN
+      RETURN FALSE
+    END;
+    IF tform[r] # FArray THEN RETURN FALSE END;
+    RETURN tOpen[r]
+  END IsOpen;
+
 PROCEDURE NewRecord (): TypeIndex;
   BEGIN
     RETURN NewDesc(FRecord, -1)
@@ -919,7 +945,11 @@ PROCEDURE EnterParam (name: ARRAY OF CHAR; isVar: BOOLEAN;
     IF idx = -1 THEN RETURN FALSE END;
     SetSymType(name, t);
     syms[idx].slot := 3 + VAL(INTEGER, parCnt[pdep]);
-    INC(parCnt[pdep]);
+    IF IsOpen(t) THEN
+      INC(parCnt[pdep], 2)
+    ELSE
+      INC(parCnt[pdep])
+    END;
     pi := NewParamRec(t, isVar);
     IF pi # -1 THEN AppParam(pi, FALSE) END;
     RETURN TRUE

BIN
SymTab.o


BIN
TBadArr.MC4


BIN
VBadVar.MC4


BIN
WBadInt.MC4


BIN
WBadStr.MC4


BIN
WIo.MC4


BIN
WStr2.MC4


+ 79 - 0
docs/summary_step5.md

@@ -0,0 +1,79 @@
+# Step 5 — Open arrays, copy, strings, I/O, NIL trap (uncommitted)
+
+99/99 tests green (74 regressions + 15 run + 10 rejection), mc64 suite green.
+
+## Goal
+
+Phase 4, first half: 1D open arrays (`ARRAY OF T`, `HIGH`, VAR + value,
+fixed actuals only), whole array/record copy (`copy_block`), fixed
+`CHAR`-array `=`/`#`/`<`/`<=`/`>`/`>=` (`string_comp`), `WriteInt` /
+`WriteString` (SYSTEM 1 + print helper), NIL-trap (VM Fatal, no static
+check). Deferred to step 6: single-file modules, VAR tails (`233`),
+value composites (`230`), open-to-open (`233`).
+
+## What was built
+
+- `SymTab`: `NewOpen`/`IsOpen` (`tOpen` flag), open params take 2 slots
+  (`EnterParam`: addr+len, `parCnt+=2`, `Leave` drops slots, arity still
+  counts formals).
+- `MGen`: open actuals (`ActValue`: addr + `ArrayLen` const → 2 temps;
+  `ActEnd`: reload len then addr so addr lands at base), `PushAddr`
+  treats open value params as indirect, `PrintNum`/`CallPrint`
+  (print helper), `SysCall` (`0C3`), `Swap`/`LoadByte`/`StoreByte`
+  already from step 4.
+- `M2c.atg`: `ArrayType` allows `ARRAY OF` (no index → `NewOpen`;
+  LL(1) via `OF` lookahead), record fields reject open (`230`),
+  `HIGH(...)` builtin (fixed `ArrayHi`, open `len-1` via `LoadLocal`
+  or display `FrameAddr+LoadIndir`; non-array `217`), whole copy
+  (`pushedDst` for all whole Array/Record vars + `pushedFld` fields:
+  string `Str→Array` with length check `210`, else `Assignable`?
+  copy : `210`; no more `230` for same-type copy), fixed `CHAR`-array
+  compare (`StrComp` + `Or`/`Not`/`Swap`/`Drop`, no `RealEq` cmp),
+  `WriteInt` (`IsIntFamily`? `CallPrint` : `210`), `WriteString`
+  (`Str` or `Array-of-CHAR`? `PushInt(1)` + `SysCall` : `210`).
+- `mc64/Interpreter`: `string_comp` gt/lt swap fix + src-NUL length
+  fix (`dst` non-NUL → `gt`); NIL trap on `41H/51H/60H-6FH/70H-7FH`
+  (`p=0` → Fatal, exit 1). `mkdtest` field_mask 252 unchanged
+  (exclusive VM kept; M2c ranges inclusive via hi+1 from step 4).
+
+## Tests — 99/99 (74 + 15 + 10)
+
+15 run: `o_open` 150 (VAR open+HIGH), `c_copy` 18 (whole array),
+`s_streq` 21 (`=/#/<`), `o_val` 14 (value open), `o_high` 14
+(`HIGH` fixed 5+9), `c_rec` 17 (whole record), `w_io` hi42
+(`WriteString`+`WriteInt`), `o_open2` 286 (two lengths, runtime HIGH),
+`c_copy2` 9 (CHAR copy), `s_cmp2` 10 (`>/>=/<=`), `r_copy2` 15
+(nested record copy), `a_subopen` 66 (2D subarray actual),
+`w_str2` ok8 (WriteString var), `p_newarr` 66 (NEW array + `p^[i]`),
+`o_char` 4 (open CHAR+HIGH). 10 rejections, each exactly one error:
+`o_bad_open` 233 (open-to-open), `o_bad_high` 217, `c_bad_len` 210,
+`s_bad_cmp` 213, `v_bad_var` 233 (VAR `a[i]`), `w_bad_int` 210,
+`w_bad_str` 210, `r_bad_open` 230, `p_bad_dispose` 219, `s_bad_op` 211.
+
+## Bugs found and fixed
+
+1. `string_comp` gt/lt swapped (`src>dst` gave `gt`, should be `lt`)
+   + src-NUL ignored longer `dst` (gave equal, should be `gt`).
+2. String `=`/`#` used `RealEq`/`RealNe` (extra `OPrCmp` on gt/lt —
+   reinterprets bits as REAL) — use `Or`/`Not`/`Swap`/`Drop` only.
+3. Whole `a:=x` (array:=int) gave `230` hiding `210` — check
+   `Assignable` before `230` (same for records/fields).
+4. `t_bad_array` (`a:=b` same-type) became valid after whole-copy
+   lift — repurposed to open-var `230`, added `c_copy` run (18).
+5. Empty `""` lexed as CHAR (len 2 ≤ 3 → `CharOrd('"')`=34) — CHAR
+   iff len = 3; len 2/≥4 is Str (empty via `EmitString` NUL only).
+6. Single-slot `[1..1]` CHAR arrays took scalar `StoreFinish`
+   (stored pointer, no length check) — `pushedDst` for any Array-CHAR
+   (not just slots>1); `s_bad_long` (`"abcdefghij"` → 11 > 8) now 210.
+7. `Design` unreachable after WITH lift (Coco error, step 4 loop) —
+   removed dead `Design` (step-4 build already fixed; kept).
+
+## Known limits (deferred with rejection tests)
+
+Open-to-open actuals `233`, VAR designators with tails (`a[i]`/`p^`/
+fields as VAR) `233`, value composite params/returns `230` (`a_bad_val`
+kept), open string compare `213`→`230`? (currently `213` via
+Array/Record guard; open CHAR `=` gives `213` — acceptable, no test),
+`HIGH` on open needs same/descendant frame (display walk implemented,
+untested beyond one level), `WriteInt` prints unsigned (like `ExitCode`;
+negatives wrap), modules single-file untouched (step 6).

+ 29 - 0
run_tests.sh

@@ -190,5 +190,34 @@ expect_fail a_bad_val.mod "not supported in this phase"
 expect_fail s_bad_long.mod "incompatible assignment"
 expect_fail r_bad_asn.mod "incompatible assignment"
 
+echo "=== Step-5 run tests (open arrays, copy, strings, I/O) ==="
+expect_run o_open.mod 150
+expect_run c_copy.mod 18
+expect_run s_streq.mod 21
+expect_run o_val.mod 14
+expect_run o_high.mod 14
+expect_run c_rec.mod 17
+expect_run w_io.mod hi42
+expect_run o_open2.mod 286
+expect_run c_copy2.mod 9
+expect_run s_cmp2.mod 10
+expect_run r_copy2.mod 15
+expect_run a_subopen.mod 66
+expect_run w_str2.mod ok8
+expect_run p_newarr.mod 66
+expect_run o_char.mod 4
+
+echo "=== Step-5 rejection tests ==="
+expect_fail o_bad_open.mod "invalid procedure call"
+expect_fail o_bad_high.mod "not an ARRAY type"
+expect_fail c_bad_len.mod "incompatible assignment"
+expect_fail s_bad_cmp.mod "incompatible comparison"
+expect_fail v_bad_var.mod "invalid procedure call"
+expect_fail w_bad_int.mod "incompatible assignment"
+expect_fail w_bad_str.mod "incompatible assignment"
+expect_fail r_bad_open.mod "not supported in this phase"
+expect_fail p_bad_dispose.mod "not a POINTER type"
+expect_fail s_bad_op.mod "arithmetic operand must be numeric"
+
 echo "=== $pass passed, $fail failed ==="
 test "$fail" = 0

+ 20 - 0
tests/a_subopen.LST

@@ -0,0 +1,20 @@
+Listing:
+
+    1  MODULE ASubOpen;
+    2  VAR m : ARRAY [1 .. 2], [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Sum(x : ARRAY OF INTEGER) : INTEGER;
+    4  VAR i, s : INTEGER;
+    5  BEGIN
+    6    s := 0;
+    7    FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+    8    RETURN s
+    9  END Sum;
+   10  BEGIN
+   11    m[1,1] := 1; m[1,2] := 2; m[1,3] := 3;
+   12    m[2,1] := 10; m[2,2] := 20; m[2,3] := 30;
+   13    ExitCode := Sum(m[1]) + Sum(m[2])
+   14  END ASubOpen.
+
+    0 errors
+
+

+ 14 - 0
tests/a_subopen.mod

@@ -0,0 +1,14 @@
+MODULE ASubOpen;
+VAR m : ARRAY [1 .. 2], [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Sum(x : ARRAY OF INTEGER) : INTEGER;
+VAR i, s : INTEGER;
+BEGIN
+  s := 0;
+  FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+  RETURN s
+END Sum;
+BEGIN
+  m[1,1] := 1; m[1,2] := 2; m[1,3] := 3;
+  m[2,1] := 10; m[2,2] := 20; m[2,3] := 30;
+  ExitCode := Sum(m[1]) + Sum(m[2])
+END ASubOpen.

+ 12 - 0
tests/c_bad_len.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE CBadLen;
+    2  VAR a : ARRAY [1 .. 5] OF INTEGER; b : ARRAY [1 .. 6] OF INTEGER;
+    3  BEGIN
+    4    a := b
+*****         ^ incompatible assignment
+    5  END CBadLen.
+
+    1 error
+
+

+ 5 - 0
tests/c_bad_len.mod

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

+ 13 - 0
tests/c_copy.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE CCopy;
+    2  VAR a, b : ARRAY [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    a[1] := 5; a[2] := 6; a[3] := 7;
+    5    b := a;
+    6    ExitCode := b[1] + b[2] + b[3]
+    7  END CCopy.
+
+    0 errors
+
+

+ 7 - 0
tests/c_copy.mod

@@ -0,0 +1,7 @@
+MODULE CCopy;
+VAR a, b : ARRAY [1 .. 3] OF INTEGER; ExitCode : INTEGER;
+BEGIN
+  a[1] := 5; a[2] := 6; a[3] := 7;
+  b := a;
+  ExitCode := b[1] + b[2] + b[3]
+END CCopy.

+ 13 - 0
tests/c_copy2.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE CCopy2;
+    2  VAR a, b : ARRAY [1 .. 5] OF CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    a := "hello";
+    5    b := a;
+    6    IF (b[1] = "h") AND (b[5] = "o") THEN ExitCode := 9 ELSE ExitCode := 0 END
+    7  END CCopy2.
+
+    0 errors
+
+

+ 7 - 0
tests/c_copy2.mod

@@ -0,0 +1,7 @@
+MODULE CCopy2;
+VAR a, b : ARRAY [1 .. 5] OF CHAR; ExitCode : INTEGER;
+BEGIN
+  a := "hello";
+  b := a;
+  IF (b[1] = "h") AND (b[5] = "o") THEN ExitCode := 9 ELSE ExitCode := 0 END
+END CCopy2.

+ 14 - 0
tests/c_rec.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE CRec;
+    2  TYPE R = RECORD x, y : INTEGER END;
+    3  VAR r1, r2 : R; ExitCode : INTEGER;
+    4  BEGIN
+    5    r1.x := 8; r1.y := 9;
+    6    r2 := r1;
+    7    ExitCode := r2.x + r2.y
+    8  END CRec.
+
+    0 errors
+
+

+ 8 - 0
tests/c_rec.mod

@@ -0,0 +1,8 @@
+MODULE CRec;
+TYPE R = RECORD x, y : INTEGER END;
+VAR r1, r2 : R; ExitCode : INTEGER;
+BEGIN
+  r1.x := 8; r1.y := 9;
+  r2 := r1;
+  ExitCode := r2.x + r2.y
+END CRec.

+ 12 - 0
tests/o_bad_high.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE OBadHigh;
+    2  VAR x : INTEGER;
+    3  BEGIN
+    4    x := HIGH(x)
+*****               ^ not an ARRAY type
+    5  END OBadHigh.
+
+    1 error
+
+

+ 5 - 0
tests/o_bad_high.mod

@@ -0,0 +1,5 @@
+MODULE OBadHigh;
+VAR x : INTEGER;
+BEGIN
+  x := HIGH(x)
+END OBadHigh.

+ 19 - 0
tests/o_bad_open.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  MODULE OBadOpen;
+    2  VAR a : ARRAY [1 .. 3] OF INTEGER;
+    3  PROCEDURE P(VAR x : ARRAY OF INTEGER);
+    4  BEGIN
+    5  END P;
+    6  PROCEDURE Q(VAR y : ARRAY OF INTEGER);
+    7  BEGIN
+    8    P(y)
+*****      ^ invalid procedure call
+    9  END Q;
+   10  BEGIN
+   11    P(a)
+   12  END OBadOpen.
+
+    1 error
+
+

+ 12 - 0
tests/o_bad_open.mod

@@ -0,0 +1,12 @@
+MODULE OBadOpen;
+VAR a : ARRAY [1 .. 3] OF INTEGER;
+PROCEDURE P(VAR x : ARRAY OF INTEGER);
+BEGIN
+END P;
+PROCEDURE Q(VAR y : ARRAY OF INTEGER);
+BEGIN
+  P(y)
+END Q;
+BEGIN
+  P(a)
+END OBadOpen.

+ 16 - 0
tests/o_char.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE OChar;
+    2  VAR a : ARRAY [1 .. 4] OF CHAR; ExitCode : INTEGER;
+    3  PROCEDURE Count(VAR x : ARRAY OF CHAR) : INTEGER;
+    4  BEGIN
+    5    RETURN HIGH(x) + 1
+    6  END Count;
+    7  BEGIN
+    8    a := "test";
+    9    ExitCode := Count(a)
+   10  END OChar.
+
+    0 errors
+
+

+ 10 - 0
tests/o_char.mod

@@ -0,0 +1,10 @@
+MODULE OChar;
+VAR a : ARRAY [1 .. 4] OF CHAR; ExitCode : INTEGER;
+PROCEDURE Count(VAR x : ARRAY OF CHAR) : INTEGER;
+BEGIN
+  RETURN HIGH(x) + 1
+END Count;
+BEGIN
+  a := "test";
+  ExitCode := Count(a)
+END OChar.

+ 11 - 0
tests/o_high.LST

@@ -0,0 +1,11 @@
+Listing:
+
+    1  MODULE OHigh;
+    2  VAR a : ARRAY [1 .. 5] OF INTEGER; b : ARRAY [0 .. 9] OF INTEGER; ExitCode : INTEGER;
+    3  BEGIN
+    4    ExitCode := HIGH(a) + HIGH(b)
+    5  END OHigh.
+
+    0 errors
+
+

+ 5 - 0
tests/o_high.mod

@@ -0,0 +1,5 @@
+MODULE OHigh;
+VAR a : ARRAY [1 .. 5] OF INTEGER; b : ARRAY [0 .. 9] OF INTEGER; ExitCode : INTEGER;
+BEGIN
+  ExitCode := HIGH(a) + HIGH(b)
+END OHigh.

+ 19 - 0
tests/o_open.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  MODULE OOpen;
+    2  VAR a : ARRAY [1 .. 5] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+    4  VAR i, s : INTEGER;
+    5  BEGIN
+    6    s := 0;
+    7    FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+    8    RETURN s
+    9  END Sum;
+   10  BEGIN
+   11    a[1] := 10; a[2] := 20; a[3] := 30; a[4] := 40; a[5] := 50;
+   12    ExitCode := Sum(a)
+   13  END OOpen.
+
+    0 errors
+
+

+ 13 - 0
tests/o_open.mod

@@ -0,0 +1,13 @@
+MODULE OOpen;
+VAR a : ARRAY [1 .. 5] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+VAR i, s : INTEGER;
+BEGIN
+  s := 0;
+  FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+  RETURN s
+END Sum;
+BEGIN
+  a[1] := 10; a[2] := 20; a[3] := 30; a[4] := 40; a[5] := 50;
+  ExitCode := Sum(a)
+END OOpen.

+ 20 - 0
tests/o_open2.LST

@@ -0,0 +1,20 @@
+Listing:
+
+    1  MODULE OOpen2;
+    2  VAR a : ARRAY [1 .. 3] OF INTEGER; b : ARRAY [1 .. 7] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+    4  VAR i, s : INTEGER;
+    5  BEGIN
+    6    s := 0;
+    7    FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+    8    RETURN s
+    9  END Sum;
+   10  BEGIN
+   11    a[1] := 1; a[2] := 2; a[3] := 3;
+   12    b[1] := 10; b[2] := 20; b[3] := 30; b[4] := 40; b[5] := 50; b[6] := 60; b[7] := 70;
+   13    ExitCode := Sum(a) + Sum(b)
+   14  END OOpen2.
+
+    0 errors
+
+

+ 14 - 0
tests/o_open2.mod

@@ -0,0 +1,14 @@
+MODULE OOpen2;
+VAR a : ARRAY [1 .. 3] OF INTEGER; b : ARRAY [1 .. 7] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Sum(VAR x : ARRAY OF INTEGER) : INTEGER;
+VAR i, s : INTEGER;
+BEGIN
+  s := 0;
+  FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+  RETURN s
+END Sum;
+BEGIN
+  a[1] := 1; a[2] := 2; a[3] := 3;
+  b[1] := 10; b[2] := 20; b[3] := 30; b[4] := 40; b[5] := 50; b[6] := 60; b[7] := 70;
+  ExitCode := Sum(a) + Sum(b)
+END OOpen2.

+ 19 - 0
tests/o_val.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  MODULE OVal;
+    2  VAR a : ARRAY [0 .. 4] OF INTEGER; ExitCode : INTEGER;
+    3  PROCEDURE Sum(x : ARRAY OF INTEGER) : INTEGER;
+    4  VAR i, s : INTEGER;
+    5  BEGIN
+    6    s := 0;
+    7    FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+    8    RETURN s
+    9  END Sum;
+   10  BEGIN
+   11    a[0] := 3; a[1] := 1; a[2] := 4; a[3] := 1; a[4] := 5;
+   12    ExitCode := Sum(a)
+   13  END OVal.
+
+    0 errors
+
+

+ 13 - 0
tests/o_val.mod

@@ -0,0 +1,13 @@
+MODULE OVal;
+VAR a : ARRAY [0 .. 4] OF INTEGER; ExitCode : INTEGER;
+PROCEDURE Sum(x : ARRAY OF INTEGER) : INTEGER;
+VAR i, s : INTEGER;
+BEGIN
+  s := 0;
+  FOR i := 0 TO HIGH(x) DO s := s + x[i] END;
+  RETURN s
+END Sum;
+BEGIN
+  a[0] := 3; a[1] := 1; a[2] := 4; a[3] := 1; a[4] := 5;
+  ExitCode := Sum(a)
+END OVal.

+ 12 - 0
tests/p_bad_dispose.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE PBadDispose;
+    2  VAR x : INTEGER;
+    3  BEGIN
+    4    DISPOSE(x)
+*****             ^ not a POINTER type
+    5  END PBadDispose.
+
+    1 error
+
+

+ 5 - 0
tests/p_bad_dispose.mod

@@ -0,0 +1,5 @@
+MODULE PBadDispose;
+VAR x : INTEGER;
+BEGIN
+  DISPOSE(x)
+END PBadDispose.

+ 15 - 0
tests/p_newarr.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE PNewArr;
+    2  TYPE P = POINTER TO ARRAY [1 .. 3] OF INTEGER;
+    3  VAR p : P; ExitCode : INTEGER;
+    4  BEGIN
+    5    NEW(p);
+    6    p^[1] := 11; p^[2] := 22; p^[3] := 33;
+    7    ExitCode := p^[1] + p^[2] + p^[3];
+    8    DISPOSE(p)
+    9  END PNewArr.
+
+    0 errors
+
+

+ 9 - 0
tests/p_newarr.mod

@@ -0,0 +1,9 @@
+MODULE PNewArr;
+TYPE P = POINTER TO ARRAY [1 .. 3] OF INTEGER;
+VAR p : P; ExitCode : INTEGER;
+BEGIN
+  NEW(p);
+  p^[1] := 11; p^[2] := 22; p^[3] := 33;
+  ExitCode := p^[1] + p^[2] + p^[3];
+  DISPOSE(p)
+END PNewArr.

+ 12 - 0
tests/r_bad_open.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE RBadOpen;
+    2  TYPE R = RECORD a : ARRAY OF INTEGER END;
+*****                               ^ not supported in this phase
+    3  VAR r : R;
+    4  BEGIN
+    5  END RBadOpen.
+
+    1 error
+
+

+ 5 - 0
tests/r_bad_open.mod

@@ -0,0 +1,5 @@
+MODULE RBadOpen;
+TYPE R = RECORD a : ARRAY OF INTEGER END;
+VAR r : R;
+BEGIN
+END RBadOpen.

+ 15 - 0
tests/r_copy2.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE RCopy2;
+    2  TYPE Inner = RECORD u, v : INTEGER END;
+    3  TYPE Outer = RECORD a : INTEGER; b : Inner END;
+    4  VAR r1, r2 : Outer; ExitCode : INTEGER;
+    5  BEGIN
+    6    r1.a := 4; r1.b.u := 5; r1.b.v := 6;
+    7    r2 := r1;
+    8    ExitCode := r2.a + r2.b.u + r2.b.v
+    9  END RCopy2.
+
+    0 errors
+
+

+ 9 - 0
tests/r_copy2.mod

@@ -0,0 +1,9 @@
+MODULE RCopy2;
+TYPE Inner = RECORD u, v : INTEGER END;
+TYPE Outer = RECORD a : INTEGER; b : Inner END;
+VAR r1, r2 : Outer; ExitCode : INTEGER;
+BEGIN
+  r1.a := 4; r1.b.u := 5; r1.b.v := 6;
+  r2 := r1;
+  ExitCode := r2.a + r2.b.u + r2.b.v
+END RCopy2.

+ 12 - 0
tests/s_bad_cmp.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE SBadCmp;
+    2  VAR a, b : ARRAY [1 .. 3] OF INTEGER;
+    3  BEGIN
+    4    IF a = b THEN END
+*****           ^ incompatible comparison
+    5  END SBadCmp.
+
+    1 error
+
+

+ 5 - 0
tests/s_bad_cmp.mod

@@ -0,0 +1,5 @@
+MODULE SBadCmp;
+VAR a, b : ARRAY [1 .. 3] OF INTEGER;
+BEGIN
+  IF a = b THEN END
+END SBadCmp.

+ 12 - 0
tests/s_bad_op.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE SBadOp;
+    2  VAR s : SET OF [0 .. 7]; x : INTEGER;
+    3  BEGIN
+    4    s := s + x
+*****             ^ arithmetic operand must be numeric
+    5  END SBadOp.
+
+    1 error
+
+

+ 5 - 0
tests/s_bad_op.mod

@@ -0,0 +1,5 @@
+MODULE SBadOp;
+VAR s : SET OF [0 .. 7]; x : INTEGER;
+BEGIN
+  s := s + x
+END SBadOp.

+ 16 - 0
tests/s_cmp2.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE SCmp2;
+    2  VAR s1, s2 : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    s1 := "abd";
+    5    s2 := "abc";
+    6    ExitCode := 0;
+    7    IF s1 > s2 THEN ExitCode := 2 ELSE ExitCode := 0 END;
+    8    IF s1 >= s2 THEN ExitCode := ExitCode + 3 ELSE ExitCode := 0 END;
+    9    IF s2 <= s1 THEN ExitCode := ExitCode + 5 ELSE ExitCode := 0 END
+   10  END SCmp2.
+
+    0 errors
+
+

+ 10 - 0
tests/s_cmp2.mod

@@ -0,0 +1,10 @@
+MODULE SCmp2;
+VAR s1, s2 : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+BEGIN
+  s1 := "abd";
+  s2 := "abc";
+  ExitCode := 0;
+  IF s1 > s2 THEN ExitCode := 2 ELSE ExitCode := 0 END;
+  IF s1 >= s2 THEN ExitCode := ExitCode + 3 ELSE ExitCode := 0 END;
+  IF s2 <= s1 THEN ExitCode := ExitCode + 5 ELSE ExitCode := 0 END
+END SCmp2.

+ 16 - 0
tests/s_streq.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE SStrEq;
+    2  VAR s1, s2 : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    s1 := "abc";
+    5    s2 := "abc";
+    6    IF s1 = s2 THEN ExitCode := 4 ELSE ExitCode := 0 END;
+    7    s2 := "abd";
+    8    IF s1 # s2 THEN ExitCode := ExitCode + 6 ELSE ExitCode := 0 END;
+    9    IF s1 < s2 THEN ExitCode := ExitCode + 11 ELSE ExitCode := 0 END
+   10  END SStrEq.
+
+    0 errors
+
+

+ 10 - 0
tests/s_streq.mod

@@ -0,0 +1,10 @@
+MODULE SStrEq;
+VAR s1, s2 : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+BEGIN
+  s1 := "abc";
+  s2 := "abc";
+  IF s1 = s2 THEN ExitCode := 4 ELSE ExitCode := 0 END;
+  s2 := "abd";
+  IF s1 # s2 THEN ExitCode := ExitCode + 6 ELSE ExitCode := 0 END;
+  IF s1 < s2 THEN ExitCode := ExitCode + 11 ELSE ExitCode := 0 END
+END SStrEq.

+ 4 - 5
tests/t_bad_array.LST

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

+ 2 - 3
tests/t_bad_array.mod

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

+ 15 - 0
tests/v_bad_var.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE VBadVar;
+    2  VAR a : ARRAY [1 .. 3] OF INTEGER;
+    3  PROCEDURE P(VAR x : INTEGER);
+    4  BEGIN
+    5  END P;
+    6  BEGIN
+    7    P(a[1])
+*****         ^ invalid procedure call
+    8  END VBadVar.
+
+    1 error
+
+

+ 8 - 0
tests/v_bad_var.mod

@@ -0,0 +1,8 @@
+MODULE VBadVar;
+VAR a : ARRAY [1 .. 3] OF INTEGER;
+PROCEDURE P(VAR x : INTEGER);
+BEGIN
+END P;
+BEGIN
+  P(a[1])
+END VBadVar.

+ 12 - 0
tests/w_bad_int.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE WBadInt;
+    2  VAR a : ARRAY [1 .. 3] OF INTEGER;
+    3  BEGIN
+    4    WriteInt(a)
+*****              ^ incompatible assignment
+    5  END WBadInt.
+
+    1 error
+
+

+ 5 - 0
tests/w_bad_int.mod

@@ -0,0 +1,5 @@
+MODULE WBadInt;
+VAR a : ARRAY [1 .. 3] OF INTEGER;
+BEGIN
+  WriteInt(a)
+END WBadInt.

+ 12 - 0
tests/w_bad_str.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE WBadStr;
+    2  VAR x : INTEGER;
+    3  BEGIN
+    4    WriteString(x)
+*****                 ^ incompatible assignment
+    5  END WBadStr.
+
+    1 error
+
+

+ 5 - 0
tests/w_bad_str.mod

@@ -0,0 +1,5 @@
+MODULE WBadStr;
+VAR x : INTEGER;
+BEGIN
+  WriteString(x)
+END WBadStr.

+ 13 - 0
tests/w_io.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE WIo;
+    2  VAR ExitCode : INTEGER;
+    3  BEGIN
+    4    WriteString("hi");
+    5    WriteInt(42);
+    6    ExitCode := 7
+    7  END WIo.
+
+    0 errors
+
+

+ 7 - 0
tests/w_io.mod

@@ -0,0 +1,7 @@
+MODULE WIo;
+VAR ExitCode : INTEGER;
+BEGIN
+  WriteString("hi");
+  WriteInt(42);
+  ExitCode := 7
+END WIo.

+ 14 - 0
tests/w_str2.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE WStr2;
+    2  VAR s : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+    3  BEGIN
+    4    s := "ok";
+    5    WriteString(s);
+    6    WriteInt(8);
+    7    ExitCode := 3
+    8  END WStr2.
+
+    0 errors
+
+

+ 8 - 0
tests/w_str2.mod

@@ -0,0 +1,8 @@
+MODULE WStr2;
+VAR s : ARRAY [1 .. 10] OF CHAR; ExitCode : INTEGER;
+BEGIN
+  s := "ok";
+  WriteString(s);
+  WriteInt(8);
+  ExitCode := 3
+END WStr2.