v3 step 1.2 — dynamic heap-allocated symbol storage (6/6 tests green)

compiler/src/SymTab.def

@@ -16,7 +16,6 @@ DEFINITION MODULE SymTab;
      "integer family"; mixed INTEGER/REAL arithmetic is rejected *)
 
 CONST
-  MaxSyms = 256;
   InvalidType = -1;
 
   (* symbol kinds *)

compiler/src/SymTab.mod

@@ -1,15 +1,13 @@
 IMPLEMENTATION MODULE SymTab;
 
 IMPORT FileIO;
+FROM Storage IMPORT ALLOCATE;
+FROM SYSTEM IMPORT TSIZE;
 
 CONST
   MaxTypes  = 256;
-  MaxFields = 512;
   MaxPend   = 64;
-  MaxScopes = 16;
   ResDepth  = 64;
-  NoNode    = -1;
-  NoScope   = -1;
 
   (* descriptor forms *)
   FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
@@ -17,43 +15,43 @@ CONST
   FInt = 9; FReal = 10; FChar = 11; FBool = 12;
 
 TYPE
-  NodeIdx = INTEGER;  (* pool index, NoNode = none *)
-  ScopeId = INTEGER;  (* scope index, NoScope = none *)
-  Symbol = RECORD
+  SymPtr = POINTER TO SymNode;
+  ScopePtr = POINTER TO ScopeNode;
+  FieldPtr = POINTER TO FieldNode;
+  SymNode = RECORD
     name  : Name;
     kind  : INTEGER;
     typ   : TypeIndex;
-    scope : ScopeId;
-    left  : NodeIdx;  (* BST links within the owning scope *)
-    right : NodeIdx;
+    scope : ScopePtr;   (* owning scope *)
+    left  : SymPtr;     (* BST links within the owning scope *)
+    right : SymPtr;
   END;
-  Scope = RECORD
-    parent : ScopeId;   (* scope tree link *)
-    root   : NodeIdx;   (* BST root of this scope's symbols *)
+  ScopeNode = RECORD
+    parent : ScopePtr;  (* scope tree link *)
+    root   : SymPtr;    (* BST root of this scope's symbols *)
     level  : CARDINAL;
+    link   : ScopePtr;  (* creation-order chain for PrintTable *)
   END;
-  Field = RECORD
+  FieldNode = RECORD
     name  : Name;
     typ   : TypeIndex;
     owner : TypeIndex;
-    next  : INTEGER;  (* index of next field of same owner, -1 = end *)
+    next  : FieldPtr;   (* next field of the same owner *)
   END;
 
 VAR
-  nodes : ARRAY [0 .. MaxSyms - 1] OF Symbol;
-  nNodes : CARDINAL;
-  scopes : ARRAY [0 .. MaxScopes - 1] OF Scope;
-  nScopes : CARDINAL;
-  curScope : ScopeId;
-  pend : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  curScope : ScopePtr;
+  scopeList : ScopePtr;  (* all scopes, creation order *)
+  scopeTail : ScopePtr;
+  fields : FieldPtr;     (* all record fields, newest first *)
+  nFields : CARDINAL;
+  pend : ARRAY [0 .. MaxPend - 1] OF SymPtr;
   nPend : CARDINAL;
-  pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  pendF : ARRAY [0 .. MaxPend - 1] OF FieldPtr;
   nPendF : CARDINAL;
   tform : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
   tref : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
   nTypes : CARDINAL;
-  fields : ARRAY [0 .. MaxFields - 1] OF Field;
-  nFields : CARDINAL;
   dInt, dCard, dReal, dChar, dBool : TypeIndex;
 
 (* ---------------- strings ---------------- *)
@@ -101,89 +99,100 @@ PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
 
 (* ---------------- scope tree + per-scope BST ---------------- *)
 
-PROCEDURE TreeFind (root: NodeIdx; name: ARRAY OF CHAR): NodeIdx;
-(* BST search within one scope; NoNode if absent. *)
-  BEGIN
-    WHILE root # NoNode DO
-      IF Equal(nodes[root].name, name) THEN RETURN root END;
-      IF Less(name, nodes[root].name) THEN root := nodes[root].left
-      ELSE root := nodes[root].right
+PROCEDURE NewScope (parent: ScopePtr; level: CARDINAL): ScopePtr;
+(* Heap-allocates a scope and appends it to the creation chain. *)
+  VAR s: ScopePtr;
+  BEGIN
+    ALLOCATE(s, TSIZE(ScopeNode));
+    s^.parent := parent;
+    s^.root := NIL;
+    s^.level := level;
+    s^.link := NIL;
+    IF scopeList = NIL THEN scopeList := s ELSE scopeTail^.link := s END;
+    scopeTail := s;
+    RETURN s
+  END NewScope;
+
+PROCEDURE TreeFind (root: SymPtr; name: ARRAY OF CHAR): SymPtr;
+(* BST search within one scope; NIL if absent. *)
+  BEGIN
+    WHILE root # NIL DO
+      IF Equal(root^.name, name) THEN RETURN root END;
+      IF Less(name, root^.name) THEN root := root^.left
+      ELSE root := root^.right
       END
     END;
-    RETURN NoNode
+    RETURN NIL
   END TreeFind;
 
-PROCEDURE TreeInsert (s: ScopeId; idx: CARDINAL): BOOLEAN;
-(* BST insert of pool node idx into scope s; FALSE on duplicate
-   (node left unlinked; caller releases it). *)
-  VAR cur, parent: NodeIdx;
+PROCEDURE TreeInsert (s: ScopePtr; node: SymPtr): BOOLEAN;
+(* BST insert of node into scope s; FALSE on duplicate. *)
+  VAR cur, parent: SymPtr;
     goLeft: BOOLEAN;
   BEGIN
-    cur := scopes[s].root; parent := NoNode; goLeft := FALSE;
-    WHILE cur # NoNode DO
-      IF Equal(nodes[cur].name, nodes[idx].name) THEN RETURN FALSE END;
+    cur := s^.root; parent := NIL; goLeft := FALSE;
+    WHILE cur # NIL DO
+      IF Equal(cur^.name, node^.name) THEN RETURN FALSE END;
       parent := cur;
-      IF Less(nodes[idx].name, nodes[cur].name) THEN
-        cur := nodes[cur].left; goLeft := TRUE
+      IF Less(node^.name, cur^.name) THEN
+        cur := cur^.left; goLeft := TRUE
       ELSE
-        cur := nodes[cur].right; goLeft := FALSE
+        cur := cur^.right; goLeft := FALSE
       END
     END;
-    nodes[idx].left := NoNode;
-    nodes[idx].right := NoNode;
-    nodes[idx].scope := s;
-    IF parent = NoNode THEN scopes[s].root := VAL(INTEGER, idx)
-    ELSIF goLeft THEN nodes[parent].left := VAL(INTEGER, idx)
-    ELSE nodes[parent].right := VAL(INTEGER, idx)
+    node^.left := NIL;
+    node^.right := NIL;
+    node^.scope := s;
+    IF parent = NIL THEN s^.root := node
+    ELSIF goLeft THEN parent^.left := node
+    ELSE parent^.right := node
     END;
     RETURN TRUE
   END TreeInsert;
 
-PROCEDURE Find (name: ARRAY OF CHAR): NodeIdx;
-(* Innermost visible node or NoNode; walks the scope chain up. *)
-  VAR s: ScopeId;
-    r: NodeIdx;
+PROCEDURE Find (name: ARRAY OF CHAR): SymPtr;
+(* Innermost visible node or NIL; walks the scope chain up. *)
+  VAR s: ScopePtr;
+    r: SymPtr;
   BEGIN
     s := curScope;
-    WHILE s # NoScope DO
-      r := TreeFind(scopes[s].root, name);
-      IF r # NoNode THEN RETURN r END;
-      s := scopes[s].parent
+    WHILE s # NIL DO
+      r := TreeFind(s^.root, name);
+      IF r # NIL THEN RETURN r END;
+      s := s^.parent
     END;
-    RETURN NoNode
+    RETURN NIL
   END Find;
 
-PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): NodeIdx;
-(* Allocates a pool node and links it into the current scope's BST;
-   NoNode when the pool is full or the name is a duplicate here. *)
-  VAR idx: CARDINAL;
-  BEGIN
-    IF nNodes >= MaxSyms THEN RETURN NoNode END;
-    idx := nNodes;
-    Assign(nodes[idx].name, name);
-    nodes[idx].kind := kind;
-    nodes[idx].typ := InvalidType;
-    nodes[idx].scope := curScope;
-    nodes[idx].left := NoNode;
-    nodes[idx].right := NoNode;
-    IF ~TreeInsert(curScope, idx) THEN RETURN NoNode END;
-    INC(nNodes);
-    RETURN VAL(INTEGER, idx)
+PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): SymPtr;
+(* Heap-allocates a symbol and links it into the current scope's
+   BST; NIL on duplicate (node released to nobody: dropped). *)
+  VAR node: SymPtr;
+  BEGIN
+    ALLOCATE(node, TSIZE(SymNode));
+    Assign(node^.name, name);
+    node^.kind := kind;
+    node^.typ := InvalidType;
+    node^.scope := curScope;
+    node^.left := NIL;
+    node^.right := NIL;
+    IF ~TreeInsert(curScope, node) THEN RETURN NIL END;
+    RETURN node
   END RawEnter;
 
 PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
   BEGIN
-    RETURN RawEnter(name, kind) # NoNode
+    RETURN RawEnter(name, kind) # NIL
   END Enter;
 
 PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
-  VAR idx: NodeIdx;
+  VAR node: SymPtr;
   BEGIN
-    idx := RawEnter(name, kind);
-    IF (idx # NoNode) & (nPend < MaxPend) THEN
-      pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
+    node := RawEnter(name, kind);
+    IF (node # NIL) & (nPend < MaxPend) THEN
+      pend[nPend] := node; INC(nPend)
     END;
-    RETURN idx # NoNode
+    RETURN node # NIL
   END EnterPending;
 
 PROCEDURE FixPending (t: TypeIndex);
@@ -191,7 +200,7 @@ PROCEDURE FixPending (t: TypeIndex);
   BEGIN
     i := 0;
     WHILE i < nPend DO
-      nodes[pend[i]].typ := t; INC(i)
+      pend[i]^.typ := t; INC(i)
     END;
     nPend := 0
   END FixPending;
@@ -203,35 +212,36 @@ PROCEDURE PendCount (): CARDINAL;
 
 PROCEDURE PendName (i: CARDINAL; VAR n: Name);
   BEGIN
-    IF i < nPend THEN Assign(n, nodes[pend[i]].name)
+    IF i < nPend THEN Assign(n, pend[i]^.name)
     ELSE n[0] := 0C
     END
   END PendName;
 
-PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
-  VAR i: INTEGER;
+PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): FieldPtr;
+  VAR f: FieldPtr;
   BEGIN
-    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
-    IF tform[rec] # FRecord THEN RETURN -1 END;
-    i := tref[rec];
-    WHILE i # -1 DO
-      IF Equal(fields[i].name, name) THEN RETURN i END;
-      i := fields[i].next
+    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN NIL END;
+    IF tform[rec] # FRecord THEN RETURN NIL END;
+    f := fields;
+    WHILE f # NIL DO
+      IF (f^.owner = rec) & Equal(f^.name, name) THEN RETURN f END;
+      f := f^.next
     END;
-    RETURN -1
+    RETURN NIL
   END FindField;
 
 PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
-  BEGIN
-    IF FindField(rec, name) # -1 THEN RETURN FALSE END;
-    IF nFields >= MaxFields THEN RETURN FALSE END;
-    Assign(fields[nFields].name, name);
-    fields[nFields].typ := InvalidType;
-    fields[nFields].owner := rec;
-    fields[nFields].next := tref[rec];
-    tref[rec] := VAL(INTEGER, nFields);
+  VAR f: FieldPtr;
+  BEGIN
+    IF FindField(rec, name) # NIL THEN RETURN FALSE END;
+    ALLOCATE(f, TSIZE(FieldNode));
+    Assign(f^.name, name);
+    f^.typ := InvalidType;
+    f^.owner := rec;
+    f^.next := fields;
+    fields := f;
     IF nPendF < MaxPend THEN
-      pendF[nPendF] := nFields; INC(nPendF)
+      pendF[nPendF] := f; INC(nPendF)
     END;
     INC(nFields);
     RETURN TRUE
@@ -242,8 +252,8 @@ PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
   BEGIN
     i := 0;
     WHILE i < nPendF DO
-      IF fields[pendF[i]].owner = rec THEN
-        fields[pendF[i]].typ := t;
+      IF pendF[i]^.owner = rec THEN
+        pendF[i]^.typ := t;
         (* remove by swap with last *)
         j := nPendF - 1;
         pendF[i] := pendF[j];
@@ -256,47 +266,41 @@ PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
 
 PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
   BEGIN
-    RETURN Find(name) # NoNode
+    RETURN Find(name) # NIL
   END Lookup;
 
 PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
-  VAR idx: NodeIdx;
+  VAR node: SymPtr;
   BEGIN
-    idx := Find(name);
-    IF idx = NoNode THEN RETURN InvalidType END;
-    RETURN nodes[idx].typ
+    node := Find(name);
+    IF node = NIL THEN RETURN InvalidType END;
+    RETURN node^.typ
   END SymType;
 
 PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
-  VAR idx: NodeIdx;
+  VAR node: SymPtr;
   BEGIN
-    idx := Find(name);
-    IF idx # NoNode THEN nodes[idx].typ := t END
+    node := Find(name);
+    IF node # NIL THEN node^.typ := t END
   END SetSymType;
 
 PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
-  VAR idx: NodeIdx;
+  VAR node: SymPtr;
   BEGIN
-    idx := Find(name);
-    IF idx = NoNode THEN RETURN -1 END;
-    RETURN nodes[idx].kind
+    node := Find(name);
+    IF node = NIL THEN RETURN -1 END;
+    RETURN node^.kind
   END SymKind;
 
 PROCEDURE PushScope;
   BEGIN
-    IF nScopes < MaxScopes THEN
-      scopes[nScopes].parent := curScope;
-      scopes[nScopes].root := NoNode;
-      scopes[nScopes].level := scopes[curScope].level + 1;
-      curScope := VAL(INTEGER, nScopes);
-      INC(nScopes)
-    END
+    curScope := NewScope(curScope, curScope^.level + 1)
   END PushScope;
 
 PROCEDURE PopScope;
   BEGIN
-    (* Nodes stay in the pool but become unreachable via the chain. *)
-    IF curScope # 0 THEN curScope := scopes[curScope].parent END
+    (* Nodes stay allocated but become unreachable via the chain. *)
+    IF curScope^.parent # NIL THEN curScope := curScope^.parent END
   END PopScope;
 
 (* ---------------- type descriptors (unchanged) ---------------- *)
@@ -414,15 +418,15 @@ PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
 
 PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
   BEGIN
-    RETURN FindField(Resolve(rec), name) # -1
+    RETURN FindField(Resolve(rec), name) # NIL
   END FieldExists;
 
 PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
-  VAR i: INTEGER;
+  VAR f: FieldPtr;
   BEGIN
-    i := FindField(Resolve(rec), name);
-    IF i = -1 THEN RETURN InvalidType END;
-    RETURN fields[i].typ
+    f := FindField(Resolve(rec), name);
+    IF f = NIL THEN RETURN InvalidType END;
+    RETURN f^.typ
   END FieldType;
 
 PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
@@ -447,17 +451,20 @@ PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
 
 PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
 (* Pushes a scope with t's fields; caller must PopScope afterwards. *)
-  VAR r, i: INTEGER;
+  VAR r: TypeIndex;
+    f: FieldPtr;
   BEGIN
     r := Resolve(t);
     IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
     PushScope;
-    i := tref[r];
-    WHILE i # -1 DO
-      IF Enter(fields[i].name, KindField) THEN
-        SetSymType(fields[i].name, fields[i].typ)
+    f := fields;
+    WHILE f # NIL DO
+      IF f^.owner = r THEN
+        IF Enter(f^.name, KindField) THEN
+          SetSymType(f^.name, f^.typ)
+        END
       END;
-      i := fields[i].next
+      f := f^.next
     END;
     RETURN TRUE
   END PushRecord;
@@ -618,12 +625,11 @@ PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
 
 PROCEDURE Init;
   BEGIN
-    nNodes := 0; nScopes := 1; curScope := 0;
-    scopes[0].parent := NoScope;
-    scopes[0].root := NoNode;
-    scopes[0].level := 0;
+    scopeList := NIL; scopeTail := NIL;
+    fields := NIL; nFields := 0;
     nPend := 0; nPendF := 0;
-    nTypes := 0; nFields := 0;
+    nTypes := 0;
+    curScope := NewScope(NIL, 0);
     dInt := NewDesc(FInt, InvalidType);
     dCard := NewDesc(FInt, InvalidType);
     dReal := NewDesc(FReal, InvalidType);
@@ -658,30 +664,30 @@ PROCEDURE WriteKind (kind: INTEGER);
     END
   END WriteKind;
 
-PROCEDURE WriteNode (idx: NodeIdx);
+PROCEDURE WriteNode (node: SymPtr);
   BEGIN
-    IF idx = NoNode THEN RETURN END;
-    WriteNode(nodes[idx].left);
+    IF node = NIL THEN RETURN END;
+    WriteNode(node^.left);
     FileIO.WriteString(FileIO.StdOut, "  ");
-    FileIO.WriteString(FileIO.StdOut, nodes[idx].name);
+    FileIO.WriteString(FileIO.StdOut, node^.name);
     FileIO.WriteString(FileIO.StdOut, " : ");
-    WriteKind(nodes[idx].kind);
+    WriteKind(node^.kind);
     FileIO.WriteString(FileIO.StdOut, " #");
-    FileIO.WriteInt(FileIO.StdOut, nodes[idx].typ, 1);
+    FileIO.WriteInt(FileIO.StdOut, node^.typ, 1);
     FileIO.WriteLn(FileIO.StdOut);
-    WriteNode(nodes[idx].right)
+    WriteNode(node^.right)
   END WriteNode;
 
 PROCEDURE PrintTable;
-  VAR s: CARDINAL;
+  VAR s: ScopePtr;
   BEGIN
     FileIO.WriteLn(FileIO.StdOut);
     FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
     FileIO.WriteLn(FileIO.StdOut);
-    s := 0;
-    WHILE s < nScopes DO
-      WriteNode(scopes[s].root);
-      INC(s)
+    s := scopeList;
+    WHILE s # NIL DO
+      WriteNode(s^.root);
+      s := s^.link
     END
   END PrintTable;
 

docs/summary_step1.2.md

@@ -0,0 +1,38 @@
+# V3 step 1.2 — dynamic symbol storage (done 2026-09-19)
+
+Follow-up to step 1.1 (scope tree + per-scope BST): the fixed-size
+pools are gone, replaced by `Storage`-allocated linked structures.
+`SymTab.def` unchanged apart from dropping the now-meaningless
+`MaxSyms`; `M2.atg` untouched; suite stays 6/6.
+
+## What changed (`compiler/src/SymTab.mod` only)
+
+- Symbols: heap nodes (`SymPtr`, `ALLOCATE` + `TSIZE`) linked as a
+  BST per scope instead of `nodes[0..255]`. No capacity limit;
+  `Enter` fails only on duplicates.
+- Scopes: heap nodes (`ScopePtr`) forming the scope tree, plus a
+  creation-order `link` chain so `PrintTable` still dumps every
+  scope (in-order per scope, alphabetical).
+- Record fields: heap list (`FieldPtr`, filtered by `owner`) instead
+  of `fields[0..511]`.
+- Kept bounded on purpose: `pend[]/pendF[]` (transient, per single
+  declaration, max 64) and type descriptors (`tform[]/tref[]` —
+  `TypeIndex` is an INTEGER woven through the grammar, so
+  descriptors stay indexed for now).
+- Nothing is ever freed: one compilation per process, the whole
+  table is discarded at the next `Init`. `DEALLOCATE` intentionally
+  unused (single-pass compiler, no steady-state growth).
+
+## Verification
+
+Rebuilt clean (LL(1)-clean, no gm2 warnings introduced), 6/6 green:
+insert/find/dup-detection all exercised (`t_bad_dup` → 200,
+`t_bad_undecl` → 201, 3 run tests byte-identical `.ssa` — the
+backend is untouched).
+
+## Note for step 7 (syslib port)
+
+`FROM Storage IMPORT ALLOCATE` is now the only gm2-hosted import in
+`SymTab` (plus `SYSTEM.TSIZE`, directly lowered later). The port
+swaps it for the self-hosted `Storage` without touching the tree
+logic — one reason the pool removal happened before the port.