Prechádzať zdrojové kódy

compiler: add module-level absolute variables

Eric Streit 8 hodín pred
rodič
commit
f2425f29ca

+ 1 - 0
compiler/run_tests.sh

@@ -51,6 +51,7 @@ expect_run t_minimal.mod 0
 expect_run t_longstr.mod 42
 expect_run t_csize.mod 42
 expect_run t_ptrsentinel.mod 42
+expect_run t_varaddress.mod 42
 expect_run t_exit.mod 7
 expect_run t_arith.mod 25
 expect_run showcase1.mod 50

+ 15 - 4
compiler/src/Lower.mod

@@ -1021,10 +1021,11 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                        VAR sfx: BOOLEAN);
 (* Base ident then selectors (mirrors the grammar's Design).  Leaves the
    address in q with sfx=TRUE for selectors; base vars/consts load. *)
-  VAR nm, fn, mal: SymTab.Name; cv: QbeGen.QVal; cls, op: INTEGER;
+  VAR nm, fn, mal: SymTab.Name; cv, qa: QbeGen.QVal; cls, op: INTEGER;
       i: CARDINAL; sel: AST.Node; eT, it: SymTab.TypeIndex;
       iq, ql, qlo, qhi, qe: QbeGen.QVal;
       lo, hi, fo: INTEGER; isOpen, viewMode: BOOLEAN;
+      absAddr: LONGINT;
   BEGIN
     IF AST.Kind(AST.Child(n, 0)) = AST.NkCall THEN
       (* a call result used as a designator base: P()^, P()^.field,
@@ -1086,7 +1087,13 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
       END
     ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
       cls := SymTab.ClassOf(t);
-      IF AST.Op(n) = 1 THEN
+      IF SymTab.GetSymAbs(nm, absAddr) THEN
+        (* absolute variable: materialize the fixed address as a value *)
+        QbeGen.IntStr(VAL(INTEGER, absAddr), qa);
+        QbeGen.NewTemp(q);
+        QbeGen.Op3L("add", q, qa, "0");
+        sfx := TRUE
+      ELSIF AST.Op(n) = 1 THEN
         (* a forward module-level reference: the grammar's FwdAddrOper
            leaves an address (sfx=TRUE), not a loaded value *)
         QbeGen.AddrOf(nm, q); sfx := TRUE
@@ -2962,6 +2969,7 @@ PROCEDURE EmitVarNames (c: AST.Node);
 (* Emit DeclVar for each name of an NkVarDecl; the names are a chunked
    sequence (AstAppend), so follow NkBlock continuations. *)
   VAR j: CARDINAL; chunk, vn: AST.Node; nm: SymTab.Name;
+      absAddr: LONGINT;
   BEGIN
     chunk := c;
     WHILE chunk # AST.NoNode DO
@@ -2970,8 +2978,11 @@ PROCEDURE EmitVarNames (c: AST.Node);
         vn := AST.Child(chunk, j);
         IF AST.Kind(vn) = AST.NkIdent THEN
           Name(vn, nm);
-          QbeGen.DeclVar(nm, AST.Ty(c));
-          IF (NOT QbeGen.InFunction())
+          IF NOT SymTab.GetSymAbs(nm, absAddr) THEN
+            QbeGen.DeclVar(nm, AST.Ty(c))
+          END;
+          IF (NOT SymTab.GetSymAbs(nm, absAddr))
+             AND (NOT QbeGen.InFunction())
              AND (SymTab.ClassOf(AST.Ty(c)) = SymTab.ClArray)
              AND QbeGen.RecArrayNeedsInit(SymTab.ArrayLen(AST.Ty(c)),
                                           AST.Ty(c))

+ 20 - 2
compiler/src/M2.atg

@@ -2173,6 +2173,7 @@ PRODUCTIONS
                                         (. astDecl := astSeq; .) .
   VarDecl                               (. VAR nm: SymTab.Name;
                                              t: SymTab.TypeIndex;
+                                             absAddr: LONGINT;
                                              i: CARDINAL;
                                              cls: INTEGER;
                                              astNode, astTail: AST.Node; .)
@@ -2182,6 +2183,10 @@ PRODUCTIONS
                                            i := 0;
                                            WHILE i < SymTab.PendCount() DO
                                              SymTab.PendName(i, nm);
+                                             IF SymTab.GetSymAbs(nm, absAddr)
+                                                AND SymTab.InProc() THEN
+                                               SemError(230)
+                                             END;
                                              Lower.NoteVar(nm, SymTab.KindVar, t);
                                              (* chunked: a VAR list can
                                                 exceed AST.MaxChild *)
@@ -2246,14 +2251,27 @@ PRODUCTIONS
                                               result is discarded *)
                                            IF NOT SymTab.FixPending(t) THEN
                                            END; .) .
-  VarIdents                             (. VAR n: SymTab.Name; .)
+  VarIdents                             (. VAR n: SymTab.Name;
+                                             at: SymTab.TypeIndex;
+                                             aq: QbeGen.QVal;
+                                             av: INTEGER; .)
     = GetIdent<n>                       (. IF NOT SymTab.EnterPending(n,
                                              SymTab.KindVar) THEN
                                              SemError(200) END; .)
+      [ "[" Expr<at, aq> "]"            (. IF SymTab.ConstInt(aq, av) THEN
+                                             SymTab.SetSymAbs(n,
+                                               VAL(LONGINT, av))
+                                           ELSE SemError(230)
+                                           END; .) ]
       { ","
         GetIdent<n>                     (. IF NOT SymTab.EnterPending(n,
                                              SymTab.KindVar) THEN
-                                             SemError(200) END; .) } .
+                                             SemError(200) END; .)
+        [ "[" Expr<at, aq> "]"          (. IF SymTab.ConstInt(aq, av) THEN
+                                             SymTab.SetSymAbs(n,
+                                               VAL(LONGINT, av))
+                                           ELSE SemError(230)
+                                           END; .) ] } .
   ParIdents<isV: BOOLEAN>               (. VAR n: SymTab.Name; .)
     = GetIdent<n>                       (. IF NOT SymTab.EnterParam(n, isV) THEN
                                              SemError(200) END; .)

+ 6 - 0
compiler/src/SymTab.def

@@ -130,6 +130,12 @@ PROCEDURE SetSymVal (name: ARRAY OF CHAR; v: ARRAY OF CHAR);
 PROCEDURE GetSymVal (name: ARRAY OF CHAR; VAR v: ARRAY OF CHAR): BOOLEAN;
 (* v := stored literal value text of CONST name; FALSE if none. *)
 
+PROCEDURE SetSymAbs (name: ARRAY OF CHAR; addr: LONGINT);
+(* Marks a KindVar as declared at a fixed address. *)
+
+PROCEDURE GetSymAbs (name: ARRAY OF CHAR; VAR addr: LONGINT): BOOLEAN;
+(* Fixed address of an absolute variable, or FALSE. *)
+
 PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
 
 PROCEDURE PushScope;

+ 25 - 0
compiler/src/SymTab.mod

@@ -60,6 +60,8 @@ TYPE
     mod   : Name;       (* defining module (for QBE global names) *)
     uid   : CARDINAL;   (* KindProc: unique id for name mangling *)
     val   : Name;       (* KindConst: literal value text, "" if none *)
+    abs   : BOOLEAN;    (* KindVar: declared at a fixed address *)
+    absAddr : LONGINT;  (* KindVar: fixed address when abs is TRUE *)
     declSeq : CARDINAL; (* declaration order (module-level use-before-decl) *)
   END;
   ScopeNode = RECORD
@@ -191,6 +193,28 @@ PROCEDURE Assign (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR);
     dest[i] := CHR(0)
   END Assign;
 
+PROCEDURE SetSymAbs (name: ARRAY OF CHAR; addr: LONGINT);
+  VAR node: SymPtr;
+  BEGIN
+    node := Find(name);
+    IF (node # NIL) AND (node^.kind = KindVar) THEN
+      node^.abs := TRUE;
+      node^.absAddr := addr
+    END
+  END SetSymAbs;
+
+PROCEDURE GetSymAbs (name: ARRAY OF CHAR; VAR addr: LONGINT): BOOLEAN;
+  VAR node: SymPtr;
+  BEGIN
+    node := Find(name);
+    addr := 0;
+    IF (node # NIL) AND (node^.abs) THEN
+      addr := node^.absAddr;
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END GetSymAbs;
+
 PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
   VAR i : CARDINAL;
   BEGIN
@@ -335,6 +359,7 @@ PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): SymPtr;
     node^.left := NIL;
     node^.right := NIL;
     node^.val[0] := CHR(0);
+    node^.abs := FALSE; node^.absAddr := 0;
     node^.declSeq := declSeq; INC(declSeq);
     node^.fsnap := FALSE;   (* no DEFINITION signature snapshotted *)
     node^.ext := FALSE;

+ 10 - 0
compiler/tests/t_varaddress.mod

@@ -0,0 +1,10 @@
+MODULE TVarAddress;
+(* Absolute variable: no storage is emitted; ADR is the fixed address. *)
+FROM SYSTEM IMPORT ADDRESS, VAL, ADR;
+VAR ExitCode : INTEGER;
+    v [0x1000] : CARDINAL;
+    p : ADDRESS;
+BEGIN
+  p := ADR(v);
+  IF p = VAL(ADDRESS, 0x1000) THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TVarAddress.

+ 1 - 1
docs/comparison-PIM4-gm2-V3.md

@@ -87,7 +87,7 @@ change individual cells.
 | `BYTE` granularity | ✅ 8-bit | ✅ 8-bit | ✅ `OCTET` 8-bit | ✅ (PIM `BYTE`) | ✅ `BYTE`/`SBYTE`/`WORD8`/`CARDINAL8`/`INTEGER8` are 8-bit; `ARRAY OF BYTE` is a real buffer |
 | `SHORTREAL` (32-bit) | ❌ | ✅ | ❌ (REAL/LONGREAL) | ⚠️ dialect-dependent | ✅ true 4-byte `SHORTREAL`/`REAL32` |
 | `ADDRESS` arithmetic (`ADDADR`/`SUBADR`/`DIFADR`) | ❌ | ✅ | ❌ | ❌ | ❌ |
-| Absolute variables `VAR [addr]: T` | ❌ | ✅ (extension) | ✅ (pragma `ADDR`) | ❌ | ❌ |
+| Absolute variables `VAR [addr]: T` | ❌ | ✅ (extension) | ✅ (pragma `ADDR`) | ❌ | ✅ module-level (`VAR x [0x...] : T`) |
 | Set ordering (`<`, `<=`, `>`, `>=`) | ❌ (`=`/`#`/`IN` only) | ✅ (extension) | ❌ | ❌ | ❌ |
 
 ## Statements & procedures

+ 30 - 36
docs/future-work-2026-10-25.md

@@ -14,7 +14,7 @@ implement everything.
 (3,845,439 bytes), per-object fixpoint OK (11 objects), corpus
 521/612 compile-OK, 0 crashes, 64 `LANG` and 27 `LIB`.
 
-**Progress update 2026-10-27:** suite 327/327.  The SQLite binding
+**Progress update 2026-10-27:** suite 328/328.  The SQLite binding
 is under `bindings/sqlite3` and has its own tests/showcases.  Compiler
 work completed since this note:
 
@@ -27,8 +27,8 @@ work completed since this note:
   `VAL(ADDRESS, -1)`;
 - `ADR(array)` remains descriptor-based for compatibility; C bindings
   use `ADR(a[0])` for the data address;
-- absolute variables (`VAR x [addr] : T`) remain unimplemented; see
-  section 2.1 below.
+- absolute variables (`VAR x [addr] : T`) are implemented at module level;
+  see section 2.1 below.
 
 ---
 
@@ -104,7 +104,7 @@ escape hatch.
 
 ---
 
-### 2.1 Absolute variables (`VAR x [address] : T`) — not implemented
+### 2.1 Absolute variables (`VAR x [address] : T`) — implemented 2026-10-27
 
 GNU Modula-2 supports fixed-address variables:
 
@@ -119,36 +119,31 @@ memory-mapped I/O, firmware tables and embedded targets.
 
 Current V3 status:
 
-- the syntax is rejected by `VarIdents` (`':' expected` / `'..' expected`);
-- gm2 corpus cases `varaddress`, `varaddress2`, `varaddress3` remain
-  unsupported;
-- `docs/comparison-PIM4-gm2-V3.md` lists absolute variables as a V3
-  missing feature.
-
-Implementation requirements:
-
-1. Parser: accept an optional `[constant-expression]` after each name in
-   `VarIdents`; do not confuse it with the `[lo..hi]` type subrange.
-2. Constant folding: require a constant address, using the V3 `0x...`
-   form (the gm2 `1000H` suffix is not currently accepted).
-3. Symbol table: add absolute-variable metadata (flag + address); expose
-   it to `Lower`.
-4. AST/Lower: record the address; a designator of an absolute variable
-   must produce the fixed address instead of `AddrOf`.
-5. QBE: do not emit a normal global data object or initializer for an
-   absolute variable; emit direct loads/stores.
-6. `ADR(var)` must return the fixed address; passes to `VAR` formals and
-   pointer-based access should remain addressable.
-7. Decide whether absolute variables are module-level only or also
-   allowed locally.
-8. Document alignment/volatile limits: V3 has no `VOLATILE` annotation
-   yet, so memory-mapped I/O still needs careful review.
-9. Tests: compile-only checks such as `ADR(var) = 0x1000`; avoid
-   dereferencing arbitrary unmapped addresses in the normal suite.
-   A runtime test needs a deliberately mapped address or an allocated
-   buffer.
-
-Current workaround:
+- syntax accepted for module-level variables: `VAR v [0x1000] : CARDINAL`;
+- addresses are constant-folded; the V3 `0x...` form is required
+  (the gm2 `1000H` suffix is not accepted);
+- `SymTab` records the absolute flag/address;
+- `Lower` materializes the fixed address instead of `AddrOf`;
+- `QBE` emits no normal data object or initializer for the variable;
+- `ADR(v)` returns the fixed address;
+- absolute variables inside procedures are currently rejected with
+  `not supported yet`;
+- address materialization currently uses the 32-bit `IntStr` path;
+  addresses above `0x7FFFFFFF` need a long-address follow-up;
+- no `VOLATILE` annotation exists yet, so memory-mapped I/O still needs
+  careful review.
+
+Covered by:
+
+```text
+compiler/tests/t_varaddress.mod
+```
+
+The test checks `ADR(v) = VAL(ADDRESS, 0x1000)` without dereferencing an
+arbitrary unmapped address.  A runtime read/write test needs a
+deliberately mapped page or an allocated buffer.
+
+Current workaround for addresses outside the implemented range:
 
 ```modula2
 TYPE PCard = POINTER TO CARDINAL;
@@ -159,8 +154,7 @@ BEGIN
 END
 ```
 
-This is not a named absolute variable, but it is usable today now that
-`VAL` supports integer-to-pointer conversion.
+---
 
 ---
 

+ 3 - 2
docs/triage-corpus-2026-10-24.md

@@ -63,8 +63,9 @@ No policy relaxation is recommended.
   but structurally identical array types).
 - **`SHORTREAL` vs `WORD` VAR**: `testparam3` (gm2 word-model
   extension; V3 has 64-bit reals).
-- **Absolute variables** `VAR [addr]: T`: `varaddress`,
-  `varaddress2`, `varaddress3`.
+- **Absolute variables** `VAR [addr]: T`: now supported at module level;
+  the gm2 corpus uses the `1000H` suffix, so those cases still need a
+  literal-form update or scanner support.
 - **Module named `CHAR`**: `CHAR.mod` collides with the predefined
   type; gm2-specific test naming.