lower L6: classes (methods, fields, sibling calls, inheritance)

- Class declarations (op=0) emit nothing but replay each method heading
  via BeginFunc/FuncParam/AbortFunc so the backend temp counters advance
  exactly as the legacy parse did.
- Class implementations (op=1) emit each method (hidden THIS receiver,
  then declared formals) with THIS pushed as the WITH base so bare field
  names resolve; class BEGIN bodies emit <class>_init.
- Method calls: obj.Method binds the receiver (ArmRecv) and dispatches
  through VirtCallBegin (virtual) or CallBegin; bare sibling method names
  inside an implementation call THIS (curImplCls).
- CanType accepts ClClass; methods are gated by CanMethod/CanMethods with
  the class pushed as the WITH base.

lower_ok t_classmethod / t_classinherit / t_classsibling byte-match.
Suite 197/197; FIXPOINT OK (stage2 == stage3, 3,375,374 bytes).

compiler/run_tests.sh

@@ -472,6 +472,9 @@ lower_ok t_lower1.mod
 lower_ok t_lower2.mod
 lower_ok t_lower3.mod
 lower_ok t_nestedmod.mod
+lower_ok t_classmethod.mod
+lower_ok t_classinherit.mod
+lower_ok t_classsibling.mod
 lower_ok t_lower4.mod
 lower_ok t_lower4case.mod
 lower_ok t_lower4with.mod

compiler/src/Lower.mod

@@ -34,6 +34,8 @@ VAR
   nProcs   : CARDINAL;
   withRec  : ARRAY [0 .. 15] OF SymTab.TypeIndex;
   withTop  : CARDINAL;
+  curMethCls : SymTab.TypeIndex;   (* class bound by the last obj.Method *)
+  curImplCls : SymTab.TypeIndex;   (* class whose implementation is open *)
 
 PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
   VAR i: CARDINAL;
@@ -300,7 +302,7 @@ PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN;
         OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal)
         OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray)
         OR (cls = SymTab.ClSet) OR (cls = SymTab.ClRecord)
-        OR (cls = SymTab.ClPtr)
+        OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClClass)
   END CanType;
 
 PROCEDURE CanWithField (nm: ARRAY OF CHAR; VAR t: SymTab.TypeIndex): BOOLEAN;
@@ -351,8 +353,13 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
     IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
     Name(AST.Child(n, 0), nm);
     IF NOT Resolve(nm, k, t) THEN
-      IF NOT CanWithField(nm, t) THEN RETURN FALSE END;
-      k := SymTab.KindField
+      IF CanWithField(nm, t) THEN
+        k := SymTab.KindField
+      ELSIF (curImplCls # SymTab.InvalidType)
+         AND SymTab.MethodExists(curImplCls, nm) THEN
+        k := SymTab.KindProc
+      ELSE RETURN FALSE
+      END
     END;
     IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
        AND (k # SymTab.KindConst) AND (k # SymTab.KindField) THEN
@@ -388,6 +395,42 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
     RETURN TRUE
   END CanDesign;
 
+PROCEDURE IsMethodCall (n: AST.Node): BOOLEAN;
+(* n is a call whose callee is `obj.Method` on a class receiver. *)
+  VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
+  BEGIN
+    IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END;
+    d := AST.Child(n, 0);
+    IF AST.Kind(d) # AST.NkDesignator THEN RETURN FALSE END;
+    IF AST.NChild(d) = 1 THEN
+      (* bare name: a sibling method inside a class implementation? *)
+      Name(AST.Child(d, 0), nm);
+      RETURN (curImplCls # SymTab.InvalidType)
+             AND SymTab.MethodExists(curImplCls, nm)
+    END;
+    IF AST.NChild(d) < 2 THEN RETURN FALSE END;
+    sel := AST.Child(d, AST.NChild(d) - 1);
+    IF AST.Op(sel) # AST.SelField THEN RETURN FALSE END;
+    Name(AST.Child(d, 0), nm);
+    IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
+    IF t = SymTab.InvalidType THEN RETURN FALSE END;
+    IF SymTab.ClassOf(t) # SymTab.ClClass THEN RETURN FALSE END;
+    Name(AST.Child(sel, 0), fn);
+    RETURN SymTab.MethodExists(t, fn)
+  END IsMethodCall;
+
+PROCEDURE CanMethodCall (n: AST.Node): BOOLEAN;
+  VAR i: CARDINAL;
+  BEGIN
+    IF NOT IsMethodCall(n) THEN RETURN FALSE END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END CanMethodCall;
+
 PROCEDURE CanBuiltin (n: AST.Node): BOOLEAN;
   VAR i: CARDINAL;
   BEGIN
@@ -429,6 +472,7 @@ PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
     END;
     IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END;
     IF AST.Kind(n) = AST.NkCall THEN
+      IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END;
       CalleeName(n, nm);
       IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
       RETURN IsCall(n) AND CanCallArgs(n)
@@ -531,6 +575,7 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
       RETURN CanExpr(AST.Child(n, 0))
     END;
     IF k = AST.NkCall THEN
+      IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END;
       CalleeName(n, nm);
       IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
       RETURN IsCall(n) AND CanCallArgs(n)
@@ -538,9 +583,66 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
     RETURN FALSE
   END CanStmt;
 
+PROCEDURE CanMethod (m: AST.Node; ct: SymTab.TypeIndex): BOOLEAN;
+  VAR nm: SymTab.Name; uid, depth, np: CARDINAL; res, t: SymTab.TypeIndex;
+      ext, isV: BOOLEAN; pn: SymTab.Name; i: CARDINAL; ok: BOOLEAN;
+      save: CARDINAL; saveCls: SymTab.TypeIndex;
+  BEGIN
+    IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN FALSE END;
+    Name(AST.Child(m, 0), nm);
+    IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END;
+    IF (res # SymTab.InvalidType) AND NOT CanType(res) THEN RETURN FALSE END;
+    i := 0;
+    WHILE i < np DO
+      IF NOT ParamInfo(nm, i, t, isV, pn) THEN RETURN FALSE END;
+      IF NOT CanType(t) THEN RETURN FALSE END;
+      INC(i)
+    END;
+    save := withTop;
+    saveCls := curImplCls;
+    curImplCls := ct;
+    IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
+    ok := CanDecls(AST.Child(m, 2)) AND CanStmt(AST.Child(m, 1));
+    withTop := save;
+    curImplCls := saveCls;
+    RETURN ok
+  END CanMethod;
+
+PROCEDURE CanMethods (seq: AST.Node; ct: SymTab.TypeIndex): BOOLEAN;
+  VAR i: CARDINAL; m: AST.Node;
+  BEGIN
+    IF seq = AST.NoNode THEN RETURN TRUE END;
+    i := 0;
+    WHILE i < AST.NChild(seq) DO
+      m := AST.Child(seq, i);
+      IF i = AST.MaxChild - 1 THEN
+        IF NOT CanMethods(m, ct) THEN RETURN FALSE END
+      ELSIF AST.Kind(m) = AST.NkFieldDecl THEN
+        IF NOT CanMethods(m, ct) THEN RETURN FALSE END
+      ELSIF AST.Kind(m) = AST.NkProcDecl THEN
+        IF NOT CanMethod(m, ct) THEN RETURN FALSE END
+      END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END CanMethods;
+
 PROCEDURE CanDecl (c: AST.Node): BOOLEAN;
-  VAR i: CARDINAL;
+  VAR i: CARDINAL; nm: SymTab.Name; k: INTEGER; ct: SymTab.TypeIndex;
   BEGIN
+    IF AST.Kind(c) = AST.NkClassDecl THEN
+      IF AST.Op(c) = 1 THEN
+        Name(AST.Child(c, 0), nm);
+        IF NOT Resolve(nm, k, ct) THEN RETURN FALSE END;
+        IF SymTab.ClassOf(ct) # SymTab.ClClass THEN RETURN FALSE END;
+        IF NOT CanMethods(AST.Child(c, 3), ct) THEN RETURN FALSE END;
+        IF AST.Child(c, 2) # AST.NoNode THEN
+          IF NOT CanStmt(AST.Child(c, 2)) THEN RETURN FALSE END
+        END;
+        RETURN TRUE
+      END;
+      RETURN TRUE
+    END;
     IF AST.Kind(c) = AST.NkUnit THEN
       IF AST.Child(c, 3) # AST.NoNode THEN RETURN FALSE END;
       RETURN CanDecls(AST.Child(c, 1)) AND CanStmt(AST.Child(c, 2))
@@ -585,6 +687,7 @@ PROCEDURE CanDecls (seq: AST.Node): BOOLEAN;
 PROCEDURE CanLower (unit: AST.Node): BOOLEAN;
   BEGIN
     withTop := 0;
+    curImplCls := SymTab.InvalidType;
     IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END;
     IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END;
     IF AST.Child(unit, 3) # AST.NoNode THEN RETURN FALSE END;
@@ -637,10 +740,18 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
     QbeGen.CopyOp(nm, qn);
     sfx := FALSE;
     IF NOT Resolve(nm, k, t) THEN
-      IF NOT WithField(nm, k, t, q) THEN
+      IF WithField(nm, k, t, q) THEN
+        sfx := TRUE
+      ELSIF (curImplCls # SymTab.InvalidType)
+         AND SymTab.MethodExists(curImplCls, nm) THEN
+        (* bare sibling method name inside a class implementation *)
+        QbeGen.ThisBase(q);
+        QbeGen.ArmRecv(q);
+        curMethCls := curImplCls; k := SymTab.KindProc;
+        t := SymTab.InvalidType; sfx := FALSE
+      ELSE
         t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
-      END;
-      sfx := TRUE
+      END
     END;
     IF k = SymTab.KindConst THEN
       IF SymTab.Equal(nm, "TRUE") THEN
@@ -676,6 +787,12 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
       IF op = AST.SelField THEN
         Name(AST.Child(sel, 0), fn);
         IF t = SymTab.InvalidType THEN
+        ELSIF (SymTab.ClassOf(t) = SymTab.ClClass)
+           AND SymTab.MethodExists(t, fn) THEN
+          (* obj.Method: bind the receiver; the call supplies the value *)
+          QbeGen.ArmRecv(q);
+          QbeGen.CopyOp(fn, qn);
+          curMethCls := t; k := SymTab.KindProc; t := SymTab.InvalidType
         ELSIF NOT SymTab.FieldExists(t, fn) THEN t := SymTab.InvalidType
         ELSE
           fo := SymTab.FieldOffset(t, fn);
@@ -893,6 +1010,138 @@ PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
     END
   END LowerBuiltinStmt;
 
+PROCEDURE LowerMethod (m: AST.Node; ct: SymTab.TypeIndex);
+(* A class method: hidden THIS receiver, then declared formals; the body
+   runs with THIS pushed as the WITH base (bare field names resolve). *)
+  VAR nm, txt: SymTab.Name; mg, thisQ: QbeGen.QVal;
+      uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
+      pv, ext: BOOLEAN; j: CARDINAL; saveCls: SymTab.TypeIndex;
+  BEGIN
+    IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN END;
+    Name(AST.Child(m, 0), nm);
+    IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN END;
+    QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
+    QbeGen.BeginFunc(mg);
+    IF NOT QbeGen.FuncParam("THIS", TRUE, ct) THEN END;
+    j := 0;
+    WHILE j < np DO
+      IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
+      IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
+      INC(j)
+    END;
+    QbeGen.SetFuncRes(res);
+    QbeGen.EndFuncHeader;
+    QbeGen.ThisBase(thisQ);
+    saveCls := curImplCls;
+    curImplCls := ct;
+    QbeGen.PushWith(thisQ);
+    IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
+    LowerDecls(AST.Child(m, 2));
+    LowerStmt(AST.Child(m, 1));
+    IF withTop > 0 THEN DEC(withTop) END;
+    curImplCls := saveCls;
+    QbeGen.PopWith;
+    QbeGen.EndFunc(res)
+  END LowerMethod;
+
+PROCEDURE LowerMethods (seq: AST.Node; ct: SymTab.TypeIndex);
+  VAR i: CARDINAL; m: AST.Node;
+  BEGIN
+    IF seq = AST.NoNode THEN RETURN END;
+    i := 0;
+    WHILE i < AST.NChild(seq) DO
+      m := AST.Child(seq, i);
+      IF i = AST.MaxChild - 1 THEN LowerMethods(m, ct)
+      ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethods(m, ct)
+      ELSIF AST.Kind(m) = AST.NkProcDecl THEN LowerMethod(m, ct)
+      END;
+      INC(i)
+    END
+  END LowerMethods;
+
+PROCEDURE LowerMethodHeadings (seq: AST.Node; ct: SymTab.TypeIndex);
+(* Class-declaration method headings: emit+discard a function header per
+   method so the backend temp counters advance exactly as the legacy
+   parse did (the implementation's temps then line up). *)
+  VAR i, j: CARDINAL; m: AST.Node; nm, txt: SymTab.Name;
+      mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
+      pv, ext: BOOLEAN;
+  BEGIN
+    IF seq = AST.NoNode THEN RETURN END;
+    i := 0;
+    WHILE i < AST.NChild(seq) DO
+      m := AST.Child(seq, i);
+      IF i = AST.MaxChild - 1 THEN LowerMethodHeadings(m, ct)
+      ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethodHeadings(m, ct)
+      ELSIF AST.Kind(m) = AST.NkProcDecl THEN
+        Name(AST.Child(m, 0), nm);
+        IF ProcInfo(nm, uid, res, depth, ext, np) THEN
+          QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
+          QbeGen.BeginFunc(mg);
+          j := 0;
+          WHILE j < np DO
+            IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
+            IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
+            INC(j)
+          END;
+          QbeGen.SetFuncRes(res);
+          QbeGen.AbortFunc
+        END
+      END;
+      INC(i)
+    END
+  END LowerMethodHeadings;
+
+PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex;
+                           VAR q: QbeGen.QVal; want: BOOLEAN);
+  VAR d: AST.Node; ct, res, ft, at: SymTab.TypeIndex;
+      cq, mg, qa, qt, qe: QbeGen.QVal; fn, pn: SymTab.Name;
+      k, vs: INTEGER; i: CARDINAL; sfx, isV, conv: BOOLEAN;
+  BEGIN
+    d := AST.Child(n, 0);
+    curMethCls := SymTab.InvalidType;
+    LowerDesign(d, ct, k, cq, pn, sfx);
+    ct := curMethCls;
+    IF ct = SymTab.InvalidType THEN
+      t := SymTab.InvalidType; QbeGen.CopyOp("0", q); RETURN
+    END;
+    IF AST.NChild(d) = 1 THEN
+      Name(AST.Child(d, 0), fn)
+    ELSE
+      Name(AST.Child(AST.Child(d, AST.NChild(d) - 1), 0), fn)
+    END;
+    res := SymTab.ClassMethodRes(ct, fn);
+    vs := SymTab.VirtSlot(ct, fn);
+    IF vs >= 0 THEN QbeGen.VirtCallBegin(cq, vs, res)
+    ELSE
+      QbeGen.Mangled(fn, SymTab.ClassMethodUid(ct, fn), mg);
+      QbeGen.CallBegin(mg, res, 0, FALSE)
+    END;
+    i := 1;
+    WHILE i < AST.NChild(n) DO
+      LowerExpr(AST.Child(n, i), at, qe);
+      ft := SymTab.ClassMethodParamType(ct, fn, i - 1);
+      isV := SymTab.ClassMethodParamIsVar(ct, fn, i - 1);
+      IF isV THEN
+        IF QbeGen.AddrOfVal(qe, qa) THEN
+          IF NOT QbeGen.CallArg(qa, "l") THEN END
+        END
+      ELSE
+        conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at);
+        IF conv THEN
+          QbeGen.ConvIR(qe, qt);
+          IF NOT QbeGen.CallArg(qt, "d") THEN END
+        ELSE
+          IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+        END
+      END;
+      INC(i)
+    END;
+    IF want THEN t := res; QbeGen.CallEnd(TRUE, q)
+    ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
+    END
+  END LowerMethodCall;
+
 PROCEDURE LowerCase (n: AST.Node);
 (* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). *)
   VAR i, j: CARDINAL; arm, lab: AST.Node; tsel, t2, t3: SymTab.TypeIndex;
@@ -1018,9 +1267,12 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
     ELSIF AST.Kind(n) = AST.NkDesignator THEN
       LowerDesign(n, t, k, q, qn, sfx)
     ELSIF AST.Kind(n) = AST.NkCall THEN
-      CalleeName(n, qn);
-      IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
-      ELSE LowerCall(n, t, q, TRUE)
+      IF IsMethodCall(n) THEN LowerMethodCall(n, t, q, TRUE)
+      ELSE
+        CalleeName(n, qn);
+        IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
+        ELSE LowerCall(n, t, q, TRUE)
+        END
       END
     ELSIF AST.Kind(n) = AST.NkUnary THEN
       LowerExpr(AST.Child(n, 0), t, q);
@@ -1333,9 +1585,12 @@ PROCEDURE LowerStmt (seq: AST.Node);
     ELSIF k = AST.NkCase THEN LowerCase(seq)
     ELSIF k = AST.NkWith THEN LowerWith(seq)
     ELSIF k = AST.NkCall THEN
-      CalleeName(seq, qn);
-      IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
-      ELSE LowerCall(seq, t, q, FALSE)
+      IF IsMethodCall(seq) THEN LowerMethodCall(seq, t, q, FALSE)
+      ELSE
+        CalleeName(seq, qn);
+        IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
+        ELSE LowerCall(seq, t, q, FALSE)
+        END
       END
     END
   END LowerStmt;
@@ -1369,7 +1624,7 @@ PROCEDURE ReenterGlobals (seq: AST.Node);
 PROCEDURE LowerDecls (seq: AST.Node);
   VAR i, j: CARDINAL; c: AST.Node; nm, txt: SymTab.Name; qv: QbeGen.QVal;
       mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
-      ext, pv: BOOLEAN;
+      ext, pv: BOOLEAN; kk: INTEGER; ct: SymTab.TypeIndex;
   BEGIN
     IF seq = AST.NoNode THEN RETURN END;
     i := 0;
@@ -1377,6 +1632,22 @@ PROCEDURE LowerDecls (seq: AST.Node);
       c := AST.Child(seq, i);
       IF i = AST.MaxChild - 1 THEN LowerDecls(c)
       ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDecls(c)
+      ELSIF AST.Kind(c) = AST.NkClassDecl THEN
+        Name(AST.Child(c, 0), nm);
+        IF Resolve(nm, kk, ct) THEN
+          IF SymTab.ClassOf(ct) = SymTab.ClClass THEN
+            IF AST.Op(c) = 1 THEN
+              LowerMethods(AST.Child(c, 3), ct);
+              IF AST.Child(c, 2) # AST.NoNode THEN
+                QbeGen.BeginInit(nm);
+                LowerStmt(AST.Child(c, 2));
+                QbeGen.EndInit
+              END
+            ELSE
+              LowerMethodHeadings(AST.Child(c, 3), ct)
+            END
+          END
+        END
       ELSIF AST.Kind(c) = AST.NkUnit THEN
         Name(AST.Child(c, 0), nm);
         ReenterGlobals(AST.Child(c, 1));
@@ -1423,6 +1694,7 @@ PROCEDURE LowerUnit (unit: AST.Node);
   VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL;
   BEGIN
     withTop := 0;
+    curImplCls := SymTab.InvalidType;
     Name(AST.Child(unit, 0), nm);
     i := 0;
     WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO