lang: finish CLASS -- sibling method calls + init body

- Sibling calls: inside a CLASS IMPLEMENTATION a bare method name is a
  call on THIS. SymTab tracks the open implementation (implStk,
  PushImplClass/PopImplClass/CurImplClass); Design binds an otherwise
  unresolved name to the class's method and arms THIS as the receiver.
- Class BEGIN ... END init body: emitted as <Class>_init, registered
  with the module init functions and run once at startup.
- t_class promoted from a reject test to a run test; multiple parents
  stay 230 (single inheritance by design).
- tests: t_classsibling (7), t_classinit (42) -> 146/146.
- Fixpoint OK (2,313,762 bytes).

compiler/run_tests.sh

@@ -80,7 +80,9 @@ expect_run t_setrange.mod 55
 expect_run t_classmethod.mod 7
 expect_run t_classinherit.mod 7
 expect_run t_virtual.mod 3
-expect_fail t_class.mod "not supported yet"
+expect_run t_classsibling.mod 7
+expect_run t_classinit.mod 42
+expect_run t_class.mod 0
 expect_fail t_bad_parent.mod "undeclared identifier"
 expect_run showcase3.mod 183
 expect_run showcase4.mod 44

compiler/src/M2.atg

@@ -597,16 +597,16 @@ PRODUCTIONS
                                               SymTab.InvalidType THEN
                                              IF NOT SymTab.PushClassMembers(
                                                     ct) THEN
-                                               SemError(230) END
+                                               SemError(230) END;
+                                             SymTab.PushImplClass(ct)
                                            END; .)
       ";" { MethodImpl<ct> ";" }
-      [ "BEGIN"                         (. (* no receiver in a class
-                                             init body yet *)
-                                           SemError(230); .)
-        [ StatSeq ] ]
+      [ "BEGIN"                         (. QbeGen.BeginInit(cn); .)
+        [ StatSeq ]                     (. QbeGen.EndInit; .) ]
       "END"
       GetIdent<m2>                      (. IF NOT SymTab.Equal(cn, m2) THEN
                                              SemError(202) END;
+                                           SymTab.PopImplClass;
                                            SymTab.PopScope; .) .
   MethodImpl<ct: SymTab.TypeIndex>      (. VAR pn: SymTab.Name;
                                              thisQ: QbeGen.QVal;
@@ -1538,6 +1538,7 @@ PRODUCTIONS
          VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
                                         (. VAR n, fn, mal: SymTab.Name;
                                              cls: INTEGER;
+                                             ic: SymTab.TypeIndex;
                                              curT, it, eT, bt:
                                                SymTab.TypeIndex;
                                              iq, ql, qlo, qhi, qe:
@@ -1550,10 +1551,27 @@ PRODUCTIONS
                                            QbeGen.CopyOp(n, qn);
                                            sfx := FALSE;
                                            IF NOT SymTab.Lookup(n) THEN
-                                             SemError(201);
-                                             t := SymTab.InvalidType;
-                                             k := -1;
-                                             QbeGen.CopyOp("0", q)
+                                             (* a bare method name inside
+                                                a CLASS IMPLEMENTATION
+                                                is a sibling call on
+                                                THIS *)
+                                             ic := SymTab.CurImplClass();
+                                             IF (ic #
+                                                SymTab.InvalidType)
+  AND SymTab.MethodExists(ic, n) THEN
+                                               sfx := FALSE;
+                                               QbeGen.ThisBase(q);
+                                               QbeGen.ArmRecv(q);
+                                               methCls := ic;
+                                               k := SymTab.KindProc;
+                                               t := SymTab.InvalidType
+                                             ELSE
+                                               SemError(201);
+                                               t :=
+                                                 SymTab.InvalidType;
+                                               k := -1;
+                                               QbeGen.CopyOp("0", q)
+                                             END
                                            ELSE
                                              t := SymTab.SymType(n);
                                              k := SymTab.SymKind(n);

compiler/src/SymTab.def

@@ -322,6 +322,11 @@ PROCEDURE IsSubclass (sub, sup: TypeIndex): BOOLEAN;
 
 PROCEDURE VptrOffset (ct: TypeIndex): INTEGER;
 (* Byte offset of the class's vptr field (-1 when it has none). *)
+PROCEDURE PushImplClass (ct: TypeIndex);
+PROCEDURE PopImplClass;
+PROCEDURE CurImplClass (): TypeIndex;
+(* The innermost open CLASS IMPLEMENTATION's class (InvalidType none). *)
+
 PROCEDURE VtClassCount (): CARDINAL;
 PROCEDURE VtClassAt (k: CARDINAL): TypeIndex;
 (* Classes that have a vtable, in build order. *)

compiler/src/SymTab.mod

@@ -98,6 +98,10 @@ VAR
   tvptr  : ARRAY [0 .. MaxTypes - 1] OF INTEGER;  (* vptr field offset, -1 none *)
   vtl    : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;  (* classes with a vtable *)
   nVtl   : CARDINAL;
+  (* class whose CLASS IMPLEMENTATION body is currently open (nested
+     impls stack); bare method names resolve against it *)
+  implStk : ARRAY [0 .. 15] OF TypeIndex;
+  nImpl   : CARDINAL;
   tvtag : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;  (* record has variants *)
   ttag : ARRAY [0 .. MaxTypes - 1] OF FieldPtr;  (* variant CASE selector *)
   alo : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
@@ -1655,6 +1659,25 @@ PROCEDURE ClassMethodRes (t: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
   END ClassMethodRes;
 
 
+PROCEDURE PushImplClass (ct: TypeIndex);
+  BEGIN
+    IF nImpl <= HIGH(implStk) THEN
+      implStk[nImpl] := ct; INC(nImpl)
+    END
+  END PushImplClass;
+
+PROCEDURE PopImplClass;
+  BEGIN IF nImpl > 0 THEN DEC(nImpl) END
+  END PopImplClass;
+
+PROCEDURE CurImplClass (): TypeIndex;
+(* The class whose CLASS IMPLEMENTATION body is innermost open, or
+   InvalidType.  Bare method names inside a body resolve against it. *)
+  BEGIN
+    IF nImpl = 0 THEN RETURN InvalidType END;
+    RETURN implStk[nImpl - 1]
+  END CurImplClass;
+
 PROCEDURE VtClassCount (): CARDINAL;
   BEGIN RETURN nVtl END VtClassCount;
 
@@ -2753,7 +2776,7 @@ PROCEDURE Init;
     fields := NIL; nFields := 0;
     nPend := 0; nPendF := 0;
     nTypes := 0; nProc := 0; nBounds := 0; nextUid := 0;
-    vtTop := 0; nVtl := 0;
+    vtTop := 0; nVtl := 0; nImpl := 0;
     curProc := NIL; curPTail := NIL;
     nMods := 0; curMod := -1; curUnit := -1; haveProg := FALSE;
     curScope := NewScope(NIL, 0);

compiler/tests/t_classinit.mod

@@ -0,0 +1,18 @@
+MODULE TClassInit;
+(* A class's BEGIN ... END initialisation body runs once at startup.
+   Exit 42. *)
+VAR g : INTEGER;
+TYPE
+  CLASS C;
+    PROCEDURE P() : INTEGER;
+  END C;
+CLASS IMPLEMENTATION C;
+  PROCEDURE P() : INTEGER;
+  BEGIN RETURN 1 END P;
+BEGIN
+  g := 41
+END C;
+VAR ExitCode : INTEGER;
+BEGIN
+  ExitCode := g + 1
+END TClassInit.

compiler/tests/t_classsibling.mod

@@ -0,0 +1,24 @@
+MODULE TClassSibling;
+(* A method body calls a sibling method by its bare name; it is a
+   call on THIS. Exit 7. *)
+VAR ExitCode : INTEGER;
+TYPE
+  CLASS Acc;
+    total : INTEGER;
+    PROCEDURE Add(v : INTEGER);
+    PROCEDURE AddTwice(a, b : INTEGER);
+    PROCEDURE Get() : INTEGER;
+  END Acc;
+CLASS IMPLEMENTATION Acc;
+  PROCEDURE Add(v : INTEGER);
+  BEGIN total := total + v END Add;
+  PROCEDURE AddTwice(a, b : INTEGER);
+  BEGIN Add(a); Add(b) END AddTwice;         (* sibling calls *)
+  PROCEDURE Get() : INTEGER;
+  BEGIN RETURN total END Get;
+END Acc;
+VAR c : Acc;
+BEGIN
+  c.AddTwice(3, 4);
+  ExitCode := c.Get()
+END TClassSibling.

docs/OOP.txt

@@ -45,8 +45,10 @@ NOTES (V3 implementation, m2compiler-V3):
 - VIRTUAL now dispatches dynamically through per-class vtables, with
   POINTER-TO-Derived -> POINTER-TO-Base subtype assignment (see
   docs/summary_virtual-dispatch.md).
-- Still 230: a bare sibling-method call inside a method body and a
-  class BEGIN init body.
+- A bare sibling-method call inside a method body is a call on THIS;
+  a class BEGIN ... END init body runs once at startup (as
+  <Class>_init).
+- Still 230: extra parents (multiple inheritance is out of scope).
 	
 
 

docs/features.md

@@ -1,4 +1,4 @@
-# m2compiler-V3 — feature status (at `v3-showcase18`, 144/144 green)
+# m2compiler-V3 — feature status (at `v3-class-finish`, 146/146 green)
 
 Pipeline: Coco/R `M2.atg` (1748 lines, 73 productions) → `gm2`-built
 `M2` → QBE `.ssa` → `qbe` → `cc` → run. `SymTab.mod` 1623 lines,
@@ -101,12 +101,14 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   `IOChan` (streams + files; `Position`/`Seek`/`Rewind`), `Storage`.
 
 ## Not started
-- 🔄 Clarion `CLASS`: fields, methods (value/VAR formals, results),
-  single inheritance, `WITH`, a hidden `THIS` receiver, and
-  **`VIRTUAL` dynamic dispatch via vtables** (with subtype pointer
-  assignment) all work; bare sibling-method calls and a class
-  `BEGIN` init body are still 230 (see `docs/summary_class-lowering.md`,
-  `docs/summary_virtual-dispatch.md`).
+- ✅ Clarion `CLASS`: fields, methods (value/VAR formals, results),
+  single inheritance, `WITH`, a hidden `THIS` receiver, **`VIRTUAL`
+  dynamic dispatch via vtables** (with subtype pointer assignment),
+  bare sibling-method calls (a call on `THIS`), and a class
+  `BEGIN … END` init body (runs at startup). ⏸ Multiple parents
+  (deliberately single inheritance only). See
+  `docs/summary_class-lowering.md`, `docs/summary_virtual-dispatch.md`,
+  `docs/summary_class-finish.md`.
   ⏸ `VAL(LONGINT|REAL, x)` and long→int narrowing (V3 has no 64→32
   conversion; `Conversions` works around it). The TopSpeed legacy
   grammar (`TopSpeed-V3-M2.atg`) is a separate sidecar, not merged.

docs/summary_class-finish.md

@@ -0,0 +1,65 @@
+# Step: CLASS finished (sibling calls + init body)
+
+Tag `v3-class-finish`. Suite **146/146**; fixpoint **OK**
+(image **2,313,762 bytes**).
+
+Removes the last two implementable `230`s in the Clarion class area
+(the third, multiple parents, stays a deliberate limitation).
+
+## Sibling-method calls
+
+Inside a `CLASS IMPLEMENTATION` body, a **bare method name** is a call
+on `THIS`:
+
+```modula-2
+CLASS IMPLEMENTATION Acc;
+  PROCEDURE Add(v : INTEGER);       BEGIN total := total + v END Add;
+  PROCEDURE AddTwice(a, b : INTEGER);
+  BEGIN Add(a); Add(b) END AddTwice;      (* sibling calls *)
+END Acc;
+```
+
+- `SymTab` tracks the innermost open implementation (`PushImplClass`/
+  `PopImplClass`/`CurImplClass`); `ClassImplRest` pushes it.
+- `Design`: when an identifier is not found in the ordinary scopes but
+  the current implementation class has a method of that name, it binds
+  the method, arms `THIS` as the receiver (`QbeGen.ThisBase` +
+  `ArmRecv`), and marks a static (or virtual, if `VIRTUAL`) call.
+
+## Class `BEGIN … END` init body
+
+A class's initialisation body now compiles and runs **once at
+startup**, as `<Class>_init` (registered in the same list as module
+init functions, called from `main`):
+
+```modula-2
+CLASS IMPLEMENTATION C;
+  ...
+BEGIN
+  g := 41                 (* runs at startup *)
+END C;
+```
+
+A body that references instance fields has no receiver and still
+reports 230 (class statics do not exist in V3).
+
+## Multiple parents — deliberate
+
+`CLASS Multi (A, B)` (more than one parent) remains 230: the design is
+single inheritance only (`docs/OOP.txt`). `showcase5.mod` keeps that
+rejection under test.
+
+## Tests
+
+- `t_classsibling.mod` (7): sibling calls.
+- `t_classinit.mod` (42): the init body sets a global before `main`.
+- `t_class.mod` promoted from a reject test to a run test (0).
+- `showcase5.mod` still rejects (multiple parents).
+
+## Files
+
+`compiler/src/SymTab.def`/`.mod` (`implStk`, `PushImplClass`/
+`PopImplClass`/`CurImplClass`), `compiler/src/M2.atg` (`ClassImplRest`
+push/pop + init body, `Design` sibling-call branch),
+`compiler/tests/{t_classsibling,t_classinit}.mod`,
+`compiler/run_tests.sh`, `docs/{features,OOP}.txt`.