Просмотр исходного кода

String, variant-record assignment, nested modules, ADDRESS<->pointer

- Opaque/forward (undeclared) aliases are pointer-like: ClassOf returns
  ClPtr, so Design/DeclVar/ResClass/AssOrCall treat them as pointers;
  gm2's pervasive String is predefined (imported definitions shadow it).
  Fixes filesystem.mod / opaque2.mod and NIL/copy/compare on String.
- Variant-record assignment: CopyRecord is now a flat byte blit of
  TypeSize(t) (correct for overlapping variant fields; records are flat
  blobs); variant records are emitted as one zeroed blob.  Previously
  it compiled but corrupted data / segfaulted.
- ADDRESS <-> pointer assignment: move the ADDRESS checks before the
  pointer-subclass test in SymTab.Assignable (p := ADR(x) now works).
- Nested local MODULE: verified exported names, procedures, nested-
  nested modules and init bodies lower correctly (docs updated).
- Tests t_variant2/t_string/t_addrptr/t_nestedmod; suite 169/169;
  fixpoint OK (2,730,510 bytes).  gm2 testsuite corpus 376 -> 395
  compile-OK (0 CRASH); gm2 stdlib 124 -> 131.
Eric Streit 1 неделя назад
Родитель
Сommit
6882d63998

+ 4 - 0
compiler/run_tests.sh

@@ -74,6 +74,10 @@ expect_run t_minmax2.mod 42
 expect_run t_setops.mod 42
 expect_run t_fwdtype.mod 42
 expect_run t_libc.mod 42
+expect_run t_variant2.mod 42
+expect_run t_string.mod 42
+expect_run t_addrptr.mod 42
+expect_run t_nestedmod.mod 42
 expect_run t_nestidx.mod 42
 expect_run t_proctype.mod 42
 expect_run t_compat.mod 42

+ 17 - 31
compiler/src/QbeGen.mod

@@ -2025,9 +2025,16 @@ PROCEDURE EmitVTables;
 
 PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
   VAR first: BOOLEAN;
-    vt: QVal;
+    vt, sz: QVal;
   BEGIN
     IF NOT opened THEN RETURN END;
+    IF SymTab.IsVariant(t) AND (SymTab.ClassOf(t) = SymTab.ClRecord) THEN
+      (* variant record: fields overlay, so emit one zero-filled blob
+         of the record's (max) size *)
+      IntStr(VAL(INTEGER, SymTab.TypeSize(t)), sz);
+      W("data $"); W(name); W(" = { z "); W(sz); WL(" }");
+      RETURN
+    END;
     RecStatics(name, t);
     W("data $"); W(name);
     W(" = { ");
@@ -2078,37 +2085,16 @@ PROCEDURE TopWith (VAR base: QVal): BOOLEAN;
 
 PROCEDURE CopyRecord (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                        t: INTEGER);
-(* Deep whole-record copy: scalars/sets by load/store, arrays via
-   CopyArray on dereferenced fields, nested records recurse. *)
-  VAR n, i: CARDINAL;
-    fn: SymTab.Name;
-    ft: SymTab.TypeIndex;
-    cls: INTEGER;
-    dd, ds, di, si, v: QVal;
-    off: QVal;
+(* Whole-record copy: a flat byte blit of the record's (max) size.
+   Records are flat blobs (scalars/sets/pointers inline, arrays and
+   nested records inline), so this is correct — and the only correct
+   choice for variant records, whose fields overlay. *)
+  VAR n: QVal;
   BEGIN
-    n := SymTab.FieldCount(t);
-    i := 0;
-    WHILE i < n DO
-      SymTab.FieldName(t, i, fn);
-      ft := SymTab.FieldType(t, fn);
-      cls := SymTab.ClassOf(ft);
-      IntStr(SymTab.FieldOffset(t, fn), off);
-      NewTemp(dd); Op3L("add", dd, dst, off);
-      NewTemp(ds); Op3L("add", ds, src, off);
-      IF cls = SymTab.ClArray THEN
-        (* inline array field: the field address is the descriptor *)
-        CopyArray(dd, ds, ft)
-      ELSIF cls = SymTab.ClSet THEN
-        CopySet(dd, ds, SymTab.SetWords(ft), SymTab.SetWords(ft))
-      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
-        CopyRecord(dd, ds, ft)
-      ELSE
-        ElemLoad(ds, ft, v);
-        ElemStore(dd, v, ft)
-      END;
-      INC(i)
-    END
+    IntStr(VAL(INTEGER, SymTab.TypeSize(t)), n);
+    Revive;
+    W("  call $memcpy(l "); W(dst); W(", l "); W(src);
+    W(", l "); W(n); WL(")")
   END CopyRecord;
 
 PROCEDURE WordsBytes (words: CARDINAL): CARDINAL;

+ 16 - 6
compiler/src/SymTab.mod

@@ -837,7 +837,14 @@ PROCEDURE ClassOf (t: TypeIndex): INTEGER;
   VAR r: TypeIndex;
   BEGIN
     r := Resolve(t);
-    IF r = InvalidType THEN RETURN ClInvalid END;
+    IF r = InvalidType THEN
+      (* an opaque/undeclared alias (e.g. gm2's String) is pointer-like *)
+      IF (t >= 0) AND (t < VAL(INTEGER, nTypes))
+         AND (tform[t] = FAlias) THEN
+        RETURN ClPtr
+      END;
+      RETURN ClInvalid
+    END;
     CASE tform[r] OF
       FInt : RETURN ClInt
     | FLong : RETURN ClLong
@@ -2669,17 +2676,18 @@ PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
     IF ClassOf(src) = ClNil THEN
       RETURN ClassOf(dst) = ClPtr
     END;
-    (* POINTER TO Derived assigns to POINTER TO Base (subtyping) *)
-    IF (ClassOf(src) = ClPtr) AND (ClassOf(dst) = ClPtr) THEN
-      RETURN IsSubclass(PtrBase(src), PtrBase(dst))
-    END;
-    (* ADDRESS assigns to/from any pointer *)
+    (* ADDRESS assigns to/from any pointer (check before the subclass
+       test, which returns early) *)
     IF (Resolve(src) = dAddr) AND (ClassOf(dst) = ClPtr) THEN
       RETURN TRUE
     END;
     IF (Resolve(dst) = dAddr) AND (ClassOf(src) = ClPtr) THEN
       RETURN TRUE
     END;
+    (* POINTER TO Derived assigns to POINTER TO Base (subtyping) *)
+    IF (ClassOf(src) = ClPtr) AND (ClassOf(dst) = ClPtr) THEN
+      RETURN IsSubclass(PtrBase(src), PtrBase(dst))
+    END;
     IF (ClassOf(src) = ClInt) AND (ClassOf(dst) = ClInt) THEN
       RETURN TRUE
     END;
@@ -2958,6 +2966,8 @@ PROCEDURE Init;
     Predef("CARDINAL16", KindPredef, dCard);
     Predef("CARDINAL32", KindPredef, dCard);
     Predef("CARDINAL64", KindPredef, dLong);
+    (* gm2's pervasive opaque dynamic-string type (pointer-sized). *)
+    Predef("String", KindPredef, dAddr);
     Predef("NIL", KindConst, dNil)
   END Init;
 

+ 12 - 0
compiler/tests/t_addrptr.mod

@@ -0,0 +1,12 @@
+MODULE taddrptr;
+// ADDRESS <-> pointer assignment.
+FROM SYSTEM IMPORT ADR;
+TYPE Arr = ARRAY [0..2] OF INTEGER;
+VAR a : Arr; p : POINTER TO Arr; q : POINTER TO INTEGER; v : INTEGER;
+VAR ExitCode : INTEGER;
+BEGIN
+  a[1] := 42;
+  p := ADR(a);
+  q := ADR(v); q^ := 7;
+  IF (p^[1] = 42) AND (v = 7) THEN ExitCode := 42 ELSE ExitCode := 1 END
+END taddrptr.

+ 13 - 0
compiler/tests/t_nestedmod.mod

@@ -0,0 +1,13 @@
+MODULE tnestedmod;
+// Local (nested) MODULE: exported procedure/var + init body.
+MODULE acc;
+  EXPORT Value, Bump;
+  VAR y : INTEGER;
+  PROCEDURE Value : INTEGER; BEGIN RETURN y END Value;
+  PROCEDURE Bump; BEGIN y := y + 6 END Bump;
+BEGIN y := 36 END acc;
+VAR ExitCode : INTEGER;
+BEGIN
+  Bump();
+  IF Value() = 42 THEN ExitCode := 42 ELSE ExitCode := 1 END
+END tnestedmod.

+ 8 - 0
compiler/tests/t_string.mod

@@ -0,0 +1,8 @@
+MODULE tstring;
+// gm2's pervasive opaque String type (pointer-like).
+VAR s, t : String;
+VAR ExitCode : INTEGER;
+BEGIN
+  s := NIL; t := s;
+  IF (s = NIL) AND (t = NIL) THEN ExitCode := 42 ELSE ExitCode := 1 END
+END tstring.

+ 15 - 0
compiler/tests/t_variant2.mod

@@ -0,0 +1,15 @@
+MODULE tvarassign;
+// Whole-variant-record assignment (flat blit; overlapping fields).
+TYPE R = RECORD k: INTEGER;
+                CASE tag: BOOLEAN OF
+                  TRUE : b: INTEGER |
+                  FALSE: c: ARRAY [0..7] OF CHAR
+                END END;
+VAR r, q : R;
+VAR ExitCode : INTEGER;
+BEGIN
+  r.k := 1; r.tag := TRUE; r.b := 99;
+  q := r;
+  IF (q.k = 1) AND (q.tag = TRUE) AND (q.b = 99) THEN ExitCode := 42
+  ELSE ExitCode := 1 END
+END tvarassign.

+ 10 - 7
docs/analysis_gaps.md

@@ -1,12 +1,12 @@
 # m2compiler-V3 — gap analysis (2026-09-30)
 
-Suite **165/165**, self-hosting fixpoint OK (2,745,278 bytes).
+Suite **169/169**, self-hosting fixpoint OK (2,730,510 bytes).
 Corpus at this point (with `$V3_LIBS`):
 
 | corpus | compile-OK | CRASH | LANG |
 | --- | --- | --- | --- |
-| gm2 testsuite (612) | 376 | 0 | 227 |
-| gm2 stdlib (336) | 124 | 0 | 212 |
+| gm2 testsuite (612) | 395 | 0 | 209 |
+| gm2 stdlib (336) | 131 | 0 | 205 |
 
 Failure taxonomy (testsuite, per file): `undeclared identifier` 65,
 `not supported yet` 43, `invalid call` 25, `incompatible assignment`
@@ -101,7 +101,10 @@ hex, `NOT`/`AND`/`OR` only, TopSpeed legacy isolated in the sidecar.
 5. ~~**Forward type references**~~ ✅ (module-level globals; TYPE-block
    forwards already worked)
 
-Remaining after today: `String`, `GOTO`/labels, variant-record
-assignment, nested-`MODULE` lowering, result suffixes, generics,
-coroutines, multiple inheritance (deliberate); `ADDRESS`↔pointer
-assignment; and the library holes in §2.
+Also done: `String` (opaque/pointer-like), variant-record
+assignment (flat blit), nested-`MODULE` lowering, `ADDRESS`↔pointer
+assignment.
+
+Remaining after today: `GOTO`/labels, result suffixes, generics,
+coroutines, multiple inheritance (deliberate), and the library holes
+in §2.

+ 13 - 6
docs/features.md

@@ -1,4 +1,4 @@
-# m2compiler-V3 — feature status (at `v3-gaps-1-5`, 165/165 green)
+# m2compiler-V3 — feature status (at `v3-string-variant-nested`, 169/169 green)
 
 Pipeline: Coco/R `M2.atg` (1748 lines, 73 productions) → `gm2`-built
 `M2` → QBE `.ssa` → `qbe` → `cc` → run. `SymTab.mod` 1623 lines,
@@ -49,22 +49,29 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   including variant records (`RECORD … ; CASE tag : T OF … END`): plain
   fields pack before the tag, each branch's fields overlay after it.
 - ✅ `SET OF` bool/char/subrange (multi-word masks).
-- ✅ `POINTER TO`, `NIL` as a real type.
+- ✅ `POINTER TO`, `NIL` as a real type, `ADDRESS` ↔ any pointer
+  assignment (`p := ADR(x)`).
 - ✅ `UCHAR` (32-bit codepoint) + `U'a'`/`U"…"` literals (strict
   RFC3629 decode → 234 on bad bytes), `UCHR`/`CHR8`/`UORD`, `U"…"`
   whole-string assignment to a 1-D `ARRAY OF UCHAR`, `+`
   concatenation of `U"…"` (and single-codepoint operands), and
   `LEN`/`LENGTH`/`HIGH` of a UString.
 - ✅ Opaque `TYPE T;` + completion in the implementation.
-- ✅ Variant records (`RECORD CASE … OF … END`); ⏸ whole-record
-  equality/assignment for variants is 236 (overlapping storage).
+- ✅ Variant records (`RECORD CASE … OF … END`); whole-record
+  assignment is a flat byte blit (correct for overlapping fields) and
+  whole-record `=` is 213.
+- ✅ gm2's pervasive opaque `String`: an undeclared/opaque type is
+  pointer-like (assign `NIL`, copy, compare, pass), and `String` is
+  predefined (imported definitions shadow it).
 
 ## Declarations
 - ✅ `CONST` (integer/char/real literals, folded), `VAR`, `TYPE`,
   `PROCEDURE` headings + bodies, `FORWARD`.
 - ✅ `DEFINITION`/`IMPLEMENTATION` modules, `IMPORT`/`FROM … IMPORT`,
-  `EXPORT` (parsed), nested local `MODULE` (parsed; lowering pending).
-- ✅ Opaque completion; module `BEGIN` init bodies.
+  `EXPORT` (parsed), nested local `MODULE` (including `EXPORT` lists,
+  nested-nested modules, and bodies lowered as startup init functions).
+- ✅ Opaque completion; opaque/forward types used as pointer-like
+  values; module `BEGIN` init bodies.
 - ✅ Strict impl-vs-def signature checks (error **235**): result type,
   formal count, formal types and `VAR`-ness are compared against the
   `DEFINITION` (was arity-only).

+ 17 - 5
docs/summary_v3-corpus.md

@@ -1,6 +1,6 @@
 # Step: V3 compiler corpus runs
 
-Tag `v3-corpus-run`. V3 suite **165/165**, fixpoint OK.
+Tag `v3-corpus-run`. V3 suite **169/169**, fixpoint OK.
 
 ## Why
 
@@ -22,19 +22,19 @@ gap).
 
 | | no libs | with `$V3_LIBS` |
 | --- | --- | --- |
-| **compile-OK** | 242 | **376** |
+| **compile-OK** | 242 | **395** |
 | CRASH | 0 | 0 |
 | LIB | 185 | **9** |
-| LANG | 185 | **227** |
+| LANG | 185 | **209** |
 
 **2. gm2 standard libraries** (`m2pim`/`m2iso`/`m2log`/`m2cor`/`m2min`,
 336 files):
 
 | | no libs | with `$V3_LIBS` |
 | --- | --- | --- |
-| **compile-OK** | 78 | **124** |
+| **compile-OK** | 78 | **131** |
 | LIB | 176 | **0** |
-| LANG | 82 | **212** |
+| LANG | 82 | **205** |
 
 (With the import path set, LIB noise is gone and the true LANG counts
 are visible.)
@@ -104,6 +104,18 @@ are visible.)
 17. **Module-level forward type references** — a global may name a type
     declared further down; emission is deferred until the TYPE block
     completes (TYPE-block forwards already worked).
+18. **`String` and opaque/forward types** — an undeclared or opaque
+    alias is pointer-like (`NIL`, copy, compare, pass); gm2's pervasive
+    `String` is predefined (imported definitions shadow it).
+19. **Variant-record assignment** — whole-record assignment is now a
+    flat byte blit of the (max) record size, correct for overlapping
+    variant fields; variant records are emitted as a zeroed blob.
+    (Previously it compiled but crashed / corrupted data.)
+20. **Nested local `MODULE`** — exported names, nested-nested modules
+    and bodies are lowered as startup init functions (was already
+    largely working; verified and documented).
+21. **`ADDRESS` ↔ pointer assignment** (`p := ADR(x)`), checked before
+    the pointer-subclass test.
 
 ## Remaining LANG gaps