v3 step 1.1 — scope-tree + per-scope BST symbol table (6/6 tests green)

compiler/run_tests.sh

@@ -50,6 +50,7 @@ expect_run t_minimal.mod 0
 expect_run t_exit.mod 7
 expect_run t_arith.mod 25
 expect_fail t_bad_undecl.mod "undeclared identifier"
+expect_fail t_bad_dup.mod "duplicate identifier"
 expect_fail t_bad_mismatch.mod "module name mismatch"
 echo "--- $pass passed, $fail failed ---"
 [ "$fail" -eq 0 ]

compiler/src/SymTab.mod

@@ -6,8 +6,10 @@ CONST
   MaxTypes  = 256;
   MaxFields = 512;
   MaxPend   = 64;
-  MaxMarks  = 16;
+  MaxScopes = 16;
   ResDepth  = 64;
+  NoNode    = -1;
+  NoScope   = -1;
 
   (* descriptor forms *)
   FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
@@ -15,11 +17,20 @@ CONST
   FInt = 9; FReal = 10; FChar = 11; FBool = 12;
 
 TYPE
+  NodeIdx = INTEGER;  (* pool index, NoNode = none *)
+  ScopeId = INTEGER;  (* scope index, NoScope = none *)
   Symbol = RECORD
-    name : Name;
-    kind : INTEGER;
-    typ  : TypeIndex;
-    lev  : CARDINAL;
+    name  : Name;
+    kind  : INTEGER;
+    typ   : TypeIndex;
+    scope : ScopeId;
+    left  : NodeIdx;  (* BST links within the owning scope *)
+    right : NodeIdx;
+  END;
+  Scope = RECORD
+    parent : ScopeId;   (* scope tree link *)
+    root   : NodeIdx;   (* BST root of this scope's symbols *)
+    level  : CARDINAL;
   END;
   Field = RECORD
     name  : Name;
@@ -29,11 +40,11 @@ TYPE
   END;
 
 VAR
-  syms : ARRAY [0 .. MaxSyms - 1] OF Symbol;
-  nSyms : CARDINAL;
-  curLev : CARDINAL;
-  marks : ARRAY [0 .. MaxMarks - 1] OF CARDINAL;
-  mtop : CARDINAL;
+  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;
   nPend : CARDINAL;
   pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
@@ -68,6 +79,18 @@ PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
     END
   END Equal;
 
+PROCEDURE Less (a, b: ARRAY OF CHAR): BOOLEAN;
+(* Lexicographic order on NUL-terminated strings (BST key order). *)
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    LOOP
+      IF a[i] # b[i] THEN RETURN ORD(a[i]) < ORD(b[i]) END;
+      IF a[i] = 0C THEN RETURN FALSE END;
+      INC(i)
+    END
+  END Less;
+
 PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
   VAR i : CARDINAL;
   BEGIN
@@ -76,66 +99,99 @@ PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
     RETURN i
   END StrLen;
 
-(* ---------------- symbols and scopes ---------------- *)
+(* ---------------- scope tree + per-scope BST ---------------- *)
 
-PROCEDURE Find (name: ARRAY OF CHAR): INTEGER;
-(* innermost visible index or -1 *)
-  VAR i : CARDINAL;
+PROCEDURE TreeFind (root: NodeIdx; name: ARRAY OF CHAR): NodeIdx;
+(* BST search within one scope; NoNode if absent. *)
   BEGIN
-    i := nSyms;
-    WHILE i > 0 DO
-      DEC(i);
-      IF Equal(syms[i].name, name) THEN RETURN VAL(INTEGER, i) END
+    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
+      END
     END;
-    RETURN -1
+    RETURN NoNode
+  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;
+    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;
+      parent := cur;
+      IF Less(nodes[idx].name, nodes[cur].name) THEN
+        cur := nodes[cur].left; goLeft := TRUE
+      ELSE
+        cur := nodes[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)
+    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;
+  BEGIN
+    s := curScope;
+    WHILE s # NoScope DO
+      r := TreeFind(scopes[s].root, name);
+      IF r # NoNode THEN RETURN r END;
+      s := scopes[s].parent
+    END;
+    RETURN NoNode
   END Find;
 
-PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): INTEGER;
-(* index or -1 when full *)
-  BEGIN
-    IF nSyms >= MaxSyms THEN RETURN -1 END;
-    Assign(syms[nSyms].name, name);
-    syms[nSyms].kind := kind;
-    syms[nSyms].typ := InvalidType;
-    syms[nSyms].lev := curLev;
-    INC(nSyms);
-    RETURN VAL(INTEGER, nSyms - 1)
+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)
   END RawEnter;
 
-PROCEDURE DupInLevel (name: ARRAY OF CHAR): BOOLEAN;
-  VAR i : CARDINAL;
-  BEGIN
-    i := nSyms;
-    WHILE (i > 0) & (syms[i - 1].lev = curLev) DO
-      DEC(i);
-      IF Equal(syms[i].name, name) THEN RETURN TRUE END
-    END;
-    RETURN FALSE
-  END DupInLevel;
-
 PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
   BEGIN
-    IF DupInLevel(name) THEN RETURN FALSE END;
-    RETURN RawEnter(name, kind) # -1
+    RETURN RawEnter(name, kind) # NoNode
   END Enter;
 
 PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
-  VAR idx : INTEGER;
+  VAR idx: NodeIdx;
   BEGIN
-    IF DupInLevel(name) THEN RETURN FALSE END;
     idx := RawEnter(name, kind);
-    IF (idx # -1) & (nPend < MaxPend) THEN
+    IF (idx # NoNode) & (nPend < MaxPend) THEN
       pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
     END;
-    RETURN idx # -1
+    RETURN idx # NoNode
   END EnterPending;
 
 PROCEDURE FixPending (t: TypeIndex);
-  VAR i : CARDINAL;
+  VAR i: CARDINAL;
   BEGIN
     i := 0;
     WHILE i < nPend DO
-      syms[pend[i]].typ := t; INC(i)
+      nodes[pend[i]].typ := t; INC(i)
     END;
     nPend := 0
   END FixPending;
@@ -147,13 +203,13 @@ PROCEDURE PendCount (): CARDINAL;
 
 PROCEDURE PendName (i: CARDINAL; VAR n: Name);
   BEGIN
-    IF i < nPend THEN Assign(n, syms[pend[i]].name)
+    IF i < nPend THEN Assign(n, nodes[pend[i]].name)
     ELSE n[0] := 0C
     END
   END PendName;
 
 PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
-  VAR i : INTEGER;
+  VAR i: INTEGER;
   BEGIN
     IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
     IF tform[rec] # FRecord THEN RETURN -1 END;
@@ -182,7 +238,7 @@ PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
   END FieldPending;
 
 PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
-  VAR i, j : CARDINAL;
+  VAR i, j: CARDINAL;
   BEGIN
     i := 0;
     WHILE i < nPendF DO
@@ -200,45 +256,50 @@ PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
 
 PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
   BEGIN
-    RETURN Find(name) # -1
+    RETURN Find(name) # NoNode
   END Lookup;
 
 PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
-  VAR idx : INTEGER;
+  VAR idx: NodeIdx;
   BEGIN
     idx := Find(name);
-    IF idx = -1 THEN RETURN InvalidType END;
-    RETURN syms[idx].typ
+    IF idx = NoNode THEN RETURN InvalidType END;
+    RETURN nodes[idx].typ
   END SymType;
 
 PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
-  VAR idx : INTEGER;
+  VAR idx: NodeIdx;
   BEGIN
     idx := Find(name);
-    IF idx # -1 THEN syms[idx].typ := t END
+    IF idx # NoNode THEN nodes[idx].typ := t END
   END SetSymType;
 
 PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
-  VAR idx : INTEGER;
+  VAR idx: NodeIdx;
   BEGIN
     idx := Find(name);
-    IF idx = -1 THEN RETURN -1 END;
-    RETURN syms[idx].kind
+    IF idx = NoNode THEN RETURN -1 END;
+    RETURN nodes[idx].kind
   END SymKind;
 
 PROCEDURE PushScope;
   BEGIN
-    IF mtop < MaxMarks THEN marks[mtop] := nSyms; INC(mtop) END;
-    INC(curLev)
+    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
   END PushScope;
 
 PROCEDURE PopScope;
   BEGIN
-    IF mtop > 0 THEN DEC(mtop); nSyms := marks[mtop] END;
-    IF curLev > 0 THEN DEC(curLev) END
+    (* Nodes stay in the pool but become unreachable via the chain. *)
+    IF curScope # 0 THEN curScope := scopes[curScope].parent END
   END PopScope;
 
-(* ---------------- type descriptors ---------------- *)
+(* ---------------- type descriptors (unchanged) ---------------- *)
 
 PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
   BEGIN
@@ -297,7 +358,7 @@ PROCEDURE SetTarget (t, base: TypeIndex);
   END SetTarget;
 
 PROCEDURE Resolve (t: TypeIndex): TypeIndex;
-  VAR n : CARDINAL;
+  VAR n: CARDINAL;
   BEGIN
     n := 0;
     WHILE (n < ResDepth) & (t >= 0) & (t < VAL(INTEGER, nTypes))
@@ -320,7 +381,7 @@ PROCEDURE BoolType (): TypeIndex;
   BEGIN RETURN dBool END BoolType;
 
 PROCEDURE ClassOf (t: TypeIndex): INTEGER;
-  VAR r : TypeIndex;
+  VAR r: TypeIndex;
   BEGIN
     r := Resolve(t);
     IF r = InvalidType THEN RETURN ClInvalid END;
@@ -357,7 +418,7 @@ PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
   END FieldExists;
 
 PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
-  VAR i : INTEGER;
+  VAR i: INTEGER;
   BEGIN
     i := FindField(Resolve(rec), name);
     IF i = -1 THEN RETURN InvalidType END;
@@ -365,7 +426,7 @@ PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
   END FieldType;
 
 PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
-  VAR r : TypeIndex;
+  VAR r: TypeIndex;
   BEGIN
     r := Resolve(t);
     IF (r = InvalidType) OR (tform[r] # FArray) THEN
@@ -375,7 +436,7 @@ PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
   END ArrayElem;
 
 PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
-  VAR r : TypeIndex;
+  VAR r: TypeIndex;
   BEGIN
     r := Resolve(t);
     IF (r = InvalidType) OR (tform[r] # FPtr) THEN
@@ -386,7 +447,7 @@ 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, i: INTEGER;
   BEGIN
     r := Resolve(t);
     IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
@@ -401,7 +462,7 @@ PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
     RETURN TRUE
   END PushRecord;
 
-(* ---------------- predicates ---------------- *)
+(* ---------------- predicates (unchanged) ---------------- *)
 
 PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
 (* base compatibility for two SET types *)
@@ -415,7 +476,7 @@ PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
   END SetBasesOk;
 
 PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
-  VAR rs, rd : TypeIndex;
+  VAR rs, rd: TypeIndex;
   BEGIN
     IF (src = InvalidType) OR (dst = InvalidType) THEN RETURN TRUE END;
     rs := Resolve(src); rd := Resolve(dst);
@@ -466,7 +527,7 @@ PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
   END BoolCheck;
 
 PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
-  VAR rl, rr : TypeIndex;
+  VAR rl, rr: TypeIndex;
   BEGIN
     IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
     IF SameType(l, r) THEN RETURN TRUE END;
@@ -506,7 +567,7 @@ PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
   END OrdCheck;
 
 PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
-  VAR rs, b : TypeIndex;
+  VAR rs, b: TypeIndex;
   BEGIN
     IF (l = InvalidType) OR (set = InvalidType) THEN RETURN TRUE END;
     rs := Resolve(set);
@@ -541,7 +602,7 @@ PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
   END SetElemCheck;
 
 PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
-  VAR e : TypeIndex;
+  VAR e: TypeIndex;
   BEGIN
     e := Resolve(elem);
     IF e = InvalidType THEN e := dInt END;
@@ -557,7 +618,10 @@ PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
 
 PROCEDURE Init;
   BEGIN
-    nSyms := 0; curLev := 0; mtop := 0;
+    nNodes := 0; nScopes := 1; curScope := 0;
+    scopes[0].parent := NoScope;
+    scopes[0].root := NoNode;
+    scopes[0].level := 0;
     nPend := 0; nPendF := 0;
     nTypes := 0; nFields := 0;
     dInt := NewDesc(FInt, InvalidType);
@@ -594,22 +658,30 @@ PROCEDURE WriteKind (kind: INTEGER);
     END
   END WriteKind;
 
+PROCEDURE WriteNode (idx: NodeIdx);
+  BEGIN
+    IF idx = NoNode THEN RETURN END;
+    WriteNode(nodes[idx].left);
+    FileIO.WriteString(FileIO.StdOut, "  ");
+    FileIO.WriteString(FileIO.StdOut, nodes[idx].name);
+    FileIO.WriteString(FileIO.StdOut, " : ");
+    WriteKind(nodes[idx].kind);
+    FileIO.WriteString(FileIO.StdOut, " #");
+    FileIO.WriteInt(FileIO.StdOut, nodes[idx].typ, 1);
+    FileIO.WriteLn(FileIO.StdOut);
+    WriteNode(nodes[idx].right)
+  END WriteNode;
+
 PROCEDURE PrintTable;
-  VAR i : CARDINAL;
+  VAR s: CARDINAL;
   BEGIN
     FileIO.WriteLn(FileIO.StdOut);
     FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
     FileIO.WriteLn(FileIO.StdOut);
-    i := 0;
-    WHILE i < nSyms DO
-      FileIO.WriteString(FileIO.StdOut, "  ");
-      FileIO.WriteString(FileIO.StdOut, syms[i].name);
-      FileIO.WriteString(FileIO.StdOut, " : ");
-      WriteKind(syms[i].kind);
-      FileIO.WriteString(FileIO.StdOut, " #");
-      FileIO.WriteInt(FileIO.StdOut, syms[i].typ, 1);
-      FileIO.WriteLn(FileIO.StdOut);
-      INC(i)
+    s := 0;
+    WHILE s < nScopes DO
+      WriteNode(scopes[s].root);
+      INC(s)
     END
   END PrintTable;
 

compiler/tests/t_bad_dup.mod

@@ -0,0 +1,5 @@
+MODULE TBadDup;
+VAR ExitCode, ExitCode : INTEGER;
+BEGIN
+  ExitCode := 1
+END TBadDup.