瀏覽代碼

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

Eric Streit 3 周之前
父節點
當前提交
ff564e1981
共有 56 個文件被更改,包括 2035 次插入 和 463 次删除
  1. 二進制
      M2comp
  2. 二進制
      MC4/DBasic.MC4
  3. 二進制
      MC4/DFrom.MC4
  4. 二進制
      MC4/DFunc.MC4
  5. 二進制
      MC4/DInit.MC4
  6. 二進制
      MC4/DMulti.MC4
  7. 二進制
      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. 二進制
      src/M2comp.o
  15. 431 195
      src/M2compP.mod
  16. 二進制
      src/M2compP.o
  17. 64 62
      src/M2compS.mod
  18. 二進制
      src/M2compS.o
  19. 63 7
      src/MGen.mod
  20. 二進制
      src/MGen.o
  21. 90 2
      src/SymTab.def
  22. 243 0
      src/SymTab.mod
  23. 二進制
      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

二進制
M2comp


二進制
MC4/DBasic.MC4


二進制
MC4/DFrom.MC4


二進制
MC4/DFunc.MC4


二進制
MC4/DInit.MC4


二進制
MC4/DMulti.MC4


二進制
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]"
   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_proc.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_module.mod 83
 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 ---"
 [ "$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,
    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
-   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,
    unary minus takes a Factor (3.3), abbreviated arrays (3.1),
    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
      the messages still name the right tokens. *)
   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;
                                            d, bd, bs, rt: AST.Node;
-                                           im: AST.Node; .)
-    =                                 (. SymTab.Init; d := NIL; .)
+                                           im, ax: AST.Node; .)
+    =                                 (. SymTab.SetUnit(SymTab.UnitProg);
+                                         d := NIL; .)
       "MODULE"
       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);
                                         rt := AST.MkModule(m1, d,
                                           AST.MkBlock(NIL, bs));
@@ -63,29 +190,83 @@ PRODUCTIONS
                                         SymTab.PrintTable;
                                         AST.DumpTree(
                                           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"
-        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"
-      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>
     = ident                           (. LexName(n); .) .
   Block<VAR d: AST.Node; VAR s: AST.Node>
@@ -116,12 +297,19 @@ PRODUCTIONS
                                          THEN SemError(200) END; .)
       "="
       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>
                                       (. VAR vD: BOOLEAN; .)
     = Expr<t, vD, e> .
@@ -231,14 +419,15 @@ PRODUCTIONS
                                           isV)); .) } .
   ModuleDecl<VAR n: AST.Node>         (. VAR m1, m2: SymTab.Name;
                                            d, bd, bs: AST.Node;
-                                           im, en: AST.Node; .)
+                                           im, ax, en: AST.Node; .)
     = "MODULE"                        (* local module, Wirth form *)
                                       (. d := NIL; .)
       GetIdent<m1>                    (. IF ~SymTab.EnterModule(m1) THEN
                                          SemError(200) END; .)
       [ 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); .) ]
       Block<bd, bs>                   (. d := AST.Append(d, bd);
                                         n := AST.MkModule(m1, d,

+ 73 - 68
src/M2comp.err

@@ -4,71 +4,76 @@
 |  3: Msg("real expected")
 |  4: Msg("string 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:
 
-  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 charactersets:     9 (limit   250)
 

+ 188 - 79
src/M2comp.mod

@@ -7,7 +7,7 @@ MODULE M2comp;
   FROM M2compS IMPORT lst, src, errors, Error, CharAt;
   FROM M2compP IMPORT Parse, Successful;
   IMPORT
-    Strings, Storage, SYSTEM, FileIO, AST, MGen;
+    Strings, Storage, SYSTEM, FileIO, AST, MGen, SymTab;
 
   TYPE
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
@@ -18,7 +18,7 @@ MODULE M2comp;
     FROM Storage IMPORT ALLOCATE;
     FROM SYSTEM IMPORT TSIZE;
     IMPORT lst, CharAt, errors, INT32;
-    EXPORT StoreError, PrintListing;
+    EXPORT StoreError, PrintListing, ResetErrors;
 
     TYPE
       Err = POINTER TO ErrDesc;
@@ -102,74 +102,79 @@ MODULE M2comp;
         |  3: Msg("real expected")
         |  4: Msg("string 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 *)
         | 200: Msg("duplicate identifier")
@@ -199,6 +204,12 @@ MODULE M2comp;
         WriteLn(lst)
       END PrintErr;
 
+    PROCEDURE ResetErrors;
+    (* Drops stored errors so the next input file starts clean. *)
+      BEGIN
+        firstErr := NIL; lastErr := NIL
+      END ResetErrors;
+
     PROCEDURE PrintListing;
     (* Print a source listing with error messages *)
       VAR
@@ -264,6 +275,23 @@ MODULE M2comp;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     failed: 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
     (* check on correct parameter usage *)
@@ -273,12 +301,17 @@ MODULE M2comp;
       HALT
     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 *)
     Error := StoreError;
 
+    SymTab.Init();
     failed := FALSE;
+    progSeen := FALSE;
+    nDefs := 0;
+    nImpls := 0;
     LOOP
       IF sourceName[0] = 0C THEN EXIT END;
 
@@ -299,25 +332,22 @@ MODULE M2comp;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
       END;
 
+      (* fresh error list per input file (M2compS.Reset already
+         zeroes the error count inside Parse) *)
+      ResetErrors;
+
       (* instigate the compilation - Parser.Parse *)
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteLn(FileIO.StdOut);
       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 *)
       PrintListing;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
 
       (* fail fast: later files build on this one's tables *)
-      IF NOT (Successful() & emitOk)
+      IF NOT Successful()
         THEN
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteLn(FileIO.StdOut);
@@ -325,9 +355,88 @@ MODULE M2comp;
           EXIT
       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);
     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 *)
     IF NOT failed THEN
       FileIO.WriteString(FileIO.StdOut, "Parsed correctly");

二進制
src/M2comp.o


File diff suppressed because it is too large
+ 431 - 195
src/M2compP.mod


二進制
src/M2compP.o


+ 64 - 62
src/M2compS.mod

@@ -5,7 +5,7 @@ IMPLEMENTATION MODULE M2compS;
 IMPORT FileIO, Storage;
 
 CONST
-  noSYMB  = 63; (*error token code*)
+  noSYMB  = 65; (*error token code*)
   (* not only for errors but also for not finished states of scanner analysis *)
   eof     = 32C (* MS-DOS Keyboard eof char *);
   EOF     = 0C;
@@ -102,60 +102,62 @@ PROCEDURE Get (VAR sym: CARDINAL);
   PROCEDURE CheckLiteral;
     BEGIN
       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
-      | "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
-      | "C": IF Equal("CONST") THEN sym := 13; 
+      | "C": IF Equal("CONST") THEN sym := 11; 
              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
-      | "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
-      | "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
-      | "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
-      | "L": IF Equal("LOOP") THEN sym := 43; 
+      | "L": IF Equal("LOOP") THEN sym := 45; 
              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
-      | "N": IF Equal("NOT") THEN sym := 62; 
+      | "N": IF Equal("NOT") THEN sym := 64; 
              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
-      | "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
-      | "Q": IF Equal("QUALIFIED") THEN sym := 24; 
+      | "Q": IF Equal("QUALIFIED") THEN sym := 26; 
              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
-      | "S": IF Equal("SET") THEN sym := 28; 
+      | "S": IF Equal("SET") THEN sym := 30; 
              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
-      | "U": IF Equal("UNTIL") THEN sym := 42; 
+      | "U": IF Equal("UNTIL") THEN sym := 44; 
              END
-      | "V": IF Equal("VAR") THEN sym := 15; 
+      | "V": IF Equal("VAR") THEN sym := 13; 
              END
-      | "W": IF Equal("WHILE") THEN sym := 39; 
+      | "W": IF Equal("WHILE") THEN sym := 41; 
              END
       ELSE
       END
@@ -227,34 +229,34 @@ PROCEDURE Get (VAR sym: CARDINAL);
       | 14: IF (ch = ".") THEN state := 23; 
             ELSE sym := 5; RETURN
             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;
-      | 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; 
             ELSIF (ch = "=") THEN state := 29; 
-            ELSE sym := 49; RETURN
+            ELSE sym := 51; RETURN
             END;
-      | 28: sym := 48; RETURN
-      | 29: sym := 50; RETURN
+      | 28: sym := 50; RETURN
+      | 29: sym := 52; RETURN
       | 30: IF (ch = "=") THEN state := 31; 
-            ELSE sym := 51; RETURN
+            ELSE sym := 53; RETURN
             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
       ELSE sym := noSYMB; RETURN (*NextCh already done*)
       END
@@ -334,11 +336,11 @@ BEGIN
   start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
   start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
   start[ 40] := 19; start[ 41] := 20; start[ 42] := 34; start[ 43] := 32; 
-  start[ 44] := 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[ 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[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
   start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 

二進制
src/M2compS.o


+ 63 - 7
src/MGen.mod

@@ -516,6 +516,25 @@ PROCEDURE ConstFind (name: ARRAY OF CHAR): INTEGER;
     RETURN -1
   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;
   VAR a, b: INTEGER;
     ci: INTEGER;
@@ -999,7 +1018,27 @@ PROCEDURE EmitAddr (n: AST.Node);
 PROCEDURE PushConstName (n: AST.Node);
 (* Pushes a CONST value (inlined; strings handled by caller path). *)
   VAR ci: INTEGER;
+    v: INTEGER;
   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);
     IF (ci < 0) OR ~csts[ci].ok THEN
       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
     tx[0] := 0C;
     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
       RETURN FALSE
     END;
@@ -1165,6 +1206,10 @@ PROCEDURE EmitExpr (n: AST.Node);
       END
     ELSIF (n^.kind = AST.nkField) OR (n^.kind = AST.nkIndex)
        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;
       EmitAddr(n);
       LoadIndir
@@ -1342,16 +1387,27 @@ PROCEDURE AllocGlobal (size: CARDINAL): INTEGER;
 
 PROCEDURE EmitDecls (n: AST.Node);
   VAR sz: CARDINAL;
-    sl: INTEGER;
+    sl, vi: INTEGER;
   BEGIN
     WHILE (n # NIL) & ok DO
       IF n^.kind = AST.nkVar 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
         (* proc-scope vars are laid out by LayoutLocals *)
       ELSIF n^.kind = AST.nkProc THEN

二進制
src/MGen.o


+ 90 - 2
src/SymTab.def

@@ -23,17 +23,27 @@ IMPORT AST;
    223 cyclical type, 224 ordinal required, 230 unsupported construct
    (EXIT outside LOOP, open array outside formal), 232 bad RETURN,
    233 invalid call. 231 (forward mismatch) unused: no FORWARD.
-
    - flat scopes with levels: globals at level 0 (duplicates within
      one level rejected, shadowing allowed in nested scopes)
    - every symbol carries a type descriptor index (InvalidType if
      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
   MaxSyms = 256;
   InvalidType = -1;
 
+  (* compilation-unit kinds (SetUnit/UnitKind, driver stage machine) *)
+  UnitDef  = 0;
+  UnitImpl = 1;
+  UnitProg = 2;
+
   (* symbol kinds *)
   KindConst  = 0;
   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;
 (* 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.

+ 243 - 0
src/SymTab.mod

@@ -15,6 +15,7 @@ CONST
   MaxMods   = 8;
   MaxModExps = 32;
   MaxExps   = 128;
+  MaxDefs   = 16;
   MaxCallDepth = 8;
 
   (* descriptor forms *)
@@ -88,12 +89,23 @@ VAR
   expTypeA : ARRAY [0 .. MaxExps - 1] OF TypeIndex;
   expProcA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
   nExps : CARDINAL;
+  expValA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
+  expHasA : ARRAY [0 .. MaxExps - 1] OF BOOLEAN;
   callProc : ARRAY [0 .. MaxCallDepth - 1] OF INTEGER;
   callIdx : ARRAY [0 .. MaxCallDepth - 1] OF CARDINAL;
   callErr : ARRAY [0 .. MaxCallDepth - 1] OF BOOLEAN;
   callTop : CARDINAL;
   callFull : BOOLEAN;
   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;
   cdef : ARRAY [0 .. MaxSyms - 1] OF BOOLEAN;
 
@@ -167,6 +179,11 @@ PROCEDURE ConstFold (n: AST.Node; VAR v: INTEGER): BOOLEAN;
       RETURN TRUE
     ELSIF n^.kind = AST.nkName THEN
       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;
     RETURN FALSE
   END ConstFold;
@@ -1024,6 +1041,7 @@ PROCEDURE ExitModule (): BOOLEAN;
   VAR mi, k : CARDINAL;
     idx : INTEGER;
     en : Name;
+    v : INTEGER;
     ok : BOOLEAN;
   BEGIN
     IF modTop = 0 THEN RETURN TRUE END;
@@ -1044,6 +1062,11 @@ PROCEDURE ExitModule (): BOOLEAN;
         ELSE
           expProcA[nExps] := -1
         END;
+        IF (syms[idx].kind = KindConst) & ConstVal(en, v) THEN
+          expValA[nExps] := v; expHasA[nExps] := TRUE
+        ELSE
+          expHasA[nExps] := FALSE
+        END;
         INC(nExps)
       END;
       INC(k)
@@ -1219,6 +1242,7 @@ PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
   END Predef;
 
 PROCEDURE Init;
+  VAR i : CARDINAL;
   BEGIN
     nSyms := 0; curLev := 0; mtop := 0;
     nPend := 0; nPendF := 0;
@@ -1229,6 +1253,12 @@ PROCEDURE Init;
     modTop := 0; nExps := 0;
     callTop := 0; callFull := FALSE;
     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);
     dCard := NewDesc(FInt, InvalidType);
     dReal := NewDesc(FReal, InvalidType);
@@ -1249,6 +1279,219 @@ PROCEDURE Init;
     NoteConst("FALSE", 0, TRUE)
   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 ---------------- *)
 
 PROCEDURE WriteKind (kind: INTEGER);

二進制
src/SymTab.o


+ 115 - 11
src/compiler.frm

@@ -7,7 +7,7 @@ MODULE -->Grammar;
   FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
   FROM -->Parser IMPORT Parse, Successful;
   IMPORT
-    Strings, Storage, SYSTEM, FileIO, AST, MGen;
+    Strings, Storage, SYSTEM, FileIO, AST, MGen, SymTab;
 
   TYPE
     INT32 = FileIO.INT32 (* 32 bit integers needed *);
@@ -18,7 +18,7 @@ MODULE -->Grammar;
     FROM Storage IMPORT ALLOCATE;
     FROM SYSTEM IMPORT TSIZE;
     IMPORT lst, CharAt, errors, INT32;
-    EXPORT StoreError, PrintListing;
+    EXPORT StoreError, PrintListing, ResetErrors;
 
     TYPE
       Err = POINTER TO ErrDesc;
@@ -125,6 +125,12 @@ MODULE -->Grammar;
         WriteLn(lst)
       END PrintErr;
 
+    PROCEDURE ResetErrors;
+    (* Drops stored errors so the next input file starts clean. *)
+      BEGIN
+        firstErr := NIL; lastErr := NIL
+      END ResetErrors;
+
     PROCEDURE PrintListing;
     (* Print a source listing with error messages *)
       VAR
@@ -190,6 +196,23 @@ MODULE -->Grammar;
     sourceName, listName: ARRAY [0 .. 255] OF CHAR;
     failed: 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
     (* check on correct parameter usage *)
@@ -199,12 +222,17 @@ MODULE -->Grammar;
       HALT
     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 *)
     Error := StoreError;
 
+    SymTab.Init();
     failed := FALSE;
+    progSeen := FALSE;
+    nDefs := 0;
+    nImpls := 0;
     LOOP
       IF sourceName[0] = 0C THEN EXIT END;
 
@@ -225,25 +253,22 @@ MODULE -->Grammar;
         (* default Scanner.lst to screen *) lst := FileIO.StdOut;
       END;
 
+      (* fresh error list per input file (M2compS.Reset already
+         zeroes the error count inside Parse) *)
+      ResetErrors;
+
       (* instigate the compilation - Parser.Parse *)
       FileIO.WriteString(FileIO.StdOut, "Parsing ");
       FileIO.WriteString(FileIO.StdOut, sourceName);
       FileIO.WriteLn(FileIO.StdOut);
       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 *)
       PrintListing;
       IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
 
       (* fail fast: later files build on this one's tables *)
-      IF NOT (Successful() & emitOk)
+      IF NOT Successful()
         THEN
           FileIO.WriteString(FileIO.StdOut, "Incorrect source");
           FileIO.WriteLn(FileIO.StdOut);
@@ -251,9 +276,88 @@ MODULE -->Grammar;
           EXIT
       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);
     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 *)
     IF NOT failed THEN
       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.

Some files were not shown because too many files changed in this diff