فهرست منبع

m2comp step 5 — separate compilation (DEFINITION/IMPLEMENTATION/IMPORT, single image, 54/54 tests green)

Eric Streit 3 هفته پیش
والد
کامیت
ff564e1981
56فایلهای تغییر یافته به همراه2035 افزوده شده و 463 حذف شده
  1. BIN
      M2comp
  2. BIN
      MC4/DBasic.MC4
  3. BIN
      MC4/DFrom.MC4
  4. BIN
      MC4/DFunc.MC4
  5. BIN
      MC4/DInit.MC4
  6. BIN
      MC4/DMulti.MC4
  7. BIN
      MC4/DType.MC4
  8. 97 0
      docs/summary_m2comp_step5.md
  9. 70 0
      run_tests.sh
  10. 223 34
      src/M2comp.atg
  11. 73 68
      src/M2comp.err
  12. 5 5
      src/M2comp.lst
  13. 188 79
      src/M2comp.mod
  14. BIN
      src/M2comp.o
  15. 431 195
      src/M2compP.mod
  16. BIN
      src/M2compP.o
  17. 64 62
      src/M2compS.mod
  18. BIN
      src/M2compS.o
  19. 63 7
      src/MGen.mod
  20. BIN
      src/MGen.o
  21. 90 2
      src/SymTab.def
  22. 243 0
      src/SymTab.mod
  23. BIN
      src/SymTab.o
  24. 115 11
      src/compiler.frm
  25. 11 0
      tests/d_bad_dup.LST
  26. 3 0
      tests/d_bad_dup.def
  27. 14 0
      tests/d_bad_nobody.LST
  28. 7 0
      tests/d_bad_nobody.mod
  29. 14 0
      tests/d_bad_nodef.LST
  30. 5 0
      tests/d_bad_nodef.mod
  31. 13 0
      tests/d_bad_noimpl.LST
  32. 6 0
      tests/d_bad_noimpl.mod
  33. 13 0
      tests/d_bad_priv.LST
  34. 6 0
      tests/d_bad_priv.mod
  35. 19 0
      tests/d_bad_sig.LST
  36. 11 0
      tests/d_bad_sig.mod
  37. 18 0
      tests/d_basic.LST
  38. 9 0
      tests/d_basic.mod
  39. 16 0
      tests/d_from.LST
  40. 10 0
      tests/d_from.mod
  41. 14 0
      tests/d_func.LST
  42. 8 0
      tests/d_func.mod
  43. 12 0
      tests/d_init.LST
  44. 6 0
      tests/d_init.mod
  45. 14 0
      tests/d_lib.LST
  46. 8 0
      tests/d_lib.def
  47. 13 0
      tests/d_lib2.LST
  48. 7 0
      tests/d_lib2.def
  49. 15 0
      tests/d_lib2impl.LST
  50. 9 0
      tests/d_lib2impl.mod
  51. 22 0
      tests/d_libimpl.LST
  52. 16 0
      tests/d_libimpl.mod
  53. 16 0
      tests/d_multi.LST
  54. 10 0
      tests/d_multi.mod
  55. 17 0
      tests/d_type.LST
  56. 11 0
      tests/d_type.mod

BIN
MC4/DBasic.MC4


BIN
MC4/DFrom.MC4


BIN
MC4/DFunc.MC4


BIN
MC4/DInit.MC4


BIN
MC4/DMulti.MC4


BIN
MC4/DType.MC4


+ 97 - 0
docs/summary_m2comp_step5.md

@@ -0,0 +1,97 @@
+# m2comp step 5 — separate compilation (tag: `m2comp-step5`)
+
+Single-image separate compilation, v1 step-11 style: `M2comp lib.def
+impl.mod prog.mod` compiles definitions, then implementations, then
+exactly one program into one `<Prog>.MC4` (depCount 0). One `.LST`
+per input, fail-fast. Suite 54/54 (41 inherited + 6 run + 7 reject);
+all single-file images byte-identical to step 4 (no drift).
+
+## Session model
+
+- Grammar: `M2comp = Unit "."`, `Unit = "DEFINITION" DefUnit |
+  "IMPLEMENTATION" ImplUnit | Module`. New keywords DEFINITION /
+  IMPLEMENTATION (token numbers shifted; `Msg` regenerated from
+  `.err` automatically, no test depends on numbers).
+- `DEFINITION MODULE L` — CONST (integer-family only, else 230) /
+  TYPE / VAR + procedure HEADINGS (no bodies). All top-level names
+  auto-exported at `END` (parameters excluded).
+- `IMPLEMENTATION MODULE L` — needs L defined (201) and not yet
+  implemented (200); private CONST/TYPE/VAR + bodies + optional
+  `BEGIN` init body. Every heading needs its body at `END` (231).
+- Program `MODULE` — `IMPORT L` / `FROM L IMPORT x` need L defined
+  AND implemented (201). Unknown-module imports stay unchecked
+  stubs (legacy behavior, unchanged).
+- Order inside a session is free except program-last (grammar checks
+  enforce per-library order); a second program file fails the
+  session with `Incorrect source` (no `.LST` mark). A session
+  without a program emits nothing (`Incorrect source`).
+
+## What was built
+
+- `src/SymTab`: session state (no per-file `Init`; driver inits
+  once) — `SetUnit/UnitKind`, `BeginDef/EndDef` (auto-export +
+  def registry), `DefExists/ImplDone`, `OpenImpl/EndImpl` (fresh
+  scope + interface materialization), `EnterHeading`,
+  `BeginBody/EndBodyHeader` (body headers re-parse into the heading
+  entry: signature snapshot compare, 231 on mismatch/double-body),
+  `EnterAlias/SetProcNum` (FROM-import materialization),
+  `ExpConstVal` + const-value export snapshot (integer family).
+  231 message already existed in the driver (`compiler.frm`).
+- Grammar: `DefDecl/ProcHeading`, `ImplUnit/ImplDecl/ImplProcBody`,
+  rewritten `Import` (second `ax` attribute carries alias decl
+  nodes) + `ImpName` (201 unknown / 200 duplicate / 230
+  unsupported), `InProc` guard (session FROM-import inside a
+  PROCEDURE is 230), `InDef` guard (REAL/STRING CONST in a
+  definition is 230). `ConstFold` accepts qualified `Lib.C` (bounds
+  across files).
+- Driver (`compiler.frm`): `SymTab.Init` once, per-file
+  `ResetErrors` (the `firstErr` list never reset — stale errors
+  leaked into later files' listings), unit-root collection, impl→def
+  merge by module name, ONE `MGen.EmitModule` over the session
+  root (program decls chained after the library units; zero units
+  reuses the program root verbatim).
+- `src/MGen` (3 small changes): `EmitDecls` shares the library
+  global slot for tag-stamped alias `nkVar`s (no double slots);
+  `ConstFindMod` + tag-aware `PushConstName`/`ConstTextOf` with an
+  export-table fallback (plain `IMPORT` + `Lib.C` needs no
+  materialization); `EmitExpr` routes qualified const designators
+  (`aux = KindConst`) to the const path.
+- `run_tests.sh`: `expect_run_files` / `expect_fail_files` /
+  `expect_fail_multi` (MC4-aware, timeout-guarded like the rest).
+
+## Tests — 54/54
+
+New `tests/d_*` (hand-computed ExitCodes): `DBasic` 60 (FROM +
+qualified, var/proc), `DFrom` 35 (two libs, const/var/proc,
+cross-def import), `DMulti` 68 (qualified VAR actual), `DInit` 7
+(impl `BEGIN` runs: preset 2 vs zeroed 0), `DFunc` 81 (nested
+function calls), `DType` 40 (`FROM` array type + qualified
+`Lib.Point` record). Rejections: unknown definition (201),
+signature mismatch (231), missing body (231), unimplemented
+import (201), duplicate definition (200), private access (201),
+second program file (driver-level).
+
+## Bugs found (all fixed, all covered)
+
+- `Unit` double-consumed `MODULE` (every file rejected) — `Module`
+  keeps its own keyword.
+- `ProcHeading` ate the `;` its caller also expected (def files
+  rejected with cascade `';' expected`).
+- Driver stage machine rejected def-after-impl; relaxed to
+  program-last (v1 interleaves per lib too).
+- Test-only: `CONST dbl = step + step` doesn't fold (`ConstFold`
+  is literal/negation/name-only, pre-existing single-file limit) —
+  test lib uses a literal + a bound-via-imported-const instead.
+
+## Limits (documented, next steps)
+
+- One program per session; def/impl file order must respect
+  dependencies (imports need completed implementations).
+- Interface consts are integer-family only (CHAR/BOOLEAN/ordinal
+  included); REAL/STRING consts in definitions are 230.
+- Bodies are define-before-use inside an implementation (V2 has no
+  FORWARD, same discipline as everywhere else).
+- Unknown-module imports unchecked (legacy); proc/type/var/const
+  exports only (no opaque or procedure types yet).
+- Next candidates: opaque + procedure types, `WITH`/`CASE`,
+  `LONGINT`/`LONGREAL` quads, multi-`.MC4` depCount emission.

+ 70 - 0
run_tests.sh

@@ -85,6 +85,61 @@ expect_run_none() {
     fail=$((fail+1)); echo "FAIL(silent): $name output [$got]"
     fail=$((fail+1)); echo "FAIL(silent): $name output [$got]"
   fi
   fi
 }
 }
+expect_run_files() {
+  # $1 = program module (MC4 base), $2 = expected value, rest = sources
+  # (definitions, then implementations, then the program).
+  prog="$1"
+  want="$2"
+  shift 2
+  mcd="MC4/$prog.MC4"
+  rm -f "$mcd" "$prog.MC4"
+  if ./M2comp "$@" 2>&1 | grep -q "Incorrect source"; then
+    fail=$((fail+1)); echo "FAIL(run): $prog rejected"; return
+  fi
+  [ -f "$prog.MC4" ] && mv -f "$prog.MC4" "$mcd"
+  collect_mcd
+  if [ ! -f "$mcd" ]; then
+    fail=$((fail+1)); echo "FAIL(run): $prog no $mcd"; return
+  fi
+  timeout "$MCTIMEOUT" "$MCINT" "$mcd" > /tmp/m2comp_out.txt 2>&1; rc=$?
+  if [ "$rc" -ne 0 ]; then
+    fail=$((fail+1)); echo "FAIL(run): $prog vm rc=$rc (diverges?)"; return
+  fi
+  got=$(head -n 1 /tmp/m2comp_out.txt | tr -d '\r')
+  if [ "$got" = "$want" ]; then
+    pass=$((pass+1)); echo "PASS(run): $prog -> $got"
+  else
+    fail=$((fail+1)); echo "FAIL(run): $prog printed [$got], want [$want]"
+  fi
+}
+expect_fail_files() {
+  # $1 = message in the failing file's .LST, rest = sources.
+  want="$1"
+  shift
+  if ./M2comp "$@" 2>&1 | grep -q "Incorrect source"; then
+    :
+  else
+    fail=$((fail+1)); echo "FAIL(fail, accepted): $*"; return
+  fi
+  collect_mcd
+  last=""
+  for f in "$@"; do last="$f"; done
+  lst=$(echo "$last" | sed 's/\.[^.]*$/.LST/')
+  if grep -q "$want" "$lst" 2>/dev/null; then
+    pass=$((pass+1)); echo "PASS(fail): $last [$want]"
+  else
+    fail=$((fail+1)); echo "FAIL(fail): [$want] not found in $lst"
+  fi
+}
+expect_fail_multi() {
+  # stdout-only rejection (driver stage errors leave no .LST mark).
+  if ./M2comp "$@" 2>&1 | grep -q "Incorrect source"; then
+    pass=$((pass+1)); echo "PASS(fail): $*"
+  else
+    fail=$((fail+1)); echo "FAIL(fail, accepted): $*"
+  fi
+  collect_mcd
+}
 expect_ok tests/ok_minimal.mod
 expect_ok tests/ok_minimal.mod
 expect_ok tests/ok_proc.mod
 expect_ok tests/ok_proc.mod
 expect_ok tests/showcase.mod
 expect_ok tests/showcase.mod
@@ -126,5 +181,20 @@ expect_run r_string.mod 111
 expect_run r_ptr.mod 111
 expect_run r_ptr.mod 111
 expect_run r_module.mod 83
 expect_run r_module.mod 83
 expect_run r_const.mod 1102
 expect_run r_const.mod 1102
+echo "=== Step-5 run tests (DEFINITION/IMPLEMENTATION/IMPORT) ==="
+expect_run_files DBasic 60 tests/d_lib.def tests/d_libimpl.mod tests/d_basic.mod
+expect_run_files DFrom 35 tests/d_lib.def tests/d_libimpl.mod tests/d_lib2.def tests/d_lib2impl.mod tests/d_from.mod
+expect_run_files DMulti 68 tests/d_lib.def tests/d_libimpl.mod tests/d_lib2.def tests/d_lib2impl.mod tests/d_multi.mod
+expect_run_files DInit 7 tests/d_lib.def tests/d_libimpl.mod tests/d_init.mod
+expect_run_files DFunc 81 tests/d_lib.def tests/d_libimpl.mod tests/d_func.mod
+expect_run_files DType 40 tests/d_lib.def tests/d_libimpl.mod tests/d_type.mod
+echo "=== Step-5 rejection tests ==="
+expect_fail_files "undeclared identifier" tests/d_bad_nodef.mod
+expect_fail_files "procedure forward mismatch" tests/d_lib.def tests/d_bad_sig.mod
+expect_fail_files "procedure forward mismatch" tests/d_lib.def tests/d_bad_nobody.mod
+expect_fail_files "undeclared identifier" tests/d_lib.def tests/d_bad_noimpl.mod
+expect_fail_files "duplicate identifier" tests/d_lib.def tests/d_bad_dup.def
+expect_fail_files "undeclared identifier" tests/d_lib.def tests/d_libimpl.mod tests/d_bad_priv.mod
+expect_fail_multi tests/d_lib.def tests/d_libimpl.mod tests/d_basic.mod tests/d_basic.mod
 echo "--- $pass passed, $fail failed ---"
 echo "--- $pass passed, $fail failed ---"
 [ "$fail" -eq 0 ]
 [ "$fail" -eq 0 ]

+ 223 - 34
src/M2comp.atg

@@ -8,8 +8,10 @@ COMPILER M2comp
    213 comparison, 214 condition, 215 not a record, 216 unknown field,
    213 comparison, 214 condition, 215 not a record, 216 unknown field,
    217 not an array, 218 bad index, 219 not a pointer, 220 FOR misuse,
    217 not an array, 218 bad index, 219 not a pointer, 220 FOR misuse,
    221 not a type, 222 set mismatch, 223 cyclical type, 224 ordinal
    221 not a type, 222 set mismatch, 223 cyclical type, 224 ordinal
-   required, 230 unsupported (EXIT outside LOOP, open array outside
-   formal), 232 bad RETURN, 233 invalid call. 231 unused (no FORWARD).
+    required, 230 unsupported (EXIT outside LOOP, open array outside
+    formal, FROM-lib import inside PROCEDURE, REAL/STRING CONST in
+    a DEFINITION), 232 bad RETURN, 233 invalid call. 231 heading/
+    body mismatch or missing body (step 5, separate compilation).
    Kowarsch rules kept from step 1: local MODULEs in Wirth form,
    Kowarsch rules kept from step 1: local MODULEs in Wirth form,
    unary minus takes a Factor (3.3), abbreviated arrays (3.1),
    unary minus takes a Factor (3.3), abbreviated arrays (3.1),
    no octal B/C (2.1). "~" never added (2.2); "<>" still accepted. *)
    no octal B/C (2.1). "~" never added (2.2); "<>" still accepted. *)
@@ -45,15 +47,140 @@ PRODUCTIONS
      compiler.frm). After grammar edits, rebuild and check that
      compiler.frm). After grammar edits, rebuild and check that
      the messages still name the right tokens. *)
      the messages still name the right tokens. *)
   M2comp
   M2comp
-    = Module "." .
+    = Unit "." .
+  Unit
+    = "DEFINITION" DefUnit
+    | "IMPLEMENTATION" ImplUnit
+    | Module .
+  DefUnit                             (. VAR m1, m2: SymTab.Name;
+                                           d, rt: AST.Node;
+                                           im, ax, dn: AST.Node; .)
+    =                                 (. SymTab.SetUnit(SymTab.UnitDef);
+                                         d := NIL; .)
+      "MODULE"
+      GetIdent<m1>                    (. IF ~SymTab.BeginDef(m1) THEN
+                                          SemError(200) END; .)
+      ";"
+      { Import<im, ax>                (. d := AST.Append(d, im);
+                                         d := AST.Append(d, ax); .) }
+      { DefDecl<dn>                   (. d := AST.Append(d, dn); .) }
+      "END"
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                          SemError(202)
+                                         ELSIF ~SymTab.EndDef(m1) THEN
+                                          SemError(200) END;
+                                         rt := AST.MkModule(m1, d, NIL);
+                                         AST.SetRoot(rt);
+                                         SymTab.PrintTable;
+                                         AST.DumpTree(
+                                           AST.GetRoot()); .) .
+  DefDecl<VAR n: AST.Node>            (. VAR cn: AST.Node; .)
+    = "CONST"                         (. n := NIL; .)
+      { ConstDecl<cn> ";"             (. n := AST.Append(n, cn); .) }
+    | "TYPE"                          (. n := NIL; .)
+      { TypeDecl<cn> ";"              (. n := AST.Append(n, cn); .) }
+    | "VAR"                           (. n := NIL; .)
+      { VarDecl<cn> ";"               (. n := AST.Append(n, cn); .) }
+    | ProcHeading ";"                 (. n := NIL; .) .
+  ProcHeading                         (. VAR m1: SymTab.Name;
+                                           rt: SymTab.TypeIndex;
+                                           p: AST.Node; .)
+    =                                 (. rt := SymTab.InvalidType;
+                                         p := NIL; .)
+      "PROCEDURE"
+      GetIdent<m1>                    (. IF ~SymTab.EnterHeading(m1) THEN
+                                          SemError(200) END; .)
+      [ FormalParams<p> ]
+      [ ":"
+        QualIdent<rt>                 (. SymTab.SetProcRet(rt);
+                                        IF (rt #
+                                           SymTab.InvalidType)
+                                           & ((SymTab.ClassOf(rt) =
+                                              SymTab.ClArray)
+                                              OR (SymTab.ClassOf(
+                                                 rt) =
+                                                 SymTab.ClRecord)) THEN
+                                          SemError(230) END; .) ] .
+  ImplUnit                            (. VAR m1, m2: SymTab.Name;
+                                           d, bs, rt: AST.Node;
+                                           im, ax, dn: AST.Node; .)
+    =                                 (. SymTab.SetUnit(SymTab.UnitImpl);
+                                         d := NIL; bs := NIL; .)
+      "MODULE"
+      GetIdent<m1>                    (. IF ~SymTab.DefExists(m1) THEN
+                                          SemError(201)
+                                         ELSIF SymTab.ImplDone(m1) THEN
+                                          SemError(200)
+                                         ELSIF ~SymTab.OpenImpl(m1) THEN
+                                          SemError(230) END; .)
+      ";"
+      { Import<im, ax>                (. d := AST.Append(d, im);
+                                         d := AST.Append(d, ax); .) }
+      { ImplDecl<dn>                  (. d := AST.Append(d, dn); .) }
+      [ "BEGIN"
+        StatSeq<bs> ]
+      "END"
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                          SemError(202)
+                                         ELSIF ~SymTab.EndImpl(m1) THEN
+                                          SemError(231) END;
+                                         rt := AST.MkModule(m1, d,
+                                           AST.MkBlock(NIL, bs));
+                                         AST.SetRoot(rt);
+                                         SymTab.PrintTable;
+                                         AST.DumpTree(
+                                           AST.GetRoot()); .) .
+  ImplDecl<VAR n: AST.Node>           (. VAR cn: AST.Node; .)
+    = "CONST"                         (. n := NIL; .)
+      { ConstDecl<cn> ";"             (. n := AST.Append(n, cn); .) }
+    | "TYPE"                          (. n := NIL; .)
+      { TypeDecl<cn> ";"              (. n := AST.Append(n, cn); .) }
+    | "VAR"                           (. n := NIL; .)
+      { VarDecl<cn> ";"               (. n := AST.Append(n, cn); .) }
+    | ImplProcBody<cn>
+      ";"                             (. n := cn; .) .
+  ImplProcBody<VAR n: AST.Node>       (. VAR m1, m2, lib: SymTab.Name;
+                                           rt: SymTab.TypeIndex;
+                                           p, bd, bs: AST.Node;
+                                           pn: INTEGER; .)
+    =                                 (. rt := SymTab.InvalidType;
+                                         p := NIL; .)
+      "PROCEDURE"
+      GetIdent<m1>                    (. SymTab.CurModName(lib);
+                                         IF ~SymTab.BeginBody(lib,
+                                            m1) THEN
+                                          SemError(231) END;
+                                         SymTab.OpenProcScope; .)
+      [ FormalParams<p> ]
+      [ ":"
+        QualIdent<rt>                 (. SymTab.SetProcRet(rt);
+                                        IF (rt #
+                                           SymTab.InvalidType)
+                                           & ((SymTab.ClassOf(rt) =
+                                              SymTab.ClArray)
+                                              OR (SymTab.ClassOf(
+                                                 rt) =
+                                                 SymTab.ClRecord)) THEN
+                                          SemError(230) END; .) ]
+      ";"                             (. IF ~SymTab.EndBodyHeader() THEN
+                                          SemError(231) END;
+                                         pn := SymTab.ProcNum(m1); .)
+      Block<bd, bs>                   (. n := AST.MkProc(m1, rt, p,
+                                           AST.MkBlock(bd, bs));
+                                         n^.num := pn; .)
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                          SemError(202) END;
+                                         SymTab.CloseProc; .) .
   Module                              (. VAR m1, m2: SymTab.Name;
   Module                              (. VAR m1, m2: SymTab.Name;
                                            d, bd, bs, rt: AST.Node;
                                            d, bd, bs, rt: AST.Node;
-                                           im: AST.Node; .)
-    =                                 (. SymTab.Init; d := NIL; .)
+                                           im, ax: AST.Node; .)
+    =                                 (. SymTab.SetUnit(SymTab.UnitProg);
+                                         d := NIL; .)
       "MODULE"
       "MODULE"
       GetIdent<m1>
       GetIdent<m1>
       ";"
       ";"
-      { Import<im>                    (. d := AST.Append(d, im); .) }
+      { Import<im, ax>                (. d := AST.Append(d, im);
+                                         d := AST.Append(d, ax); .) }
       Block<bd, bs>                   (. d := AST.Append(d, bd);
       Block<bd, bs>                   (. d := AST.Append(d, bd);
                                         rt := AST.MkModule(m1, d,
                                         rt := AST.MkModule(m1, d,
                                           AST.MkBlock(NIL, bs));
                                           AST.MkBlock(NIL, bs));
@@ -63,29 +190,83 @@ PRODUCTIONS
                                         SymTab.PrintTable;
                                         SymTab.PrintTable;
                                         AST.DumpTree(
                                         AST.DumpTree(
                                           AST.GetRoot()); .) .
                                           AST.GetRoot()); .) .
-  Import<VAR n: AST.Node>              (. VAR mod: SymTab.Name;
-                                           h: AST.Node;
-                                           m: SymTab.Name; .)
-    =                                 (. mod[0] := 0C; .)
+  Import<VAR n: AST.Node; VAR ax: AST.Node>
+                                      (. VAR mod: SymTab.Name;
+                                           h, ah, t1, t2: AST.Node;
+                                           m: SymTab.Name;
+                                           sesh: BOOLEAN; .)
+    =                                 (. mod[0] := 0C;
+                                         n := NIL; ax := NIL;
+                                         sesh := FALSE; .)
       [ "FROM"
       [ "FROM"
-        GetIdent<m>                   (. IF ~SymTab.Enter(m,
-                                           SymTab.KindImport)
-                                         THEN SemError(200) END;
-                                        mod := m; .) ]
+        GetIdent<m>                   (. IF SymTab.DefExists(m) THEN
+                                          IF ~SymTab.ImplDone(m) THEN
+                                            SemError(201) END;
+                                          IF SymTab.InProc() THEN
+                                            SemError(230) END;
+                                          mod := m; sesh := TRUE
+                                         ELSE
+                                          IF ~SymTab.Enter(m,
+                                             SymTab.KindImport) THEN
+                                            SemError(200) END;
+                                          mod := m
+                                         END; .) ]
       "IMPORT"
       "IMPORT"
-      IdentList<h>
-      ";"                             (. n := AST.MkImport(mod, h); .) .
-  IdentList<VAR h: AST.Node>          (. VAR n: SymTab.Name; .)
-    = GetIdent<n>                     (. IF ~SymTab.Enter(n,
-                                           SymTab.KindImport)
-                                         THEN SemError(200) END;
-                                        h := AST.MkImpName(n); .)
+      ImpName<mod, sesh, h, ah>       (. ax := ah; .)
       { ","
       { ","
-        GetIdent<n>                   (. IF ~SymTab.Enter(n,
-                                           SymTab.KindImport)
-                                         THEN SemError(200) END;
-                                        h := AST.Append(h,
-                                          AST.MkImpName(n)); .) } .
+        ImpName<mod, sesh, t1, t2>    (. h := AST.Append(h, t1);
+                                         ax := AST.Append(ax, t2); .) }
+      ";"                             (. n := AST.MkImport(mod, h); .) .
+  ImpName<mod: SymTab.Name; sesh: BOOLEAN;
+          VAR h: AST.Node; VAR ah: AST.Node>
+                                      (. VAR nm: SymTab.Name;
+                                           k: INTEGER;
+                                           t: SymTab.TypeIndex;
+                                           v: INTEGER;
+                                           nd: AST.Node; .)
+    = GetIdent<nm>                    (. h := AST.MkImpName(nm);
+                                         ah := NIL;
+                                         IF sesh THEN
+                                           IF SymTab.ExpKind(mod,
+                                              nm) < 0 THEN
+                                             SemError(201)
+                                           ELSIF SymTab.Lookup(nm) THEN
+                                             SemError(200)
+                                           ELSIF ~SymTab.EnterAlias(
+                                              mod, nm) THEN
+                                             SemError(230)
+                                           ELSE
+                                             k := SymTab.SymKind(nm);
+                                             IF k =
+                                                SymTab.KindVar THEN
+                                               t := SymTab.SymType(
+                                                 nm);
+                                               nd := AST.MkVar(nm,
+                                                 t);
+                                               nd^.tag := mod;
+                                               ah := nd
+                                             ELSIF k =
+                                                SymTab.KindConst THEN
+                                               t := SymTab.SymType(
+                                                 nm);
+                                               IF SymTab.ExpConstVal(
+                                                  mod, nm, v) THEN
+                                                 ah := AST.MkConst(
+                                                   nm, AST.MkInt(v,
+                                                     t), t)
+                                               ELSE SemError(230)
+                                               END
+                                             END
+                                           END
+                                         ELSE
+                                           IF SymTab.DefExists(nm) THEN
+                                             IF ~SymTab.ImplDone(
+                                                nm) THEN
+                                               SemError(201) END
+                                           ELSIF ~SymTab.Enter(nm,
+                                              SymTab.KindImport) THEN
+                                             SemError(200) END
+                                         END; .) .
   GetIdent<VAR n: SymTab.Name>
   GetIdent<VAR n: SymTab.Name>
     = ident                           (. LexName(n); .) .
     = ident                           (. LexName(n); .) .
   Block<VAR d: AST.Node; VAR s: AST.Node>
   Block<VAR d: AST.Node; VAR s: AST.Node>
@@ -116,12 +297,19 @@ PRODUCTIONS
                                          THEN SemError(200) END; .)
                                          THEN SemError(200) END; .)
       "="
       "="
       ConstExpr<t, en>                (. SymTab.SetSymType(nm, t);
       ConstExpr<t, en>                (. SymTab.SetSymType(nm, t);
-                                        ok := SymTab.ConstFold(en,
-                                          cv);
-                                        SymTab.NoteConst(nm, cv,
-                                          ok);
-                                        n := AST.MkConst(nm, en,
-                                          t); .) .
+                                         ok := SymTab.ConstFold(en,
+                                           cv);
+                                         SymTab.NoteConst(nm, cv,
+                                           ok);
+                                         IF SymTab.InDef()
+                                            & ((SymTab.ClassOf(t) =
+                                               SymTab.ClReal)
+                                               OR (SymTab.ClassOf(
+                                                  t) =
+                                                  SymTab.ClStr)) THEN
+                                           SemError(230) END;
+                                         n := AST.MkConst(nm, en,
+                                           t); .) .
   ConstExpr<VAR t: SymTab.TypeIndex; VAR e: AST.Node>
   ConstExpr<VAR t: SymTab.TypeIndex; VAR e: AST.Node>
                                       (. VAR vD: BOOLEAN; .)
                                       (. VAR vD: BOOLEAN; .)
     = Expr<t, vD, e> .
     = Expr<t, vD, e> .
@@ -231,14 +419,15 @@ PRODUCTIONS
                                           isV)); .) } .
                                           isV)); .) } .
   ModuleDecl<VAR n: AST.Node>         (. VAR m1, m2: SymTab.Name;
   ModuleDecl<VAR n: AST.Node>         (. VAR m1, m2: SymTab.Name;
                                            d, bd, bs: AST.Node;
                                            d, bd, bs: AST.Node;
-                                           im, en: AST.Node; .)
+                                           im, ax, en: AST.Node; .)
     = "MODULE"                        (* local module, Wirth form *)
     = "MODULE"                        (* local module, Wirth form *)
                                       (. d := NIL; .)
                                       (. d := NIL; .)
       GetIdent<m1>                    (. IF ~SymTab.EnterModule(m1) THEN
       GetIdent<m1>                    (. IF ~SymTab.EnterModule(m1) THEN
                                          SemError(200) END; .)
                                          SemError(200) END; .)
       [ Priority ]
       [ Priority ]
       ";"
       ";"
-      { Import<im>                    (. d := AST.Append(d, im); .) }
+      { Import<im, ax>                (. d := AST.Append(d, im);
+                                         d := AST.Append(d, ax); .) }
       [ Export<en>                    (. d := AST.Append(d, en); .) ]
       [ Export<en>                    (. d := AST.Append(d, en); .) ]
       Block<bd, bs>                   (. d := AST.Append(d, bd);
       Block<bd, bs>                   (. d := AST.Append(d, bd);
                                         n := AST.MkModule(m1, d,
                                         n := AST.MkModule(m1, d,

+ 73 - 68
src/M2comp.err

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

+ 5 - 5
src/M2comp.lst

@@ -17,11 +17,11 @@ LL(1) conditions:         --  ok  --
 
 
 Statistics:
 Statistics:
 
 
-  nr of terminals:        64 (limit   400)
-  nr of non-terminals:    45 (limit   210)
-  nr of pragmas:           0 (limit   436)
-  nr of symbolnodes:     109 (limit   500)
-  nr of graphnodes:      474 (limit  1500)
+  nr of terminals:        66 (limit   400)
+  nr of non-terminals:    52 (limit   210)
+  nr of pragmas:           0 (limit   434)
+  nr of symbolnodes:     118 (limit   500)
+  nr of graphnodes:      590 (limit  1500)
   nr of conditionsets:     6 (limit   100)
   nr of conditionsets:     6 (limit   100)
   nr of charactersets:     9 (limit   250)
   nr of charactersets:     9 (limit   250)
 
 

+ 188 - 79
src/M2comp.mod

@@ -7,7 +7,7 @@ MODULE M2comp;
   FROM M2compS IMPORT lst, src, errors, Error, CharAt;
   FROM M2compS IMPORT lst, src, errors, Error, CharAt;
   FROM M2compP IMPORT Parse, Successful;
   FROM M2compP IMPORT Parse, Successful;
   IMPORT
   IMPORT
-    Strings, Storage, SYSTEM, FileIO, AST, MGen;
+    Strings, Storage, SYSTEM, FileIO, AST, MGen, SymTab;
 
 
   TYPE
   TYPE
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
@@ -18,7 +18,7 @@ MODULE M2comp;
     FROM Storage IMPORT ALLOCATE;
     FROM Storage IMPORT ALLOCATE;
     FROM SYSTEM IMPORT TSIZE;
     FROM SYSTEM IMPORT TSIZE;
     IMPORT lst, CharAt, errors, INT32;
     IMPORT lst, CharAt, errors, INT32;
-    EXPORT StoreError, PrintListing;
+    EXPORT StoreError, PrintListing, ResetErrors;
 
 
     TYPE
     TYPE
       Err = POINTER TO ErrDesc;
       Err = POINTER TO ErrDesc;
@@ -102,74 +102,79 @@ MODULE M2comp;
         |  3: Msg("real expected")
         |  3: Msg("real expected")
         |  4: Msg("string expected")
         |  4: Msg("string expected")
         |  5: Msg("'.' expected")
         |  5: Msg("'.' expected")
-        |  6: Msg("'MODULE' expected")
-        |  7: Msg("';' expected")
-        |  8: Msg("'FROM' expected")
-        |  9: Msg("'IMPORT' expected")
-        | 10: Msg("',' expected")
-        | 11: Msg("'BEGIN' expected")
-        | 12: Msg("'END' expected")
-        | 13: Msg("'CONST' expected")
-        | 14: Msg("'TYPE' expected")
-        | 15: Msg("'VAR' expected")
-        | 16: Msg("'=' expected")
-        | 17: Msg("':' expected")
-        | 18: Msg("'PROCEDURE' expected")
-        | 19: Msg("'(' expected")
-        | 20: Msg("')' expected")
-        | 21: Msg("'[' expected")
-        | 22: Msg("']' expected")
-        | 23: Msg("'EXPORT' expected")
-        | 24: Msg("'QUALIFIED' expected")
-        | 25: Msg("'ARRAY' expected")
-        | 26: Msg("'OF' expected")
-        | 27: Msg("'RECORD' expected")
-        | 28: Msg("'SET' expected")
-        | 29: Msg("'POINTER' expected")
-        | 30: Msg("'TO' expected")
-        | 31: Msg("'..' expected")
-        | 32: Msg("'EXIT' expected")
-        | 33: Msg("':=' expected")
-        | 34: Msg("'^' expected")
-        | 35: Msg("'IF' expected")
-        | 36: Msg("'THEN' expected")
-        | 37: Msg("'ELSIF' expected")
-        | 38: Msg("'ELSE' expected")
-        | 39: Msg("'WHILE' expected")
-        | 40: Msg("'DO' expected")
-        | 41: Msg("'REPEAT' expected")
-        | 42: Msg("'UNTIL' expected")
-        | 43: Msg("'LOOP' expected")
-        | 44: Msg("'FOR' expected")
-        | 45: Msg("'BY' expected")
-        | 46: Msg("'RETURN' expected")
-        | 47: Msg("'#' expected")
-        | 48: Msg("'<>' expected")
-        | 49: Msg("'<' expected")
-        | 50: Msg("'<=' expected")
-        | 51: Msg("'>' expected")
-        | 52: Msg("'>=' expected")
-        | 53: Msg("'IN' expected")
-        | 54: Msg("'+' expected")
-        | 55: Msg("'-' expected")
-        | 56: Msg("'OR' expected")
-        | 57: Msg("'*' expected")
-        | 58: Msg("'/' expected")
-        | 59: Msg("'DIV' expected")
-        | 60: Msg("'MOD' expected")
-        | 61: Msg("'AND' expected")
-        | 62: Msg("'NOT' expected")
-        | 63: Msg("not expected")
-        | 64: Msg("invalid MulOp")
-        | 65: Msg("invalid AddOp")
-        | 66: Msg("invalid Fact")
-        | 67: Msg("invalid Relation")
-        | 68: Msg("invalid SimExpr")
-        | 69: Msg("invalid AssignOrCall")
-        | 70: Msg("invalid IndexType")
-        | 71: Msg("invalid BoundedBase")
-        | 72: Msg("invalid Type")
-        | 73: Msg("invalid Declaration")
+        |  6: Msg("'DEFINITION' expected")
+        |  7: Msg("'IMPLEMENTATION' expected")
+        |  8: Msg("'MODULE' expected")
+        |  9: Msg("';' expected")
+        | 10: Msg("'END' expected")
+        | 11: Msg("'CONST' expected")
+        | 12: Msg("'TYPE' expected")
+        | 13: Msg("'VAR' expected")
+        | 14: Msg("'PROCEDURE' expected")
+        | 15: Msg("':' expected")
+        | 16: Msg("'BEGIN' expected")
+        | 17: Msg("'FROM' expected")
+        | 18: Msg("'IMPORT' expected")
+        | 19: Msg("',' expected")
+        | 20: Msg("'=' expected")
+        | 21: Msg("'(' expected")
+        | 22: Msg("')' expected")
+        | 23: Msg("'[' expected")
+        | 24: Msg("']' expected")
+        | 25: Msg("'EXPORT' expected")
+        | 26: Msg("'QUALIFIED' expected")
+        | 27: Msg("'ARRAY' expected")
+        | 28: Msg("'OF' expected")
+        | 29: Msg("'RECORD' expected")
+        | 30: Msg("'SET' expected")
+        | 31: Msg("'POINTER' expected")
+        | 32: Msg("'TO' expected")
+        | 33: Msg("'..' expected")
+        | 34: Msg("'EXIT' expected")
+        | 35: Msg("':=' expected")
+        | 36: Msg("'^' expected")
+        | 37: Msg("'IF' expected")
+        | 38: Msg("'THEN' expected")
+        | 39: Msg("'ELSIF' expected")
+        | 40: Msg("'ELSE' expected")
+        | 41: Msg("'WHILE' expected")
+        | 42: Msg("'DO' expected")
+        | 43: Msg("'REPEAT' expected")
+        | 44: Msg("'UNTIL' expected")
+        | 45: Msg("'LOOP' expected")
+        | 46: Msg("'FOR' expected")
+        | 47: Msg("'BY' expected")
+        | 48: Msg("'RETURN' expected")
+        | 49: Msg("'#' expected")
+        | 50: Msg("'<>' expected")
+        | 51: Msg("'<' expected")
+        | 52: Msg("'<=' expected")
+        | 53: Msg("'>' expected")
+        | 54: Msg("'>=' expected")
+        | 55: Msg("'IN' expected")
+        | 56: Msg("'+' expected")
+        | 57: Msg("'-' expected")
+        | 58: Msg("'OR' expected")
+        | 59: Msg("'*' expected")
+        | 60: Msg("'/' expected")
+        | 61: Msg("'DIV' expected")
+        | 62: Msg("'MOD' expected")
+        | 63: Msg("'AND' expected")
+        | 64: Msg("'NOT' expected")
+        | 65: Msg("not expected")
+        | 66: Msg("invalid MulOp")
+        | 67: Msg("invalid AddOp")
+        | 68: Msg("invalid Fact")
+        | 69: Msg("invalid Relation")
+        | 70: Msg("invalid SimExpr")
+        | 71: Msg("invalid AssignOrCall")
+        | 72: Msg("invalid IndexType")
+        | 73: Msg("invalid BoundedBase")
+        | 74: Msg("invalid Type")
+        | 75: Msg("invalid Declaration")
+        | 76: Msg("invalid ImplDecl")
+        | 77: Msg("invalid DefDecl")
+        | 78: Msg("invalid Unit")
         
         
         (* add customized cases here *)
         (* add customized cases here *)
         | 200: Msg("duplicate identifier")
         | 200: Msg("duplicate identifier")
@@ -199,6 +204,12 @@ MODULE M2comp;
         WriteLn(lst)
         WriteLn(lst)
       END PrintErr;
       END PrintErr;
 
 
+    PROCEDURE ResetErrors;
+    (* Drops stored errors so the next input file starts clean. *)
+      BEGIN
+        firstErr := NIL; lastErr := NIL
+      END ResetErrors;
+
     PROCEDURE PrintListing;
     PROCEDURE PrintListing;
     (* Print a source listing with error messages *)
     (* Print a source listing with error messages *)
       VAR
       VAR
@@ -264,6 +275,23 @@ MODULE M2comp;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     failed: BOOLEAN;
     failed: BOOLEAN;
     emitOk: BOOLEAN;
     emitOk: BOOLEAN;
+    progSeen: BOOLEAN;
+    uk: INTEGER;
+    nDefs, nImpls: CARDINAL;
+    i, j: CARDINAL;
+    found: BOOLEAN;
+    progRoot, sessionRoot, chain: AST.Node;
+    progName: SymTab.Name;
+    unitRoots: ARRAY [0 .. 15] OF AST.Node;
+    unitIsDef: ARRAY [0 .. 15] OF BOOLEAN;
+
+  PROCEDURE Fail (msg: ARRAY OF CHAR);
+  (* Fail-fast session abort with a one-line outcome. *)
+    BEGIN
+      FileIO.WriteString(FileIO.StdOut, msg);
+      FileIO.WriteLn(FileIO.StdOut);
+      failed := TRUE
+    END Fail;
 
 
   BEGIN
   BEGIN
     (* check on correct parameter usage *)
     (* check on correct parameter usage *)
@@ -273,12 +301,17 @@ MODULE M2comp;
       HALT
       HALT
     END;
     END;
 
 
-    (* step 1: syntax only, no symbol table yet (see M2comp.atg) *)
+    (* step 5: one symbol table per session (not per file), so
+       definitions, implementations and the program share it *)
 
 
     (* install error reporting procedure - Scanner.Error *)
     (* install error reporting procedure - Scanner.Error *)
     Error := StoreError;
     Error := StoreError;
 
 
+    SymTab.Init();
     failed := FALSE;
     failed := FALSE;
+    progSeen := FALSE;
+    nDefs := 0;
+    nImpls := 0;
     LOOP
     LOOP
       IF sourceName[0] = 0C THEN EXIT END;
       IF sourceName[0] = 0C THEN EXIT END;
 
 
@@ -299,25 +332,22 @@ MODULE M2comp;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
       END;
       END;
 
 
+      (* fresh error list per input file (M2compS.Reset already
+         zeroes the error count inside Parse) *)
+      ResetErrors;
+
       (* instigate the compilation - Parser.Parse *)
       (* instigate the compilation - Parser.Parse *)
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteLn(FileIO.StdOut);
       FileIO.WriteLn(FileIO.StdOut);
       Parse;
       Parse;
 
 
-      (* backend: emit the MC64 image while errors still reach
-         the listing below *)
-      IF Successful() THEN
-        emitOk := MGen.EmitModule(AST.GetRoot())
-      ELSE emitOk := FALSE
-      END;
-
       (* generate the source listing on lst file *)
       (* generate the source listing on lst file *)
       PrintListing;
       PrintListing;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
 
 
       (* fail fast: later files build on this one's tables *)
       (* fail fast: later files build on this one's tables *)
-      IF NOT (Successful() & emitOk)
+      IF NOT Successful()
         THEN
         THEN
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteLn(FileIO.StdOut);
           FileIO.WriteLn(FileIO.StdOut);
@@ -325,9 +355,88 @@ MODULE M2comp;
           EXIT
           EXIT
       END;
       END;
 
 
+      (* session order: definitions and implementations in
+         dependency order (the grammar enforces per-library order:
+         a definition precedes its implementation, an IMPORT needs
+         a completed implementation), then exactly one program;
+         remember each unit root for the single backend pass *)
+      uk := SymTab.UnitKind();
+      IF progSeen THEN
+        Fail("Incorrect source"); EXIT
+      ELSIF uk = SymTab.UnitDef THEN
+        IF nDefs + nImpls > 15 THEN
+          Fail("Incorrect source"); EXIT
+        END;
+        unitRoots[nDefs + nImpls] := AST.GetRoot();
+        unitIsDef[nDefs + nImpls] := TRUE;
+        INC(nDefs)
+      ELSIF uk = SymTab.UnitImpl THEN
+        IF nDefs + nImpls > 15 THEN
+          Fail("Incorrect source"); EXIT
+        END;
+        unitRoots[nDefs + nImpls] := AST.GetRoot();
+        unitIsDef[nDefs + nImpls] := FALSE;
+        INC(nImpls)
+      ELSE
+        progSeen := TRUE;
+        progRoot := AST.GetRoot();
+        Strings.Assign(progRoot^.name, progName)
+      END;
+
       FileIO.NextParameter(sourceName);
       FileIO.NextParameter(sourceName);
     END;
     END;
 
 
+    (* a session without a program emits nothing *)
+    IF NOT failed & ~progSeen THEN
+      Fail("Incorrect source")
+    END;
+
+    (* merge each implementation into its definition unit, then emit
+       the program together with the library units in one image *)
+    IF NOT failed THEN
+      i := 0;
+      WHILE (i < nDefs + nImpls) & ~failed DO
+        IF ~unitIsDef[i] THEN
+          found := FALSE;
+          j := 0;
+          WHILE (j < nDefs + nImpls) & ~found DO
+            IF unitIsDef[j] & Strings.Equal(unitRoots[j]^.name,
+               unitRoots[i]^.name) THEN
+              found := TRUE
+            ELSE
+              INC(j)
+            END
+          END;
+          IF ~found THEN Fail("Incorrect source")
+          ELSE
+            unitRoots[j]^.left := AST.Append(unitRoots[j]^.left,
+              unitRoots[i]^.left);
+            unitRoots[j]^.right := unitRoots[i]^.right
+          END
+        END;
+        INC(i)
+      END
+    END;
+    IF NOT failed THEN
+      chain := NIL;
+      i := 0;
+      WHILE i < nDefs + nImpls DO
+        IF unitIsDef[i] THEN
+          chain := AST.Append(chain, unitRoots[i])
+        END;
+        INC(i)
+      END;
+      IF chain = NIL THEN sessionRoot := progRoot
+      ELSE
+        sessionRoot := AST.MkModule(progName,
+          AST.Append(chain, progRoot^.left), progRoot^.right)
+      END;
+      (* backend: emit the MC64 image (errors reach StdOut only;
+         listings are already written) *)
+      emitOk := MGen.EmitModule(sessionRoot);
+      IF NOT emitOk THEN Fail("Incorrect source") END
+    END;
+
     (* examine the outcome *)
     (* examine the outcome *)
     IF NOT failed THEN
     IF NOT failed THEN
       FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
       FileIO.WriteString(FileIO.StdOut, "Parsed correctly");

BIN
src/M2comp.o


تفاوت فایلی نمایش داده نمی شود زیرا این فایل بسیار بزرگ است
+ 431 - 195
src/M2compP.mod


BIN
src/M2compP.o


+ 64 - 62
src/M2compS.mod

@@ -5,7 +5,7 @@ IMPLEMENTATION MODULE M2compS;
 IMPORT FileIO, Storage;
 IMPORT FileIO, Storage;
 
 
 CONST
 CONST
-  noSYMB  = 63; (*error token code*)
+  noSYMB  = 65; (*error token code*)
   (* not only for errors but also for not finished states of scanner analysis *)
   (* not only for errors but also for not finished states of scanner analysis *)
   eof     = 32C (* MS-DOS Keyboard eof char *);
   eof     = 32C (* MS-DOS Keyboard eof char *);
   EOF     = 0C;
   EOF     = 0C;
@@ -102,60 +102,62 @@ PROCEDURE Get (VAR sym: CARDINAL);
   PROCEDURE CheckLiteral;
   PROCEDURE CheckLiteral;
     BEGIN
     BEGIN
       CASE CurrentCh(bp0) OF
       CASE CurrentCh(bp0) OF
-        "A": IF Equal("AND") THEN sym := 61; 
-             ELSIF Equal("ARRAY") THEN sym := 25; 
+        "A": IF Equal("AND") THEN sym := 63; 
+             ELSIF Equal("ARRAY") THEN sym := 27; 
              END
              END
-      | "B": IF Equal("BEGIN") THEN sym := 11; 
-             ELSIF Equal("BY") THEN sym := 45; 
+      | "B": IF Equal("BEGIN") THEN sym := 16; 
+             ELSIF Equal("BY") THEN sym := 47; 
              END
              END
-      | "C": IF Equal("CONST") THEN sym := 13; 
+      | "C": IF Equal("CONST") THEN sym := 11; 
              END
              END
-      | "D": IF Equal("DIV") THEN sym := 59; 
-             ELSIF Equal("DO") THEN sym := 40; 
+      | "D": IF Equal("DEFINITION") THEN sym := 6; 
+             ELSIF Equal("DIV") THEN sym := 61; 
+             ELSIF Equal("DO") THEN sym := 42; 
              END
              END
-      | "E": IF Equal("ELSE") THEN sym := 38; 
-             ELSIF Equal("ELSIF") THEN sym := 37; 
-             ELSIF Equal("END") THEN sym := 12; 
-             ELSIF Equal("EXIT") THEN sym := 32; 
-             ELSIF Equal("EXPORT") THEN sym := 23; 
+      | "E": IF Equal("ELSE") THEN sym := 40; 
+             ELSIF Equal("ELSIF") THEN sym := 39; 
+             ELSIF Equal("END") THEN sym := 10; 
+             ELSIF Equal("EXIT") THEN sym := 34; 
+             ELSIF Equal("EXPORT") THEN sym := 25; 
              END
              END
-      | "F": IF Equal("FOR") THEN sym := 44; 
-             ELSIF Equal("FROM") THEN sym := 8; 
+      | "F": IF Equal("FOR") THEN sym := 46; 
+             ELSIF Equal("FROM") THEN sym := 17; 
              END
              END
-      | "I": IF Equal("IF") THEN sym := 35; 
-             ELSIF Equal("IMPORT") THEN sym := 9; 
-             ELSIF Equal("IN") THEN sym := 53; 
+      | "I": IF Equal("IF") THEN sym := 37; 
+             ELSIF Equal("IMPLEMENTATION") THEN sym := 7; 
+             ELSIF Equal("IMPORT") THEN sym := 18; 
+             ELSIF Equal("IN") THEN sym := 55; 
              END
              END
-      | "L": IF Equal("LOOP") THEN sym := 43; 
+      | "L": IF Equal("LOOP") THEN sym := 45; 
              END
              END
-      | "M": IF Equal("MOD") THEN sym := 60; 
-             ELSIF Equal("MODULE") THEN sym := 6; 
+      | "M": IF Equal("MOD") THEN sym := 62; 
+             ELSIF Equal("MODULE") THEN sym := 8; 
              END
              END
-      | "N": IF Equal("NOT") THEN sym := 62; 
+      | "N": IF Equal("NOT") THEN sym := 64; 
              END
              END
-      | "O": IF Equal("OF") THEN sym := 26; 
-             ELSIF Equal("OR") THEN sym := 56; 
+      | "O": IF Equal("OF") THEN sym := 28; 
+             ELSIF Equal("OR") THEN sym := 58; 
              END
              END
-      | "P": IF Equal("POINTER") THEN sym := 29; 
-             ELSIF Equal("PROCEDURE") THEN sym := 18; 
+      | "P": IF Equal("POINTER") THEN sym := 31; 
+             ELSIF Equal("PROCEDURE") THEN sym := 14; 
              END
              END
-      | "Q": IF Equal("QUALIFIED") THEN sym := 24; 
+      | "Q": IF Equal("QUALIFIED") THEN sym := 26; 
              END
              END
-      | "R": IF Equal("RECORD") THEN sym := 27; 
-             ELSIF Equal("REPEAT") THEN sym := 41; 
-             ELSIF Equal("RETURN") THEN sym := 46; 
+      | "R": IF Equal("RECORD") THEN sym := 29; 
+             ELSIF Equal("REPEAT") THEN sym := 43; 
+             ELSIF Equal("RETURN") THEN sym := 48; 
              END
              END
-      | "S": IF Equal("SET") THEN sym := 28; 
+      | "S": IF Equal("SET") THEN sym := 30; 
              END
              END
-      | "T": IF Equal("THEN") THEN sym := 36; 
-             ELSIF Equal("TO") THEN sym := 30; 
-             ELSIF Equal("TYPE") THEN sym := 14; 
+      | "T": IF Equal("THEN") THEN sym := 38; 
+             ELSIF Equal("TO") THEN sym := 32; 
+             ELSIF Equal("TYPE") THEN sym := 12; 
              END
              END
-      | "U": IF Equal("UNTIL") THEN sym := 42; 
+      | "U": IF Equal("UNTIL") THEN sym := 44; 
              END
              END
-      | "V": IF Equal("VAR") THEN sym := 15; 
+      | "V": IF Equal("VAR") THEN sym := 13; 
              END
              END
-      | "W": IF Equal("WHILE") THEN sym := 39; 
+      | "W": IF Equal("WHILE") THEN sym := 41; 
              END
              END
       ELSE
       ELSE
       END
       END
@@ -227,34 +229,34 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | 14: IF (ch = ".") THEN state := 23; 
       | 14: IF (ch = ".") THEN state := 23; 
             ELSE sym := 5; RETURN
             ELSE sym := 5; RETURN
             END;
             END;
-      | 15: sym := 7; RETURN
-      | 16: sym := 10; RETURN
-      | 17: sym := 16; RETURN
-      | 18: IF (ch = "=") THEN state := 24; 
-            ELSE sym := 17; RETURN
+      | 15: sym := 9; RETURN
+      | 16: IF (ch = "=") THEN state := 24; 
+            ELSE sym := 15; RETURN
             END;
             END;
-      | 19: sym := 19; RETURN
-      | 20: sym := 20; RETURN
-      | 21: sym := 21; RETURN
-      | 22: sym := 22; RETURN
-      | 23: sym := 31; RETURN
-      | 24: sym := 33; RETURN
-      | 25: sym := 34; RETURN
-      | 26: sym := 47; RETURN
+      | 17: sym := 19; RETURN
+      | 18: sym := 20; RETURN
+      | 19: sym := 21; RETURN
+      | 20: sym := 22; RETURN
+      | 21: sym := 23; RETURN
+      | 22: sym := 24; RETURN
+      | 23: sym := 33; RETURN
+      | 24: sym := 35; RETURN
+      | 25: sym := 36; RETURN
+      | 26: sym := 49; RETURN
       | 27: IF (ch = ">") THEN state := 28; 
       | 27: IF (ch = ">") THEN state := 28; 
             ELSIF (ch = "=") THEN state := 29; 
             ELSIF (ch = "=") THEN state := 29; 
-            ELSE sym := 49; RETURN
+            ELSE sym := 51; RETURN
             END;
             END;
-      | 28: sym := 48; RETURN
-      | 29: sym := 50; RETURN
+      | 28: sym := 50; RETURN
+      | 29: sym := 52; RETURN
       | 30: IF (ch = "=") THEN state := 31; 
       | 30: IF (ch = "=") THEN state := 31; 
-            ELSE sym := 51; RETURN
+            ELSE sym := 53; RETURN
             END;
             END;
-      | 31: sym := 52; RETURN
-      | 32: sym := 54; RETURN
-      | 33: sym := 55; RETURN
-      | 34: sym := 57; RETURN
-      | 35: sym := 58; RETURN
+      | 31: sym := 54; RETURN
+      | 32: sym := 56; RETURN
+      | 33: sym := 57; RETURN
+      | 34: sym := 59; RETURN
+      | 35: sym := 60; RETURN
       | 36: sym := 0; ch := 0C; DEC(bp); RETURN
       | 36: sym := 0; ch := 0C; DEC(bp); RETURN
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       END
       END
@@ -334,11 +336,11 @@ BEGIN
   start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
   start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
   start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
   start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
   start[ 40] := 19; start[ 41] := 20; start[ 42] := 34; start[ 43] := 32; 
   start[ 40] := 19; start[ 41] := 20; start[ 42] := 34; start[ 43] := 32; 
-  start[ 44] := 16; start[ 45] := 33; start[ 46] := 14; start[ 47] := 35; 
+  start[ 44] := 17; start[ 45] := 33; start[ 46] := 14; start[ 47] := 35; 
   start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
   start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
   start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
   start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
-  start[ 56] := 12; start[ 57] := 12; start[ 58] := 18; start[ 59] := 15; 
-  start[ 60] := 27; start[ 61] := 17; start[ 62] := 30; start[ 63] := 37; 
+  start[ 56] := 12; start[ 57] := 12; start[ 58] := 16; start[ 59] := 15; 
+  start[ 60] := 27; start[ 61] := 18; start[ 62] := 30; start[ 63] := 37; 
   start[ 64] := 37; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
   start[ 64] := 37; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
   start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
   start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
   start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 
   start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 

BIN
src/M2compS.o


+ 63 - 7
src/MGen.mod

@@ -516,6 +516,25 @@ PROCEDURE ConstFind (name: ARRAY OF CHAR): INTEGER;
     RETURN -1
     RETURN -1
   END ConstFind;
   END ConstFind;
 
 
+PROCEDURE ConstFindMod (mod, name: ARRAY OF CHAR): INTEGER;
+(* Innermost (highest const index) constant of a module scope
+   (qualified interface constants: Lib.C). *)
+  VAR i: INTEGER;
+    best: INTEGER;
+  BEGIN
+    best := -1;
+    i := 0;
+    WHILE VAL(CARDINAL, i) < nC DO
+      IF scopes[csts[i].scope].isMod
+         & SymTab.Equal(scopes[csts[i].scope].tag, mod)
+         & SymTab.Equal(csts[i].name, name) THEN
+        best := i
+      END;
+      INC(i)
+    END;
+    RETURN best
+  END ConstFindMod;
+
 PROCEDURE EvalConstInt (n: AST.Node; VAR v: INTEGER): BOOLEAN;
 PROCEDURE EvalConstInt (n: AST.Node; VAR v: INTEGER): BOOLEAN;
   VAR a, b: INTEGER;
   VAR a, b: INTEGER;
     ci: INTEGER;
     ci: INTEGER;
@@ -999,7 +1018,27 @@ PROCEDURE EmitAddr (n: AST.Node);
 PROCEDURE PushConstName (n: AST.Node);
 PROCEDURE PushConstName (n: AST.Node);
 (* Pushes a CONST value (inlined; strings handled by caller path). *)
 (* Pushes a CONST value (inlined; strings handled by caller path). *)
   VAR ci: INTEGER;
   VAR ci: INTEGER;
+    v: INTEGER;
   BEGIN
   BEGIN
+    IF n^.tag[0] # 0C THEN
+      (* qualified constant: walked materialized decl first,
+         export-table value fallback (plain IMPORT needs none) *)
+      ci := ConstFindMod(n^.tag, n^.name);
+      IF (ci >= 0) & csts[ci].ok THEN
+        IF csts[ci].ck = 0 THEN PushInt(csts[ci].ival)
+        ELSIF csts[ci].ck = 1 THEN PushBits(csts[ci].bits)
+        ELSE Fail230(); PushBits(0H)
+        END;
+        RETURN
+      END;
+      IF SymTab.ExpConstVal(n^.tag, n^.name, v) THEN
+        PushInt(v); RETURN
+      END;
+      IF SymTab.Equal(n^.name, "NIL") THEN PushInt(0)
+      ELSE Fail230(); PushInt(0)
+      END;
+      RETURN
+    END;
     ci := ConstFind(n^.name);
     ci := ConstFind(n^.name);
     IF (ci < 0) OR ~csts[ci].ok THEN
     IF (ci < 0) OR ~csts[ci].ok THEN
       IF SymTab.Equal(n^.name, "NIL") THEN PushInt(0)
       IF SymTab.Equal(n^.name, "NIL") THEN PushInt(0)
@@ -1019,7 +1058,9 @@ PROCEDURE ConstTextOf (n: AST.Node; VAR tx: ARRAY OF CHAR): BOOLEAN;
   BEGIN
   BEGIN
     tx[0] := 0C;
     tx[0] := 0C;
     IF (n = NIL) OR (n^.kind # AST.nkName) THEN RETURN FALSE END;
     IF (n = NIL) OR (n^.kind # AST.nkName) THEN RETURN FALSE END;
-    ci := ConstFind(n^.name);
+    IF n^.tag[0] # 0C THEN ci := ConstFindMod(n^.tag, n^.name)
+    ELSE ci := ConstFind(n^.name)
+    END;
     IF (ci < 0) OR ~csts[ci].ok OR (csts[ci].ck # 2) THEN
     IF (ci < 0) OR ~csts[ci].ok OR (csts[ci].ck # 2) THEN
       RETURN FALSE
       RETURN FALSE
     END;
     END;
@@ -1165,6 +1206,10 @@ PROCEDURE EmitExpr (n: AST.Node);
       END
       END
     ELSIF (n^.kind = AST.nkField) OR (n^.kind = AST.nkIndex)
     ELSIF (n^.kind = AST.nkField) OR (n^.kind = AST.nkIndex)
        OR (n^.kind = AST.nkDeref) THEN
        OR (n^.kind = AST.nkDeref) THEN
+      IF (n^.kind = AST.nkField) & (n^.tag[0] # 0C)
+         & (n^.aux = SymTab.KindConst) THEN
+        PushConstName(n); RETURN
+      END;
       IF SymTab.TypeSlots(t) # 1 THEN Fail230(); PushInt(0); RETURN END;
       IF SymTab.TypeSlots(t) # 1 THEN Fail230(); PushInt(0); RETURN END;
       EmitAddr(n);
       EmitAddr(n);
       LoadIndir
       LoadIndir
@@ -1342,16 +1387,27 @@ PROCEDURE AllocGlobal (size: CARDINAL): INTEGER;
 
 
 PROCEDURE EmitDecls (n: AST.Node);
 PROCEDURE EmitDecls (n: AST.Node);
   VAR sz: CARDINAL;
   VAR sz: CARDINAL;
-    sl: INTEGER;
+    sl, vi: INTEGER;
   BEGIN
   BEGIN
     WHILE (n # NIL) & ok DO
     WHILE (n # NIL) & ok DO
       IF n^.kind = AST.nkVar THEN
       IF n^.kind = AST.nkVar THEN
         IF scopes[curScope].isMod THEN
         IF scopes[curScope].isMod THEN
-          sz := SymTab.TypeSlots(n^.typ);
-          IF sz = 0 THEN sz := 1 END;
-          sl := AllocGlobal(sz);
-          EnterVar(n^.name, SymTab.KindVar, n^.typ, sl, sz, 0,
-                   TRUE, FALSE)
+          IF n^.tag[0] # 0C THEN
+            (* FROM-import alias: share the library slot instead of
+               allocating a second global *)
+            vi := FindModVar(n^.tag, n^.name);
+            IF vi < 0 THEN Fail230()
+            ELSE
+              EnterVar(n^.name, SymTab.KindVar, n^.typ,
+                       vars[vi].slot, vars[vi].size, 0, TRUE, FALSE)
+            END
+          ELSE
+            sz := SymTab.TypeSlots(n^.typ);
+            IF sz = 0 THEN sz := 1 END;
+            sl := AllocGlobal(sz);
+            EnterVar(n^.name, SymTab.KindVar, n^.typ, sl, sz, 0,
+                     TRUE, FALSE)
+          END
         END
         END
         (* proc-scope vars are laid out by LayoutLocals *)
         (* proc-scope vars are laid out by LayoutLocals *)
       ELSIF n^.kind = AST.nkProc THEN
       ELSIF n^.kind = AST.nkProc THEN

BIN
src/MGen.o


+ 90 - 2
src/SymTab.def

@@ -23,17 +23,27 @@ IMPORT AST;
    223 cyclical type, 224 ordinal required, 230 unsupported construct
    223 cyclical type, 224 ordinal required, 230 unsupported construct
    (EXIT outside LOOP, open array outside formal), 232 bad RETURN,
    (EXIT outside LOOP, open array outside formal), 232 bad RETURN,
    233 invalid call. 231 (forward mismatch) unused: no FORWARD.
    233 invalid call. 231 (forward mismatch) unused: no FORWARD.
-
    - flat scopes with levels: globals at level 0 (duplicates within
    - flat scopes with levels: globals at level 0 (duplicates within
      one level rejected, shadowing allowed in nested scopes)
      one level rejected, shadowing allowed in nested scopes)
    - every symbol carries a type descriptor index (InvalidType if
    - every symbol carries a type descriptor index (InvalidType if
      unknown, e.g. imported names); unknown types suppress follow-on
      unknown, e.g. imported names); unknown types suppress follow-on
-     errors to avoid cascades *)
+     errors to avoid cascades.
+
+   Step 5 adds separate compilation (v1 step-11 style, single
+   image): DEFINITION units seed the export table, IMPLEMENTATION
+   units supply checked bodies (231 on heading/body mismatch or a
+   missing body), programs IMPORT definitions (201 on unknown or
+   unimplemented modules). See "separate compilation" below. *)
 
 
 CONST
 CONST
   MaxSyms = 256;
   MaxSyms = 256;
   InvalidType = -1;
   InvalidType = -1;
 
 
+  (* compilation-unit kinds (SetUnit/UnitKind, driver stage machine) *)
+  UnitDef  = 0;
+  UnitImpl = 1;
+  UnitProg = 2;
+
   (* symbol kinds *)
   (* symbol kinds *)
   KindConst  = 0;
   KindConst  = 0;
   KindType   = 1;
   KindType   = 1;
@@ -348,4 +358,82 @@ PROCEDURE ConstVal (name: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
 PROCEDURE ConstFold (n: AST.Node; VAR v: INTEGER): BOOLEAN;
 PROCEDURE ConstFold (n: AST.Node; VAR v: INTEGER): BOOLEAN;
 (* Folds nkInt / nkUn(+/-) / const nkName nodes. Needs AST import. *)
 (* Folds nkInt / nkUn(+/-) / const nkName nodes. Needs AST import. *)
 
 
+(* ---------------- separate compilation (step 5) ---------------- *)
+(* Session model (v1 step-11 style, single image): M2comp lib.def
+   impl.mod prog.mod — definitions, then implementations, then
+   exactly one program. The driver calls Init once per session (not
+   per file); definition units seed the export table, implementation
+   units supply checked bodies, the program is emitted together with
+   the merged library units into one <Prog>.MC4 (depCount 0).
+
+   Errors: 201 unknown definition / unimplemented import / body
+   without heading, 200 duplicate definition / second implementation,
+   231 heading/body signature mismatch or heading without body. *)
+
+PROCEDURE SetUnit (k: INTEGER);
+(* Records the kind (UnitDef/UnitImpl/UnitProg) of the unit being
+   parsed (driver stage machine). *)
+
+PROCEDURE UnitKind (): INTEGER;
+(* Kind of the current unit (UnitProg before any SetUnit). *)
+
+PROCEDURE InDef (): BOOLEAN;
+(* TRUE while a DEFINITION unit body parses (const-class check). *)
+
+PROCEDURE BeginDef (name: ARRAY OF CHAR): BOOLEAN;
+(* Opens a definition unit: like EnterModule (duplicate FALSE).
+   Records the pending definition name. *)
+
+PROCEDURE EndDef (name: ARRAY OF CHAR): BOOLEAN;
+(* Snapshots every body-scope declaration into the export table
+   (all definition names are exported), closes the scope, registers
+   the definition (implementation pending). FALSE on name mismatch. *)
+
+PROCEDURE DefExists (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE if a definition unit for name was registered. *)
+
+PROCEDURE ImplDone (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE if the implementation body for name completed. *)
+
+PROCEDURE OpenImpl (name: ARRAY OF CHAR): BOOLEAN;
+(* Opens the implementation scope for a defined module (caller checks
+   DefExists/ImplDone first for 201/200) and materializes its
+   interface names into the fresh body scope. FALSE only on table
+   overflow (caller reports 230). *)
+
+PROCEDURE EndImpl (name: ARRAY OF CHAR): BOOLEAN;
+(* Closes the implementation scope and marks it done. FALSE on name
+   mismatch or when a heading still lacks its body (231). *)
+
+PROCEDURE EnterHeading (name: ARRAY OF CHAR): BOOLEAN;
+(* Definition-unit procedure heading: like EnterProc (fresh number,
+   current-proc context for params) plus heading mark. FALSE on
+   duplicate or table full. *)
+
+PROCEDURE BeginBody (lib, name: ARRAY OF CHAR): BOOLEAN;
+(* Body-header matcher (implementation bodies): lib must export a
+   still-unimplemented procedure heading for name (FALSE: unknown,
+   second body). Resets the heading signature for re-parsing and
+   sets the current-procedure context to it, so FormalParams rebuild
+   the chain in place; recursion resolves through the materialized
+   alias. Call EndBodyHeader after the header. *)
+
+PROCEDURE EndBodyHeader (): BOOLEAN;
+(* Compares the re-parsed header (return type, arity, parameter
+   types/VAR-ness) against the heading snapshot; marks implemented
+   on match. FALSE (caller reports 231) on mismatch. *)
+
+PROCEDURE EnterAlias (mod, name: ARRAY OF CHAR): BOOLEAN;
+(* FROM-import materialization: enters name in the current scope
+   copying kind/type/proc-number/const-value from (mod, name)'s
+   export entry. FALSE on unknown export or duplicate. *)
+
+PROCEDURE SetProcNum (name: ARRAY OF CHAR; num: INTEGER);
+(* Sets the procedure number of the visible entry (alias body fix). *)
+
+PROCEDURE ExpConstVal (mod, name: ARRAY OF CHAR;
+                       VAR v: INTEGER): BOOLEAN;
+(* Folded value of an exported integer-family CONST (for grammar
+   bound folding across files). FALSE if absent / not constant. *)
+
 END SymTab.
 END SymTab.

+ 243 - 0
src/SymTab.mod

@@ -15,6 +15,7 @@ CONST
   MaxMods   = 8;
   MaxMods   = 8;
   MaxModExps = 32;
   MaxModExps = 32;
   MaxExps   = 128;
   MaxExps   = 128;
+  MaxDefs   = 16;
   MaxCallDepth = 8;
   MaxCallDepth = 8;
 
 
   (* descriptor forms *)
   (* descriptor forms *)
@@ -88,12 +89,23 @@ VAR
   expTypeA : ARRAY [0 .. MaxExps - 1] OF TypeIndex;
   expTypeA : ARRAY [0 .. MaxExps - 1] OF TypeIndex;
   expProcA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
   expProcA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
   nExps : CARDINAL;
   nExps : CARDINAL;
+  expValA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
+  expHasA : ARRAY [0 .. MaxExps - 1] OF BOOLEAN;
   callProc : ARRAY [0 .. MaxCallDepth - 1] OF INTEGER;
   callProc : ARRAY [0 .. MaxCallDepth - 1] OF INTEGER;
   callIdx : ARRAY [0 .. MaxCallDepth - 1] OF CARDINAL;
   callIdx : ARRAY [0 .. MaxCallDepth - 1] OF CARDINAL;
   callErr : ARRAY [0 .. MaxCallDepth - 1] OF BOOLEAN;
   callErr : ARRAY [0 .. MaxCallDepth - 1] OF BOOLEAN;
   callTop : CARDINAL;
   callTop : CARDINAL;
   callFull : BOOLEAN;
   callFull : BOOLEAN;
   loopDep : CARDINAL;
   loopDep : CARDINAL;
+  unitKind : INTEGER;
+  defNames : ARRAY [0 .. MaxDefs - 1] OF Name;
+  nDefs : CARDINAL;
+  implDone : ARRAY [0 .. MaxDefs - 1] OF BOOLEAN;
+  procHead : ARRAY [1 .. MaxProcs] OF BOOLEAN;
+  procHasBody : ARRAY [1 .. MaxProcs] OF BOOLEAN;
+  pendingBody : INTEGER;
+  pendingRet : TypeIndex;
+  headSave : INTEGER;
   cval : ARRAY [0 .. MaxSyms - 1] OF INTEGER;
   cval : ARRAY [0 .. MaxSyms - 1] OF INTEGER;
   cdef : ARRAY [0 .. MaxSyms - 1] OF BOOLEAN;
   cdef : ARRAY [0 .. MaxSyms - 1] OF BOOLEAN;
 
 
@@ -167,6 +179,11 @@ PROCEDURE ConstFold (n: AST.Node; VAR v: INTEGER): BOOLEAN;
       RETURN TRUE
       RETURN TRUE
     ELSIF n^.kind = AST.nkName THEN
     ELSIF n^.kind = AST.nkName THEN
       RETURN ConstVal(n^.name, v)
       RETURN ConstVal(n^.name, v)
+    ELSIF n^.kind = AST.nkField THEN
+      (* qualified interface constant (Lib.C): values live in the
+         export table, scopes are long popped *)
+      IF n^.tag[0] = 0C THEN RETURN FALSE END;
+      RETURN ExpConstVal(n^.tag, n^.name, v)
     END;
     END;
     RETURN FALSE
     RETURN FALSE
   END ConstFold;
   END ConstFold;
@@ -1024,6 +1041,7 @@ PROCEDURE ExitModule (): BOOLEAN;
   VAR mi, k : CARDINAL;
   VAR mi, k : CARDINAL;
     idx : INTEGER;
     idx : INTEGER;
     en : Name;
     en : Name;
+    v : INTEGER;
     ok : BOOLEAN;
     ok : BOOLEAN;
   BEGIN
   BEGIN
     IF modTop = 0 THEN RETURN TRUE END;
     IF modTop = 0 THEN RETURN TRUE END;
@@ -1044,6 +1062,11 @@ PROCEDURE ExitModule (): BOOLEAN;
         ELSE
         ELSE
           expProcA[nExps] := -1
           expProcA[nExps] := -1
         END;
         END;
+        IF (syms[idx].kind = KindConst) & ConstVal(en, v) THEN
+          expValA[nExps] := v; expHasA[nExps] := TRUE
+        ELSE
+          expHasA[nExps] := FALSE
+        END;
         INC(nExps)
         INC(nExps)
       END;
       END;
       INC(k)
       INC(k)
@@ -1219,6 +1242,7 @@ PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
   END Predef;
   END Predef;
 
 
 PROCEDURE Init;
 PROCEDURE Init;
+  VAR i : CARDINAL;
   BEGIN
   BEGIN
     nSyms := 0; curLev := 0; mtop := 0;
     nSyms := 0; curLev := 0; mtop := 0;
     nPend := 0; nPendF := 0;
     nPend := 0; nPendF := 0;
@@ -1229,6 +1253,12 @@ PROCEDURE Init;
     modTop := 0; nExps := 0;
     modTop := 0; nExps := 0;
     callTop := 0; callFull := FALSE;
     callTop := 0; callFull := FALSE;
     loopDep := 0;
     loopDep := 0;
+    unitKind := UnitProg; nDefs := 0;
+    pendingBody := 0; pendingRet := InvalidType; headSave := -1;
+    i := 1;
+    WHILE i <= MaxProcs DO
+      procHead[i] := FALSE; procHasBody[i] := FALSE; INC(i)
+    END;
     dInt := NewDesc(FInt, InvalidType);
     dInt := NewDesc(FInt, InvalidType);
     dCard := NewDesc(FInt, InvalidType);
     dCard := NewDesc(FInt, InvalidType);
     dReal := NewDesc(FReal, InvalidType);
     dReal := NewDesc(FReal, InvalidType);
@@ -1249,6 +1279,219 @@ PROCEDURE Init;
     NoteConst("FALSE", 0, TRUE)
     NoteConst("FALSE", 0, TRUE)
   END Init;
   END Init;
 
 
+(* ---------------- separate compilation (step 5) ---------------- *)
+
+PROCEDURE SetUnit (k: INTEGER);
+  BEGIN
+    unitKind := k
+  END SetUnit;
+
+PROCEDURE UnitKind (): INTEGER;
+  BEGIN
+    RETURN unitKind
+  END UnitKind;
+
+PROCEDURE InDef (): BOOLEAN;
+  BEGIN
+    RETURN unitKind = UnitDef
+  END InDef;
+
+PROCEDURE BeginDef (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN EnterModule(name)
+  END BeginDef;
+
+PROCEDURE EndDef (name: ARRAY OF CHAR): BOOLEAN;
+  VAR mi : CARDINAL;
+    i : CARDINAL;
+  BEGIN
+    IF modTop = 0 THEN RETURN FALSE END;
+    mi := modTop - 1;
+    IF ~Equal(modNames[mi], name) THEN RETURN FALSE END;
+    (* auto-export every body-scope declaration except parameters *)
+    i := 0;
+    WHILE i < nSyms DO
+      IF (syms[i].lev = modLevs[mi])
+         & (syms[i].kind # KindParam)
+         & (syms[i].kind # KindVarPar) THEN
+        IF ~ModuleAddExp(syms[i].name) THEN RETURN FALSE END
+      END;
+      INC(i)
+    END;
+    IF ~ExitModule() THEN RETURN FALSE END;
+    IF nDefs > MaxDefs - 1 THEN RETURN FALSE END;
+    Assign(defNames[nDefs], name);
+    implDone[nDefs] := FALSE;
+    INC(nDefs);
+    RETURN TRUE
+  END EndDef;
+
+PROCEDURE DefIndex (name: ARRAY OF CHAR): INTEGER;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nDefs DO
+      IF Equal(defNames[i], name) THEN RETURN VAL(INTEGER, i) END;
+      INC(i)
+    END;
+    RETURN -1
+  END DefIndex;
+
+PROCEDURE DefExists (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN DefIndex(name) # -1
+  END DefExists;
+
+PROCEDURE ImplDone (name: ARRAY OF CHAR): BOOLEAN;
+  VAR d : INTEGER;
+  BEGIN
+    d := DefIndex(name);
+    IF d = -1 THEN RETURN FALSE END;
+    RETURN implDone[d]
+  END ImplDone;
+
+PROCEDURE OpenImpl (name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+    en : Name;
+    k : INTEGER;
+    idx : INTEGER;
+  BEGIN
+    IF modTop > MaxMods - 1 THEN RETURN FALSE END;
+    Assign(modNames[modTop], name);
+    modNExps[modTop] := 0;
+    INC(modTop);
+    PushScope;
+    modLevs[modTop - 1] := curLev;
+    (* materialize the interface names into the fresh body scope *)
+    i := 0;
+    WHILE i < nExps DO
+      IF Equal(expMod[i], name) THEN
+        Assign(en, expName[i]);
+        k := expKindA[i];
+        IF (k = KindParam) OR (k = KindVarPar) THEN
+        ELSIF ~Enter(en, k) THEN RETURN FALSE
+        ELSE
+          idx := Find(en);
+          IF idx = -1 THEN RETURN FALSE END;
+          syms[idx].typ := expTypeA[i];
+          IF k = KindProc THEN syms[idx].pnum := expProcA[i] END;
+          IF (k = KindConst) & expHasA[i] THEN
+            NoteConst(en, expValA[i], TRUE)
+          END
+        END
+      END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END OpenImpl;
+
+PROCEDURE EndImpl (name: ARRAY OF CHAR): BOOLEAN;
+  VAR mi : CARDINAL;
+    i : CARDINAL;
+    pn : INTEGER;
+    ok : BOOLEAN;
+  BEGIN
+    IF modTop = 0 THEN RETURN FALSE END;
+    mi := modTop - 1;
+    IF ~Equal(modNames[mi], name) THEN RETURN FALSE END;
+    (* every exported heading needs its body *)
+    ok := TRUE;
+    i := 0;
+    WHILE i < nExps DO
+      IF Equal(expMod[i], name) & (expKindA[i] = KindProc) THEN
+        pn := expProcA[i];
+        IF (pn < 1) OR (pn > MaxProcs) OR ~procHasBody[pn] THEN
+          ok := FALSE
+        END
+      END;
+      INC(i)
+    END;
+    PopScope;
+    DEC(modTop);
+    IF ~ok THEN RETURN FALSE END;
+    implDone[DefIndex(name)] := TRUE;
+    RETURN TRUE
+  END EndImpl;
+
+PROCEDURE EnterHeading (name: ARRAY OF CHAR): BOOLEAN;
+  VAR n : INTEGER;
+  BEGIN
+    IF ~EnterProc(name) THEN RETURN FALSE END;
+    n := ProcNum(name);
+    IF (n >= 1) & (n <= MaxProcs) THEN procHead[n] := TRUE END;
+    RETURN TRUE
+  END EnterHeading;
+
+PROCEDURE BeginBody (lib, name: ARRAY OF CHAR): BOOLEAN;
+  VAR h : INTEGER;
+  BEGIN
+    h := ExpProc(lib, name);
+    IF (h < 1) OR (h > VAL(INTEGER, nProcs)) THEN RETURN FALSE END;
+    IF procHasBody[h] THEN RETURN FALSE END;
+    pendingBody := h;
+    pendingRet := procs[h].ret;
+    headSave := procs[h].head;
+    procs[h].head := -1;
+    procs[h].tail := -1;
+    curProc := h;
+    RETURN TRUE
+  END BeginBody;
+
+PROCEDURE EndBodyHeader (): BOOLEAN;
+  VAR h, fpi, hpi : INTEGER;
+  BEGIN
+    h := pendingBody;
+    pendingBody := 0;
+    IF (h < 1) OR (h > VAL(INTEGER, nProcs)) THEN RETURN FALSE END;
+    IF procs[h].ret # pendingRet THEN RETURN FALSE END;
+    fpi := procs[h].head; hpi := headSave;
+    WHILE (fpi # -1) OR (hpi # -1) DO
+      IF (fpi = -1) OR (hpi = -1) THEN RETURN FALSE END;
+      IF (params[fpi].typ # params[hpi].typ)
+         OR (params[fpi].isVar # params[hpi].isVar) THEN
+        RETURN FALSE
+      END;
+      fpi := params[fpi].next; hpi := params[hpi].next
+    END;
+    procHasBody[h] := TRUE;
+    RETURN TRUE
+  END EndBodyHeader;
+
+PROCEDURE EnterAlias (mod, name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : INTEGER;
+  BEGIN
+    i := ExpFind(mod, name);
+    IF i = -1 THEN RETURN FALSE END;
+    IF ~Enter(name, expKindA[i]) THEN RETURN FALSE END;
+    SetSymType(name, expTypeA[i]);
+    IF expKindA[i] = KindProc THEN
+      SetProcNum(name, expProcA[i])
+    ELSIF expKindA[i] = KindConst THEN
+      NoteConst(name, expValA[i], expHasA[i])
+    END;
+    RETURN TRUE
+  END EnterAlias;
+
+PROCEDURE SetProcNum (name: ARRAY OF CHAR; num: INTEGER);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx # -1 THEN syms[idx].pnum := num END
+  END SetProcNum;
+
+PROCEDURE ExpConstVal (mod, name: ARRAY OF CHAR;
+                       VAR v: INTEGER): BOOLEAN;
+  VAR i : INTEGER;
+  BEGIN
+    v := 0;
+    i := ExpFind(mod, name);
+    IF i = -1 THEN RETURN FALSE END;
+    IF expKindA[i] # KindConst THEN RETURN FALSE END;
+    IF ~expHasA[i] THEN RETURN FALSE END;
+    v := expValA[i];
+    RETURN TRUE
+  END ExpConstVal;
+
 (* ---------------- listing ---------------- *)
 (* ---------------- listing ---------------- *)
 
 
 PROCEDURE WriteKind (kind: INTEGER);
 PROCEDURE WriteKind (kind: INTEGER);

BIN
src/SymTab.o


+ 115 - 11
src/compiler.frm

@@ -7,7 +7,7 @@ MODULE -->Grammar;
   FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
   FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
   FROM -->Parser IMPORT Parse, Successful;
   FROM -->Parser IMPORT Parse, Successful;
   IMPORT
   IMPORT
-    Strings, Storage, SYSTEM, FileIO, AST, MGen;
+    Strings, Storage, SYSTEM, FileIO, AST, MGen, SymTab;
 
 
   TYPE
   TYPE
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
@@ -18,7 +18,7 @@ MODULE -->Grammar;
     FROM Storage IMPORT ALLOCATE;
     FROM Storage IMPORT ALLOCATE;
     FROM SYSTEM IMPORT TSIZE;
     FROM SYSTEM IMPORT TSIZE;
     IMPORT lst, CharAt, errors, INT32;
     IMPORT lst, CharAt, errors, INT32;
-    EXPORT StoreError, PrintListing;
+    EXPORT StoreError, PrintListing, ResetErrors;
 
 
     TYPE
     TYPE
       Err = POINTER TO ErrDesc;
       Err = POINTER TO ErrDesc;
@@ -125,6 +125,12 @@ MODULE -->Grammar;
         WriteLn(lst)
         WriteLn(lst)
       END PrintErr;
       END PrintErr;
 
 
+    PROCEDURE ResetErrors;
+    (* Drops stored errors so the next input file starts clean. *)
+      BEGIN
+        firstErr := NIL; lastErr := NIL
+      END ResetErrors;
+
     PROCEDURE PrintListing;
     PROCEDURE PrintListing;
     (* Print a source listing with error messages *)
     (* Print a source listing with error messages *)
       VAR
       VAR
@@ -190,6 +196,23 @@ MODULE -->Grammar;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     failed: BOOLEAN;
     failed: BOOLEAN;
     emitOk: BOOLEAN;
     emitOk: BOOLEAN;
+    progSeen: BOOLEAN;
+    uk: INTEGER;
+    nDefs, nImpls: CARDINAL;
+    i, j: CARDINAL;
+    found: BOOLEAN;
+    progRoot, sessionRoot, chain: AST.Node;
+    progName: SymTab.Name;
+    unitRoots: ARRAY [0 .. 15] OF AST.Node;
+    unitIsDef: ARRAY [0 .. 15] OF BOOLEAN;
+
+  PROCEDURE Fail (msg: ARRAY OF CHAR);
+  (* Fail-fast session abort with a one-line outcome. *)
+    BEGIN
+      FileIO.WriteString(FileIO.StdOut, msg);
+      FileIO.WriteLn(FileIO.StdOut);
+      failed := TRUE
+    END Fail;
 
 
   BEGIN
   BEGIN
     (* check on correct parameter usage *)
     (* check on correct parameter usage *)
@@ -199,12 +222,17 @@ MODULE -->Grammar;
       HALT
       HALT
     END;
     END;
 
 
-    (* step 1: syntax only, no symbol table yet (see M2comp.atg) *)
+    (* step 5: one symbol table per session (not per file), so
+       definitions, implementations and the program share it *)
 
 
     (* install error reporting procedure - Scanner.Error *)
     (* install error reporting procedure - Scanner.Error *)
     Error := StoreError;
     Error := StoreError;
 
 
+    SymTab.Init();
     failed := FALSE;
     failed := FALSE;
+    progSeen := FALSE;
+    nDefs := 0;
+    nImpls := 0;
     LOOP
     LOOP
       IF sourceName[0] = 0C THEN EXIT END;
       IF sourceName[0] = 0C THEN EXIT END;
 
 
@@ -225,25 +253,22 @@ MODULE -->Grammar;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
       END;
       END;
 
 
+      (* fresh error list per input file (M2compS.Reset already
+         zeroes the error count inside Parse) *)
+      ResetErrors;
+
       (* instigate the compilation - Parser.Parse *)
       (* instigate the compilation - Parser.Parse *)
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteLn(FileIO.StdOut);
       FileIO.WriteLn(FileIO.StdOut);
       Parse;
       Parse;
 
 
-      (* backend: emit the MC64 image while errors still reach
-         the listing below *)
-      IF Successful() THEN
-        emitOk := MGen.EmitModule(AST.GetRoot())
-      ELSE emitOk := FALSE
-      END;
-
       (* generate the source listing on lst file *)
       (* generate the source listing on lst file *)
       PrintListing;
       PrintListing;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
 
 
       (* fail fast: later files build on this one's tables *)
       (* fail fast: later files build on this one's tables *)
-      IF NOT (Successful() & emitOk)
+      IF NOT Successful()
         THEN
         THEN
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteLn(FileIO.StdOut);
           FileIO.WriteLn(FileIO.StdOut);
@@ -251,9 +276,88 @@ MODULE -->Grammar;
           EXIT
           EXIT
       END;
       END;
 
 
+      (* session order: definitions and implementations in
+         dependency order (the grammar enforces per-library order:
+         a definition precedes its implementation, an IMPORT needs
+         a completed implementation), then exactly one program;
+         remember each unit root for the single backend pass *)
+      uk := SymTab.UnitKind();
+      IF progSeen THEN
+        Fail("Incorrect source"); EXIT
+      ELSIF uk = SymTab.UnitDef THEN
+        IF nDefs + nImpls > 15 THEN
+          Fail("Incorrect source"); EXIT
+        END;
+        unitRoots[nDefs + nImpls] := AST.GetRoot();
+        unitIsDef[nDefs + nImpls] := TRUE;
+        INC(nDefs)
+      ELSIF uk = SymTab.UnitImpl THEN
+        IF nDefs + nImpls > 15 THEN
+          Fail("Incorrect source"); EXIT
+        END;
+        unitRoots[nDefs + nImpls] := AST.GetRoot();
+        unitIsDef[nDefs + nImpls] := FALSE;
+        INC(nImpls)
+      ELSE
+        progSeen := TRUE;
+        progRoot := AST.GetRoot();
+        Strings.Assign(progRoot^.name, progName)
+      END;
+
       FileIO.NextParameter(sourceName);
       FileIO.NextParameter(sourceName);
     END;
     END;
 
 
+    (* a session without a program emits nothing *)
+    IF NOT failed & ~progSeen THEN
+      Fail("Incorrect source")
+    END;
+
+    (* merge each implementation into its definition unit, then emit
+       the program together with the library units in one image *)
+    IF NOT failed THEN
+      i := 0;
+      WHILE (i < nDefs + nImpls) & ~failed DO
+        IF ~unitIsDef[i] THEN
+          found := FALSE;
+          j := 0;
+          WHILE (j < nDefs + nImpls) & ~found DO
+            IF unitIsDef[j] & Strings.Equal(unitRoots[j]^.name,
+               unitRoots[i]^.name) THEN
+              found := TRUE
+            ELSE
+              INC(j)
+            END
+          END;
+          IF ~found THEN Fail("Incorrect source")
+          ELSE
+            unitRoots[j]^.left := AST.Append(unitRoots[j]^.left,
+              unitRoots[i]^.left);
+            unitRoots[j]^.right := unitRoots[i]^.right
+          END
+        END;
+        INC(i)
+      END
+    END;
+    IF NOT failed THEN
+      chain := NIL;
+      i := 0;
+      WHILE i < nDefs + nImpls DO
+        IF unitIsDef[i] THEN
+          chain := AST.Append(chain, unitRoots[i])
+        END;
+        INC(i)
+      END;
+      IF chain = NIL THEN sessionRoot := progRoot
+      ELSE
+        sessionRoot := AST.MkModule(progName,
+          AST.Append(chain, progRoot^.left), progRoot^.right)
+      END;
+      (* backend: emit the MC64 image (errors reach StdOut only;
+         listings are already written) *)
+      emitOk := MGen.EmitModule(sessionRoot);
+      IF NOT emitOk THEN Fail("Incorrect source") END
+    END;
+
     (* examine the outcome *)
     (* examine the outcome *)
     IF NOT failed THEN
     IF NOT failed THEN
       FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
       FileIO.WriteString(FileIO.StdOut, "Parsed correctly");

+ 11 - 0
tests/d_bad_dup.LST

@@ -0,0 +1,11 @@
+Listing:
+
+    1  DEFINITION MODULE DLib;
+*****                     ^ duplicate identifier
+    2  VAR counter : INTEGER;
+    3  END DLib.
+*****      ^ duplicate identifier
+
+    2 errors
+
+

+ 3 - 0
tests/d_bad_dup.def

@@ -0,0 +1,3 @@
+DEFINITION MODULE DLib;
+VAR counter : INTEGER;
+END DLib.

+ 14 - 0
tests/d_bad_nobody.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  IMPLEMENTATION MODULE DLib;
+    2  PROCEDURE Add(n : INTEGER);
+    3  BEGIN
+    4    counter := n
+    5  END Add;
+    6  BEGIN
+    7  END DLib.
+*****      ^ procedure forward mismatch or missing body
+
+    1 error
+
+

+ 7 - 0
tests/d_bad_nobody.mod

@@ -0,0 +1,7 @@
+IMPLEMENTATION MODULE DLib;
+PROCEDURE Add(n : INTEGER);
+BEGIN
+  counter := n
+END Add;
+BEGIN
+END DLib.

+ 14 - 0
tests/d_bad_nodef.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  IMPLEMENTATION MODULE Ghost;
+*****                         ^ undeclared identifier
+    2  PROCEDURE P;
+*****            ^ procedure forward mismatch or missing body
+    3  BEGIN
+    4  END P;
+    5  END Ghost.
+*****      ^ procedure forward mismatch or missing body
+
+    3 errors
+
+

+ 5 - 0
tests/d_bad_nodef.mod

@@ -0,0 +1,5 @@
+IMPLEMENTATION MODULE Ghost;
+PROCEDURE P;
+BEGIN
+END P;
+END Ghost.

+ 13 - 0
tests/d_bad_noimpl.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE DBadNoimpl;
+    2  IMPORT DLib;
+*****         ^ undeclared identifier
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := DLib.Get()
+    6  END DBadNoimpl.
+
+    1 error
+
+

+ 6 - 0
tests/d_bad_noimpl.mod

@@ -0,0 +1,6 @@
+MODULE DBadNoimpl;
+IMPORT DLib;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := DLib.Get()
+END DBadNoimpl.

+ 13 - 0
tests/d_bad_priv.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE DBadPriv;
+    2  IMPORT DLib;
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := DLib.total
+*****                     ^ undeclared identifier
+    6  END DBadPriv.
+
+    1 error
+
+

+ 6 - 0
tests/d_bad_priv.mod

@@ -0,0 +1,6 @@
+MODULE DBadPriv;
+IMPORT DLib;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := DLib.total
+END DBadPriv.

+ 19 - 0
tests/d_bad_sig.LST

@@ -0,0 +1,19 @@
+Listing:
+
+    1  IMPLEMENTATION MODULE DLib;
+    2  PROCEDURE Add(n, m : INTEGER);
+*****                               ^ procedure forward mismatch or missing body
+    3  BEGIN
+    4    counter := n + m
+    5  END Add;
+    6  PROCEDURE Get() : INTEGER;
+    7  BEGIN
+    8    RETURN 0
+    9  END Get;
+   10  BEGIN
+   11  END DLib.
+*****      ^ procedure forward mismatch or missing body
+
+    2 errors
+
+

+ 11 - 0
tests/d_bad_sig.mod

@@ -0,0 +1,11 @@
+IMPLEMENTATION MODULE DLib;
+PROCEDURE Add(n, m : INTEGER);
+BEGIN
+  counter := n + m
+END Add;
+PROCEDURE Get() : INTEGER;
+BEGIN
+  RETURN 0
+END Get;
+BEGIN
+END DLib.

+ 18 - 0
tests/d_basic.LST

@@ -0,0 +1,18 @@
+Listing:
+
+    1  MODULE DBasic;
+    2  FROM DLib IMPORT counter, Add;
+*****                   ^ duplicate identifier
+*****                            ^ duplicate identifier
+    3  IMPORT DLib;
+    4  VAR ExitCode : INTEGER;
+*****      ^ duplicate identifier
+    5  BEGIN
+    6    counter := 20;
+    7    Add(5);
+    8    ExitCode := counter + DLib.Get()
+    9  END DBasic.
+
+    3 errors
+
+

+ 9 - 0
tests/d_basic.mod

@@ -0,0 +1,9 @@
+MODULE DBasic;
+FROM DLib IMPORT counter, Add;
+IMPORT DLib;
+VAR ExitCode : INTEGER;
+BEGIN
+  counter := 20;
+  Add(5);
+  ExitCode := counter + DLib.Get()
+END DBasic.

+ 16 - 0
tests/d_from.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE DFrom;
+    2  FROM DLib IMPORT step, Get;
+    3  FROM DLib2 IMPORT dbl, Bump;
+    4  VAR ExitCode : INTEGER;
+    5      v : INTEGER;
+    6  BEGIN
+    7    v := 1;
+    8    Bump(v);
+    9    ExitCode := v + step + dbl + Get()
+   10  END DFrom.
+
+    0 errors
+
+

+ 10 - 0
tests/d_from.mod

@@ -0,0 +1,10 @@
+MODULE DFrom;
+FROM DLib IMPORT step, Get;
+FROM DLib2 IMPORT dbl, Bump;
+VAR ExitCode : INTEGER;
+    v : INTEGER;
+BEGIN
+  v := 1;
+  Bump(v);
+  ExitCode := v + step + dbl + Get()
+END DFrom.

+ 14 - 0
tests/d_func.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE DFunc;
+    2  FROM DLib IMPORT Get, Add;
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    Add(10);
+    6    Add(Get());
+    7    ExitCode := Get()
+    8  END DFunc.
+
+    0 errors
+
+

+ 8 - 0
tests/d_func.mod

@@ -0,0 +1,8 @@
+MODULE DFunc;
+FROM DLib IMPORT Get, Add;
+VAR ExitCode : INTEGER;
+BEGIN
+  Add(10);
+  Add(Get());
+  ExitCode := Get()
+END DFunc.

+ 12 - 0
tests/d_init.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE DInit;
+    2  IMPORT DLib;
+    3  VAR ExitCode : INTEGER;
+    4  BEGIN
+    5    ExitCode := DLib.Get()
+    6  END DInit.
+
+    0 errors
+
+

+ 6 - 0
tests/d_init.mod

@@ -0,0 +1,6 @@
+MODULE DInit;
+IMPORT DLib;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := DLib.Get()
+END DInit.

+ 14 - 0
tests/d_lib.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  DEFINITION MODULE DLib;
+    2  CONST step = 5;
+    3  VAR counter : INTEGER;
+    4  TYPE Vec = ARRAY [0 .. 3] OF INTEGER;
+    5  TYPE Point = RECORD x, y : INTEGER END;
+    6  PROCEDURE Add(n : INTEGER);
+    7  PROCEDURE Get() : INTEGER;
+    8  END DLib.
+
+    0 errors
+
+

+ 8 - 0
tests/d_lib.def

@@ -0,0 +1,8 @@
+DEFINITION MODULE DLib;
+CONST step = 5;
+VAR counter : INTEGER;
+TYPE Vec = ARRAY [0 .. 3] OF INTEGER;
+TYPE Point = RECORD x, y : INTEGER END;
+PROCEDURE Add(n : INTEGER);
+PROCEDURE Get() : INTEGER;
+END DLib.

+ 13 - 0
tests/d_lib2.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  DEFINITION MODULE DLib2;
+    2  FROM DLib IMPORT step;
+    3  CONST dbl = 10;
+    4  VAR flag : INTEGER;
+    5  TYPE SArr = ARRAY [0 .. step] OF INTEGER;
+    6  PROCEDURE Bump(VAR v : INTEGER);
+    7  END DLib2.
+
+    0 errors
+
+

+ 7 - 0
tests/d_lib2.def

@@ -0,0 +1,7 @@
+DEFINITION MODULE DLib2;
+FROM DLib IMPORT step;
+CONST dbl = 10;
+VAR flag : INTEGER;
+TYPE SArr = ARRAY [0 .. step] OF INTEGER;
+PROCEDURE Bump(VAR v : INTEGER);
+END DLib2.

+ 15 - 0
tests/d_lib2impl.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  IMPLEMENTATION MODULE DLib2;
+    2  FROM DLib IMPORT counter;
+    3  PROCEDURE Bump(VAR v : INTEGER);
+    4  BEGIN
+    5    v := v + dbl + counter
+    6  END Bump;
+    7  BEGIN
+    8    flag := 0
+    9  END DLib2.
+
+    0 errors
+
+

+ 9 - 0
tests/d_lib2impl.mod

@@ -0,0 +1,9 @@
+IMPLEMENTATION MODULE DLib2;
+FROM DLib IMPORT counter;
+PROCEDURE Bump(VAR v : INTEGER);
+BEGIN
+  v := v + dbl + counter
+END Bump;
+BEGIN
+  flag := 0
+END DLib2.

+ 22 - 0
tests/d_libimpl.LST

@@ -0,0 +1,22 @@
+Listing:
+
+    1  IMPLEMENTATION MODULE DLib;
+    2  VAR total : INTEGER;
+    3  PROCEDURE Add(n : INTEGER);
+    4  BEGIN
+    5    total := total + n;
+    6    counter := counter + n
+    7  END Add;
+    8  PROCEDURE Get() : INTEGER;
+    9  BEGIN
+   10    RETURN total + counter + step
+   11  END Get;
+   12  BEGIN
+   13    (* preset proves the init body runs: zeroed globals would read 0 *)
+   14    total := 0;
+   15    counter := 2
+   16  END DLib.
+
+    0 errors
+
+

+ 16 - 0
tests/d_libimpl.mod

@@ -0,0 +1,16 @@
+IMPLEMENTATION MODULE DLib;
+VAR total : INTEGER;
+PROCEDURE Add(n : INTEGER);
+BEGIN
+  total := total + n;
+  counter := counter + n
+END Add;
+PROCEDURE Get() : INTEGER;
+BEGIN
+  RETURN total + counter + step
+END Get;
+BEGIN
+  (* preset proves the init body runs: zeroed globals would read 0 *)
+  total := 0;
+  counter := 2
+END DLib.

+ 16 - 0
tests/d_multi.LST

@@ -0,0 +1,16 @@
+Listing:
+
+    1  MODULE DMulti;
+    2  IMPORT DLib;
+    3  IMPORT DLib2;
+    4  VAR ExitCode : INTEGER;
+    5  BEGIN
+    6    DLib.counter := 7;
+    7    DLib.Add(3);
+    8    DLib2.Bump(DLib.counter);
+    9    ExitCode := DLib.counter + DLib.Get()
+   10  END DMulti.
+
+    0 errors
+
+

+ 10 - 0
tests/d_multi.mod

@@ -0,0 +1,10 @@
+MODULE DMulti;
+IMPORT DLib;
+IMPORT DLib2;
+VAR ExitCode : INTEGER;
+BEGIN
+  DLib.counter := 7;
+  DLib.Add(3);
+  DLib2.Bump(DLib.counter);
+  ExitCode := DLib.counter + DLib.Get()
+END DMulti.

+ 17 - 0
tests/d_type.LST

@@ -0,0 +1,17 @@
+Listing:
+
+    1  MODULE DType;
+    2  FROM DLib IMPORT Vec;
+    3  IMPORT DLib;
+    4  VAR ExitCode : INTEGER;
+    5      a : Vec;
+    6      p : DLib.Point;
+    7  BEGIN
+    8    a[0] := 1; a[1] := 2; a[2] := 3; a[3] := 4;
+    9    p.x := 10; p.y := 20;
+   10    ExitCode := a[0] + a[1] + a[2] + a[3] + p.x + p.y
+   11  END DType.
+
+    0 errors
+
+

+ 11 - 0
tests/d_type.mod

@@ -0,0 +1,11 @@
+MODULE DType;
+FROM DLib IMPORT Vec;
+IMPORT DLib;
+VAR ExitCode : INTEGER;
+    a : Vec;
+    p : DLib.Point;
+BEGIN
+  a[0] := 1; a[1] := 2; a[2] := 3; a[3] := 4;
+  p.x := 10; p.y := 20;
+  ExitCode := a[0] + a[1] + a[2] + a[3] + p.x + p.y
+END DType.

برخی فایل ها در این مقایسه diff نمایش داده نمی شوند زیرا تعداد فایل ها بسیار زیاد است