v3 step 5.7 — ADDRESS/ADR/SIZE builtins + Storage (98/98 tests green)

compiler/run_tests.sh

@@ -207,6 +207,7 @@ expect_run_files DBasicProg 49 d_basic.def d_basic.mod d_basic_prog.mod
 expect_run_files DQualProg 46 d_basic.def d_basic.mod d_qual_prog.mod
 expect_run_files DTypesProg 36 d_types.def d_types.mod d_types_prog.mod
 expect_run_files DOpaqueProg 55 d_opaque.def d_opaque.mod d_opaque_prog.mod
+expect_run_files StorageProg 42 ../stdlib/storage.def ../stdlib/storage.mod storage_prog.mod
 expect_run_files ClashProg 60 d_clash_a.def d_clash_a.mod d_clash_b.def d_clash_b.mod d_clash_prog.mod
 expect_run_files_out Hello 0 "Hello, Modula-2!" ../stdlib/sysio.def ../stdlib/sysio.mod hello.mod
 expect_run_files_out StringsProg 0 "Hello World" ../stdlib/sysio.def ../stdlib/sysio.mod ../stdlib/strings.def ../stdlib/strings.mod strings_prog.mod

compiler/src/M2.atg

@@ -1702,8 +1702,32 @@ PRODUCTIONS
                                                    qr)
                                                END
                                              END;
-                                             t := SymTab.IntType();
-                                             QbeGen.CopyOp(qr, q)
+                                              t := SymTab.IntType();
+                                              QbeGen.CopyOp(qr, q)
+                                            END; .)
+    | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
+                                        (. IF dt = SymTab.InvalidType THEN
+                                             t := SymTab.InvalidType;
+                                             QbeGen.CopyOp("0", q)
+                                           ELSE
+                                             QbeGen.IntStr(VAL(INTEGER,
+                                               SymTab.ObjectSize(dt)), q);
+                                             t := SymTab.IntType()
+                                           END; .)
+    | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
+                                        (. IF dt = SymTab.InvalidType THEN
+                                             t := SymTab.InvalidType;
+                                             QbeGen.CopyOp("0", q)
+                                           ELSE
+                                             IF sfx THEN
+                                               QbeGen.CopyOp(qd, q)
+                                             ELSIF (dk = SymTab.KindVar)
+                                                OR (dk = SymTab.KindParam) THEN
+                                               QbeGen.AddrOf(qn, q)
+                                             ELSE SemError(230);
+                                               QbeGen.CopyOp("0", q)
+                                             END;
+                                             t := SymTab.AddrType()
                                            END; .)
     | "(" Expr<et, q> ")"               (. t := et; .)
     | SetLit<st, sq>                    (. t := st;

compiler/src/M2.lst

@@ -1719,104 +1719,128 @@ Listing:
  1702                                                     qr)
  1703                                                 END
  1704                                               END;
- 1705                                               t := SymTab.IntType();
- 1706                                               QbeGen.CopyOp(qr, q)
- 1707                                             END; .)
- 1708      | "(" Expr<et, q> ")"               (. t := et; .)
- 1709      | SetLit<st, sq>                    (. t := st;
- 1710                                             QbeGen.CopyOp(sq, q); .)
- 1711      | "NOT" Fact<t2, q2>                (. IF SymTab.BoolCheck(t2) THEN
- 1712                                               t := SymTab.BoolType()
- 1713                                             ELSE SemError(212);
- 1714                                               t := SymTab.InvalidType END;
- 1715                                             IF t # SymTab.InvalidType THEN
- 1716                                               QbeGen.NotQ(q2, q)
- 1717                                             ELSE QbeGen.CopyOp("0", q)
- 1718                                             END; .) .
- 1719    (* Set literals are SET OF [0..255] (8 words); elements validated
- 1720       0..255 statically when foldable (222 otherwise), runtime trap
- 1721       for computed elements. Ranges always lower via SetRange. *)
- 1722    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1723      = "{"                               (. t := SymTab.NewSet(
- 1724                                               SymTab.NewSubR(0, 255));
- 1725                                             QbeGen.NewSetTemp(8, q);
- 1726                                             QbeGen.SetZero(q, 8); .)
- 1727        [ SetElem<t, q> { "," SetElem<t, q> } ]
- 1728        "}" .
- 1729    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
- 1730                                               qe, q2: QbeGen.QVal;
- 1731                                               v, v2: INTEGER;
- 1732                                               lo: INTEGER;
- 1733                                               span: CARDINAL;
- 1734                                               cl, cl2: INTEGER;
- 1735                                               hasR: BOOLEAN; .)
- 1736      =                                   (. hasR := FALSE; .)
- 1737        Expr<et, qe>
- 1738        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
- 1739                                          (. lo := SymTab.SetBaseLo(st);
- 1740                                             span := SymTab.SetCount(st);
- 1741                                             IF (et = SymTab.InvalidType)
- 1742                                                OR (hasR & (et2 =
- 1743                                                   SymTab.InvalidType)) THEN
- 1744                                             ELSE cl :=
- 1745                                                    SymTab.ClassOf(et);
- 1746                                               IF hasR THEN
- 1747                                                 cl2 :=
- 1748                                                   SymTab.ClassOf(et2)
- 1749                                               ELSE cl2 := SymTab.ClInt
- 1750                                               END;
- 1751                                               IF ((cl # SymTab.ClInt)
- 1752                                                  & (cl # SymTab.ClChar)
- 1753                                                  & (cl # SymTab.ClBool))
- 1754                                                  OR (hasR &
- 1755                                                     ((cl2
- 1756                                                       # SymTab.ClInt)
- 1757                                                     & (cl2
- 1758                                                        # SymTab.ClChar)
- 1759                                                     & (cl2
- 1760                                                        # SymTab.ClBool))) THEN
- 1761                                                 SemError(222)
- 1762                                               ELSIF hasR
- 1763                                                  & SymTab.ConstInt(qe, v)
- 1764                                                  & SymTab.ConstInt(q2,
- 1765                                                     v2)
- 1766                                                  & ((v < lo)
- 1767                                                     OR (v2 < lo)
- 1768                                                     OR (v >= lo +
- 1769                                                        VAL(INTEGER, span))
- 1770                                                     OR (v2 >= lo +
- 1771                                                        VAL(INTEGER, span))
- 1772                                                     OR (v > v2)) THEN
- 1773                                                 SemError(222)
- 1774                                                ELSIF hasR THEN
- 1775                                                  QbeGen.SetRange(sq, qe, q2,
- 1776                                                    lo, span)
- 1777                                                ELSIF SymTab.ConstInt(qe,
- 1778                                                        v)
- 1779                                                   & ((v < lo)
- 1780                                                      OR (v >= lo +
- 1781                                                         VAL(INTEGER,
- 1782                                                           span))) THEN
- 1783                                                  SemError(222)
- 1784                                                ELSE QbeGen.SetBit(sq, qe,
- 1785                                                  lo, span)
- 1786                                               END
- 1787                                             END; .) .
- 1788    GetIdent<VAR n: SymTab.Name>
- 1789      = ident                             (. LexName(n); .) .
- 1790  
- 1791  END M2.
+ 1705                                                t := SymTab.IntType();
+ 1706                                                QbeGen.CopyOp(qr, q)
+ 1707                                              END; .)
+ 1708      | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
+ 1709                                          (. IF dt = SymTab.InvalidType THEN
+ 1710                                               t := SymTab.InvalidType;
+ 1711                                               QbeGen.CopyOp("0", q)
+ 1712                                             ELSE
+ 1713                                               QbeGen.IntStr(VAL(INTEGER,
+ 1714                                                 SymTab.ObjectSize(dt)), q);
+ 1715                                               t := SymTab.IntType()
+ 1716                                             END; .)
+ 1717      | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
+ 1718                                          (. IF dt = SymTab.InvalidType THEN
+ 1719                                               t := SymTab.InvalidType;
+ 1720                                               QbeGen.CopyOp("0", q)
+ 1721                                             ELSE
+ 1722                                               IF sfx THEN
+ 1723                                                 QbeGen.CopyOp(qd, q)
+ 1724                                               ELSIF (dk = SymTab.KindVar)
+ 1725                                                  OR (dk = SymTab.KindParam) THEN
+ 1726                                                 QbeGen.AddrOf(qn, q)
+ 1727                                               ELSE SemError(230);
+ 1728                                                 QbeGen.CopyOp("0", q)
+ 1729                                               END;
+ 1730                                               t := SymTab.AddrType()
+ 1731                                             END; .)
+ 1732      | "(" Expr<et, q> ")"               (. t := et; .)
+ 1733      | SetLit<st, sq>                    (. t := st;
+ 1734                                             QbeGen.CopyOp(sq, q); .)
+ 1735      | "NOT" Fact<t2, q2>                (. IF SymTab.BoolCheck(t2) THEN
+ 1736                                               t := SymTab.BoolType()
+ 1737                                             ELSE SemError(212);
+ 1738                                               t := SymTab.InvalidType END;
+ 1739                                             IF t # SymTab.InvalidType THEN
+ 1740                                               QbeGen.NotQ(q2, q)
+ 1741                                             ELSE QbeGen.CopyOp("0", q)
+ 1742                                             END; .) .
+ 1743    (* Set literals are SET OF [0..255] (8 words); elements validated
+ 1744       0..255 statically when foldable (222 otherwise), runtime trap
+ 1745       for computed elements. Ranges always lower via SetRange. *)
+ 1746    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1747      = "{"                               (. t := SymTab.NewSet(
+ 1748                                               SymTab.NewSubR(0, 255));
+ 1749                                             QbeGen.NewSetTemp(8, q);
+ 1750                                             QbeGen.SetZero(q, 8); .)
+ 1751        [ SetElem<t, q> { "," SetElem<t, q> } ]
+ 1752        "}" .
+ 1753    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
+ 1754                                               qe, q2: QbeGen.QVal;
+ 1755                                               v, v2: INTEGER;
+ 1756                                               lo: INTEGER;
+ 1757                                               span: CARDINAL;
+ 1758                                               cl, cl2: INTEGER;
+ 1759                                               hasR: BOOLEAN; .)
+ 1760      =                                   (. hasR := FALSE; .)
+ 1761        Expr<et, qe>
+ 1762        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
+ 1763                                          (. lo := SymTab.SetBaseLo(st);
+ 1764                                             span := SymTab.SetCount(st);
+ 1765                                             IF (et = SymTab.InvalidType)
+ 1766                                                OR (hasR & (et2 =
+ 1767                                                   SymTab.InvalidType)) THEN
+ 1768                                             ELSE cl :=
+ 1769                                                    SymTab.ClassOf(et);
+ 1770                                               IF hasR THEN
+ 1771                                                 cl2 :=
+ 1772                                                   SymTab.ClassOf(et2)
+ 1773                                               ELSE cl2 := SymTab.ClInt
+ 1774                                               END;
+ 1775                                               IF ((cl # SymTab.ClInt)
+ 1776                                                  & (cl # SymTab.ClChar)
+ 1777                                                  & (cl # SymTab.ClBool))
+ 1778                                                  OR (hasR &
+ 1779                                                     ((cl2
+ 1780                                                       # SymTab.ClInt)
+ 1781                                                     & (cl2
+ 1782                                                        # SymTab.ClChar)
+ 1783                                                     & (cl2
+ 1784                                                        # SymTab.ClBool))) THEN
+ 1785                                                 SemError(222)
+ 1786                                               ELSIF hasR
+ 1787                                                  & SymTab.ConstInt(qe, v)
+ 1788                                                  & SymTab.ConstInt(q2,
+ 1789                                                     v2)
+ 1790                                                  & ((v < lo)
+ 1791                                                     OR (v2 < lo)
+ 1792                                                     OR (v >= lo +
+ 1793                                                        VAL(INTEGER, span))
+ 1794                                                     OR (v2 >= lo +
+ 1795                                                        VAL(INTEGER, span))
+ 1796                                                     OR (v > v2)) THEN
+ 1797                                                 SemError(222)
+ 1798                                                ELSIF hasR THEN
+ 1799                                                  QbeGen.SetRange(sq, qe, q2,
+ 1800                                                    lo, span)
+ 1801                                                ELSIF SymTab.ConstInt(qe,
+ 1802                                                        v)
+ 1803                                                   & ((v < lo)
+ 1804                                                      OR (v >= lo +
+ 1805                                                         VAL(INTEGER,
+ 1806                                                           span))) THEN
+ 1807                                                  SemError(222)
+ 1808                                                ELSE QbeGen.SetBit(sq, qe,
+ 1809                                                  lo, span)
+ 1810                                               END
+ 1811                                             END; .) .
+ 1812    GetIdent<VAR n: SymTab.Name>
+ 1813      = ident                             (. LexName(n); .) .
+ 1814  
+ 1815  END M2.
 
     0 errors
 
 
 Statistics:
 
-  nr of terminals:        78 (limit   400)
+  nr of terminals:        81 (limit   400)
   nr of non-terminals:    73 (limit   210)
-  nr of pragmas:           0 (limit   422)
-  nr of symbolnodes:     151 (limit   500)
-  nr of graphnodes:      681 (limit  1500)
+  nr of pragmas:           0 (limit   419)
+  nr of symbolnodes:     154 (limit   500)
+  nr of graphnodes:      696 (limit  1500)
   nr of conditionsets:     7 (limit   100)
   nr of charactersets:    11 (limit   250)
 

compiler/src/SymTab.def

@@ -323,6 +323,13 @@ PROCEDURE IntType (): TypeIndex;
 PROCEDURE RealType (): TypeIndex;
 PROCEDURE CharType (): TypeIndex;
 PROCEDURE BoolType (): TypeIndex;
+PROCEDURE AddrType (): TypeIndex;
+(* ADDRESS: the pointer-sized opaque type (interchangeable with any
+   pointer for assignment and VAR parameters). *)
+
+PROCEDURE ObjectSize (t: TypeIndex): CARDINAL;
+(* Full allocation footprint (arrays 8 + count*element); drives
+   SYSTEM.SIZE/TSIZE. *)
 
 PROCEDURE ClassOf (t: TypeIndex): INTEGER;
 (* Resolves aliases; InvalidType maps to ClInvalid. *)

compiler/src/SymTab.mod

@@ -84,7 +84,7 @@ VAR
   procStk : ARRAY [0 .. 15] OF SymPtr;
   nProc : CARDINAL;
   nextUid : CARDINAL;
-  dInt, dCard, dReal, dChar, dBool, dNil : TypeIndex;
+  dInt, dCard, dReal, dChar, dBool, dNil, dAddr : TypeIndex;
   globScope : ScopePtr;  (* the global scope (module names live here) *)
   curMod : INTEGER;      (* current registry slot, -1 between units *)
   curUnit : INTEGER;     (* UnitProg/Def/Impl, -1 between units *)
@@ -514,6 +514,9 @@ PROCEDURE Resolve (t: TypeIndex): TypeIndex;
 
 PROCEDURE IntType (): TypeIndex;
   BEGIN RETURN dInt END IntType;
+
+PROCEDURE AddrType (): TypeIndex;
+  BEGIN RETURN dAddr END AddrType;
 PROCEDURE RealType (): TypeIndex;
   BEGIN RETURN dReal END RealType;
 PROCEDURE CharType (): TypeIndex;
@@ -740,6 +743,33 @@ PROCEDURE TypeSize (t: TypeIndex): CARDINAL;
     RETURN TypeSizeD(t, 0)
   END TypeSize;
 
+PROCEDURE ElemBytes (t: TypeIndex): CARDINAL;
+(* element size of array descriptor t (bytes) *)
+  VAR cls: INTEGER;
+  BEGIN
+    cls := ClassOf(ArrayElem(t));
+    IF cls = ClChar THEN RETURN 1 END;
+    IF cls = ClReal THEN RETURN 8 END;
+    IF (cls = ClArray) OR (cls = ClPtr) OR (cls = ClRecord)
+       OR (cls = ClClass) THEN
+      RETURN 8
+    END;
+    RETURN 4
+  END ElemBytes;
+
+PROCEDURE ObjectSize (t: TypeIndex): CARDINAL;
+(* full allocation footprint: arrays 8 + count*elem, else TypeSize.
+   Used by SYSTEM.SIZE/TSIZE. *)
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r # InvalidType) & ((tform[r] = FArray)
+       OR (tform[r] = FOpenArr)) THEN
+      RETURN 8 + ArrayLen(t) * ElemBytes(t)
+    END;
+    RETURN TypeSize(t)
+  END ObjectSize;
+
 PROCEDURE ComputeOffsets (r: TypeIndex);
 (* Declaration-order offsets over the (prepend-built, hence reverse)
    field chain, plus declaration ranks. Array fields count 8
@@ -1127,6 +1157,13 @@ PROCEDURE VarParamOk (actual, formal: TypeIndex): BOOLEAN;
       RETURN TRUE
     END;
     IF SameType(actual, formal) THEN RETURN TRUE END;
+    (* ADDRESS is interchangeable with any pointer for VAR params *)
+    IF (Resolve(formal) = dAddr) & (ClassOf(actual) = ClPtr) THEN
+      RETURN TRUE
+    END;
+    IF (Resolve(actual) = dAddr) & (ClassOf(formal) = ClPtr) THEN
+      RETURN TRUE
+    END;
     IF IsOpenArray(formal)
        & (ClassOf(actual) = ClArray) & (ArrayDepth(actual) = 1) THEN
       fa := ArrayElem(actual); fe := ArrayElem(formal);
@@ -1518,6 +1555,13 @@ PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
     IF ClassOf(src) = ClNil THEN
       RETURN ClassOf(dst) = ClPtr
     END;
+    (* ADDRESS assigns to/from any pointer *)
+    IF (Resolve(src) = dAddr) & (ClassOf(dst) = ClPtr) THEN
+      RETURN TRUE
+    END;
+    IF (Resolve(dst) = dAddr) & (ClassOf(src) = ClPtr) THEN
+      RETURN TRUE
+    END;
     IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClInt) THEN
       RETURN TRUE
     END;
@@ -1679,6 +1723,7 @@ PROCEDURE Init;
     dChar := NewDesc(FChar, InvalidType);
     dBool := NewDesc(FBool, InvalidType);
     dNil := NewDesc(FNil, InvalidType);
+    dAddr := NewDesc(FPtr, InvalidType);   (* ADDRESS: pointer-sized *)
     Predef("INTEGER", KindPredef, dInt);
     Predef("CARDINAL", KindPredef, dCard);
     Predef("SHORTINT", KindPredef, dInt);
@@ -1690,6 +1735,7 @@ PROCEDURE Init;
     Predef("BOOLEAN", KindPredef, dBool);
     Predef("TRUE", KindConst, dBool);
     Predef("FALSE", KindConst, dBool);
+    Predef("ADDRESS", KindPredef, dAddr);
     Predef("NIL", KindConst, dNil)
   END Init;
 

compiler/tests/storage_prog.mod

@@ -0,0 +1,19 @@
+MODULE StorageProg;
+(* Storage.ALLOCATE/DEALLOCATE with a typed pointer variable,
+   plus ADR and SIZE builtins. Exit 42. *)
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+TYPE P = RECORD x, y : INTEGER END;
+TYPE PP = POINTER TO P;
+VAR ExitCode : INTEGER;
+VAR p : PP;
+BEGIN
+  ALLOCATE(p, SIZE(p^));
+  p^.x := 30;
+  p^.y := 12;
+  IF ADR(p^.x) # NIL THEN
+    ExitCode := p^.x + p^.y
+  ELSE
+    ExitCode := 0
+  END;
+  DEALLOCATE(p, SIZE(p^))
+END StorageProg.

docs/summary_step5.7.md

@@ -0,0 +1,48 @@
+# V3 step 5.7 — SYSTEM facilities + Storage (done 2026-09-22)
+
+Unblocks the pointer/generic-memory layer needed by the syslib port.
+Suite 98/98. LL(1)-clean, zero gm2 warnings.
+
+## SYSTEM facilities (built-in, no import)
+
+Following V3's "built-in over module" choice (like `NEW`/`DISPOSE`),
+the SYSTEM basics are predef rather than an importable module (a
+documented divergence from ISO):
+
+- **`ADDRESS`** — new predef type, pointer-sized (`l`), class
+  `ClPtr`. Interchangeable with any `POINTER TO T` for assignment
+  and `VAR` parameters (`Assignable`/`VarParamOk` rules), and
+  `NIL`-assignable.
+- **`ADR(x)`** — address of an addressable designator (var, param,
+  or any indexed/field/deref designator); result `ADDRESS`. 230 on
+  non-addressable operands.
+- **`SIZE(x)` / `TSIZE(x)`** — full allocation footprint
+  (`SymTab.ObjectSize`: arrays `8 + count*element`, else inline
+  `TypeSize`); result INTEGER.
+
+## Storage (`stdlib/storage`)
+
+`ALLOCATE(VAR p : ADDRESS; size)`, `DEALLOCATE(VAR p : ADDRESS;
+size)` (nils `p`), `REALLOCATE(VAR p : ADDRESS; oldSize, newSize)`,
+binding libc `malloc`/`free`/`realloc` directly. Because `ADDRESS`
+is interchangeable with typed pointers, the classic idiom works:
+
+```modula-2
+TYPE PP = POINTER TO P;
+ALLOCATE(p, SIZE(p^));   (* p : PP *)
+p^.x := 30; ...
+DEALLOCATE(p, SIZE(p^))
+```
+
+## Test
+
+`StorageProg` → 42: allocates a record through a typed pointer,
+writes two fields, checks `ADR(p^.x) # NIL`, frees. Image shows
+`call $malloc(w size)` / `call $free(l addr)`.
+
+## Deferred
+
+`VAL`/`CAST` (type-operand casts), `BYTE`, and the
+`runtime/syslib` `SYSTEM`/`Trap` modules — these land with the
+step-7 syslib port, which this step now unblocks (FileIO can
+allocate its descriptors via `Storage`).

stdlib/storage.def

@@ -0,0 +1,14 @@
+DEFINITION MODULE Storage;
+(* Heap storage. ADDRESS is V3's pointer-sized opaque type (a
+   built-in, interchangeable with any POINTER TO T). *)
+
+PROCEDURE ALLOCATE(VAR p : ADDRESS; size : CARDINAL);
+(* p := a newly heap-allocated block of `size` bytes. *)
+
+PROCEDURE DEALLOCATE(VAR p : ADDRESS; size : CARDINAL);
+(* Releases p's block and sets p to NIL. *)
+
+PROCEDURE REALLOCATE(VAR p : ADDRESS; oldSize, newSize : CARDINAL);
+(* Resizes p's block to newSize bytes. *)
+
+END Storage.

stdlib/storage.mod

@@ -0,0 +1,29 @@
+IMPLEMENTATION MODULE Storage;
+(* Binds libc heap functions directly. *)
+
+PROCEDURE malloc(size : CARDINAL) : ADDRESS;
+  EXTERNAL;
+
+PROCEDURE free(p : ADDRESS);
+  EXTERNAL;
+
+PROCEDURE realloc(p : ADDRESS; size : CARDINAL) : ADDRESS;
+  EXTERNAL;
+
+PROCEDURE ALLOCATE(VAR p : ADDRESS; size : CARDINAL);
+BEGIN
+  p := malloc(size)
+END ALLOCATE;
+
+PROCEDURE DEALLOCATE(VAR p : ADDRESS; size : CARDINAL);
+BEGIN
+  free(p);
+  p := NIL
+END DEALLOCATE;
+
+PROCEDURE REALLOCATE(VAR p : ADDRESS; oldSize, newSize : CARDINAL);
+BEGIN
+  p := realloc(p, newSize)
+END REALLOCATE;
+
+END Storage.