step 3: procedure types + indirect calls (PROCEDURE (...) types, proc-typed vars, assignment, call through pointer); suite 109/109

- SymTab FProc descriptor (params in flat arrays) + ProcTypeOf + structural compatibility
- QbeGen ProcAddr + CallBeginInd/CallEnd (call %ptr)
- grammar: ProcType, named and type-only param lists, proc value/indirect call
- M2S under V3: 30 -> 3 errors (remaining: LENGTH, empty CASE ELSE, CR-generated &)

compiler/run_tests.sh

@@ -62,6 +62,7 @@ expect_run t_bool.mod 42
 expect_run t_real.mod 31
 expect_run t_array.mod 108
 expect_run t_nestidx.mod 42
+expect_run t_proctype.mod 42
 expect_run t_constfold.mod 42
 expect_run t_emptystat.mod 42
 expect_run t_highlen.mod 18

compiler/src/M2.atg

@@ -227,9 +227,47 @@ PRODUCTIONS
     | ArrayType<t, allowOpen>
     | SetType<t>
     | RecordType<t>
-    | PointerType<t> .
+    | PointerType<t>
+    | ProcType<t> .
   PointerType<VAR t: SymTab.TypeIndex>  (. VAR base: SymTab.TypeIndex; .)
     = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
+  (* Procedure types (step 8.5): PROCEDURE (params): result. Values
+     are code pointers; params are collected into the descriptor. *)
+  ProcType<VAR t: SymTab.TypeIndex>     (. VAR res, pt: SymTab.TypeIndex;
+                                             isV: BOOLEAN; .)
+    = "PROCEDURE"                       (. res := SymTab.InvalidType;
+                                           t := SymTab.NewProcType(res); .)
+      [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
+      [ ":" TypeIdent<res>              (. SymTab.SetProcTypeRes(t, res); .) ] .
+  ProcTypeSection<t: SymTab.TypeIndex>  (. VAR pt: SymTab.TypeIndex;
+                                             isV: BOOLEAN;
+                                             cnt, k: CARDINAL;
+                                             names: ARRAY [0 .. 15] OF SymTab.Name; .)
+    =                                   (. isV := FALSE; cnt := 0; .)
+      [ "VAR"                           (. isV := TRUE; .) ]
+      GetIdent<names[cnt]>              (. INC(cnt); .)
+      { "," GetIdent<names[cnt]>        (. INC(cnt); .) }
+      ( ":" Type<pt, FALSE>             (. k := 0;
+                                           WHILE k < cnt DO
+                                             SymTab.ProcTypeAdd(t, isV, pt);
+                                             INC(k)
+                                           END; .)
+      |                                 (. (* type-only parameter list:
+                                              each name is a type (GNU
+                                              shorthand used by the
+                                              Coco/R scanner frame) *)
+                                           k := 0;
+                                           WHILE k < cnt DO
+                                             IF SymTab.Lookup(names[k])
+                                                AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
+  OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
+                                               pt := SymTab.SymType(names[k])
+                                             ELSE SemError(201);
+                                               pt := SymTab.InvalidType
+                                             END;
+                                             SymTab.ProcTypeAdd(t, isV, pt);
+                                             INC(k)
+                                           END; .) ) .
   (* Arrays: "OF" without bounds is an open formal (allowed only
      where allowOpen); "[lo..hi, ...]" nests bounded levels inside
      out. Bounds are folded literals (int/char); anything else 230.
@@ -527,7 +565,8 @@ PRODUCTIONS
  AND (cls # SymTab.ClSet)
  AND (cls # SymTab.ClRecord)
  AND (cls # SymTab.ClPtr)
- AND (cls # SymTab.ClLong) THEN
+ AND (cls # SymTab.ClLong)
+ AND (cls # SymTab.ClProc) THEN
                                              SemError(230) END;
                                            IF QbeGen.LocFull() THEN
                                              SemError(233) END;
@@ -864,8 +903,10 @@ PRODUCTIONS
                                            ELSIF SymTab.ClassOf(dt) =
                                                  SymTab.ClRecord THEN
                                              QbeGen.CopyRecord(qd, qe, dt)
-                                           ELSIF SymTab.ClassOf(dt) =
-                                                 SymTab.ClPtr THEN
+                                           ELSIF (SymTab.ClassOf(dt) =
+                                                 SymTab.ClPtr)
+                                              OR (SymTab.ClassOf(dt) =
+                                                 SymTab.ClProc) THEN
                                              QbeGen.StorePtr(qn, qe)
                                            ELSIF SymTab.IsLongFamily(dt) THEN
                                              IF wconv THEN
@@ -880,7 +921,7 @@ PRODUCTIONS
                                              QbeGen.StoreVar(qn, qe, isR)
                                            END
                                          END; .)
-      | ArgList<qn, FALSE, ct2, q2, called>
+      | ArgList<qn, dt, qd, FALSE, ct2, q2, called>
       |                                 (* bare `P;`: proper parameterless
                                             procedure call; anything else
                                             here is 233 (was a bare syntax
@@ -908,29 +949,45 @@ PRODUCTIONS
      want selects CallEnd's result handling; t/q carry the call
      value (statement calls discard). Arity/type failures are 233;
      evaluation code still emits so the .ssa stays assembleable. *)
-  ArgList<pn: SymTab.Name; want: BOOLEAN;
+  ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
+          want: BOOLEAN;
           VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
           VAR called: BOOLEAN>          (. VAR i: CARDINAL;
                                              res: SymTab.TypeIndex;
                                              mg: QbeGen.QVal;
-                                             ok: BOOLEAN; .)
+                                             ok, ind: BOOLEAN; .)
     = "("                               (. called := TRUE;
-                                           res := SymTab.ProcRes(pn);
                                            ok := TRUE;
-                                           IF SymTab.SymKind(pn) #
+                                           ind := FALSE;
+                                           IF SymTab.SymKind(pn) =
                                               SymTab.KindProc THEN
-                                             SemError(233); ok := FALSE
-                                           ELSE QbeGen.Mangled(pn,
-                                             SymTab.ProcUid(pn), mg);
+                                             res := SymTab.ProcRes(pn);
+                                             QbeGen.Mangled(pn,
+                                               SymTab.ProcUid(pn), mg);
                                              QbeGen.CallBegin(mg, res,
                                                SymTab.ProcDepthOf(pn),
                                                SymTab.IsExternal(pn))
+                                           ELSIF (pt # SymTab.InvalidType)
+  AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
+                                             ind := TRUE;
+                                             res :=
+                                               SymTab.ProcTypeRes(pt);
+                                             QbeGen.CallBeginInd(callee,
+                                               res, FALSE)
+                                           ELSE SemError(233);
+                                             ok := FALSE;
+                                             res := SymTab.InvalidType
                                            END;
                                            i := 0; .)
-      [ ActParam<pn, i>                  (. INC(i); .)
-        { "," ActParam<pn, i>            (. INC(i); .) } ]
+      [ ActParam<pn, pt, ind, i>        (. INC(i); .)
+        { "," ActParam<pn, pt, ind, i>  (. INC(i); .) } ]
       ")"                               (. IF ok THEN
-                                             IF i #
+                                             IF ind THEN
+                                               IF i #
+                                                  SymTab.ProcTypeNPar(pt) THEN
+                                                 SemError(233); ok := FALSE
+                                               END
+                                             ELSIF i #
                                                 SymTab.ProcNPar(pn) THEN
                                                SemError(233); ok := FALSE
                                              END
@@ -958,11 +1015,21 @@ PRODUCTIONS
                                            END; .) .
   (* One actual: VAR formals take recorded designator addresses
      (233 otherwise); value formals take converted expressions. *)
-  ActParam<pn: SymTab.Name; i: CARDINAL>(. VAR at, ft: SymTab.TypeIndex;
+  ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
+           i: CARDINAL>                 (. VAR at, ft: SymTab.TypeIndex;
                                              qe, qa, qt: QbeGen.QVal;
                                              isV, conv: BOOLEAN; .)
-    = Expr<at, qe>                      (. ft := SymTab.ParamType(pn, i);
-                                           isV := SymTab.ParamIsVar(pn, i);
+    = Expr<at, qe>                      (. IF ind THEN
+                                             ft :=
+                                               SymTab.ProcTypeParamType(pt,
+                                                 i);
+                                             isV :=
+                                               SymTab.ProcTypeParamIsVar(pt,
+                                                 i)
+                                           ELSE
+                                             ft := SymTab.ParamType(pn, i);
+                                             isV := SymTab.ParamIsVar(pn, i)
+                                           END;
                                            IF (at = SymTab.InvalidType)
                                               OR (ft =
                                                  SymTab.InvalidType) THEN
@@ -1334,7 +1401,8 @@ PRODUCTIONS
                                                       = SymTab.ClReal) THEN
                                                  QbeGen.LoadVar(n,
                                                    cls = SymTab.ClReal, q)
-                                               ELSIF cls = SymTab.ClPtr THEN
+                                               ELSIF (cls = SymTab.ClPtr)
+                                                  OR (cls = SymTab.ClProc) THEN
                                                  QbeGen.LoadPtr(n, q)
                                                ELSIF cls = SymTab.ClLong THEN
                                                  QbeGen.LoadLong(n, q)
@@ -1851,7 +1919,7 @@ PRODUCTIONS
                                                      SymTab.ClRecord)) THEN
                                              QbeGen.NoteAddr(qd, qd)
                                            END; .)
-      [ ArgList<qn, TRUE, ct2, q2, called>
+      [ ArgList<qn, dt, qd, TRUE, ct2, q2, called>
                                         (. t := ct2;
                                            QbeGen.CopyOp(q2, q); .) ]
                                         (. IF NOT called
@@ -1872,7 +1940,15 @@ PRODUCTIONS
                                                  SymTab.IsExternal(qn));
                                                QbeGen.CallEnd(TRUE, q);
                                                t := SymTab.ProcRes(qn)
-                                             ELSE SemError(230)
+                                             ELSE
+                                               (* procedure used as a
+                                                  value (assign to a
+                                                  procedure variable):
+                                                  its code address *)
+                                               t := SymTab.ProcTypeOf(qn);
+                                               QbeGen.Mangled(qn,
+                                                 SymTab.ProcUid(qn), qm0);
+                                               QbeGen.ProcAddr(qm0, q)
                                              END
                                            END; .)
     | ( "HIGH"                          (. isHigh := TRUE; .)

compiler/src/QbeGen.def

@@ -79,12 +79,22 @@ PROCEDURE EndFunc (resT: INTEGER);
 PROCEDURE EmitRet (q: ARRAY OF CHAR; hasVal: BOOLEAN);
 (* Emits "ret q" (or dummy "ret 0"); always a terminator. *)
 
+PROCEDURE ProcAddr (mangled: ARRAY OF CHAR; VAR q: QVal);
+(* q := "$<mangled>" — a procedure's code address as a value (for
+   assigning a procedure to a procedure variable). *)
+
 PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
                        fdep: CARDINAL; isExt: BOOLEAN);
 (* Starts accumulating a call's actuals; resolves the static link
    from the caller's context and the callee's lexical depth.
    External (C) callees get no static link. *)
 
+PROCEDURE CallBeginInd (callee: ARRAY OF CHAR; resT: INTEGER;
+                         isExt: BOOLEAN);
+(* Indirect call through the code pointer `callee`. The static link
+   is 0 (top-level procedure values; nested values are not yet
+   supported). resT/isExt describe the signature. *)
+
 PROCEDURE CallArg (q: ARRAY OF CHAR; cls: CHAR): BOOLEAN;
 (* Appends one typed actual (FALSE when full → 233). *)
 

compiler/src/QbeGen.mod

@@ -41,6 +41,7 @@ VAR
   hdrComma : BOOLEAN;
   stkLink : ARRAY [0 .. 15] OF QVal;    (* per-call static links *)
   stkExt : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call external flag *)
+  stkInd : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call indirect flag *)
   outSel : CARDINAL;  (* 0 = file, else nestBufs[outSel-1] *)
   nInit : CARDINAL;
   initNames : ARRAY [0 .. 31] OF QVal;
@@ -487,7 +488,8 @@ PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
        OR (SymTab.ClassOf(t) = SymTab.ClClass) THEN
       DeclRec(g, t)
     ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
-       OR (SymTab.ClassOf(t) = SymTab.ClLong) THEN DataLineL(g, "0")
+       OR (SymTab.ClassOf(t) = SymTab.ClLong)
+       OR (SymTab.ClassOf(t) = SymTab.ClProc) THEN DataLineL(g, "0")
     ELSE DataLine(g, FALSE, "0")
     END
   END DeclVar;
@@ -758,7 +760,8 @@ PROCEDURE ResClass (t: INTEGER): CHAR;
     IF cls = SymTab.ClReal THEN RETURN "d" END;
     IF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
        OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
-       OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong) THEN
+       OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
+       OR (cls = SymTab.ClProc) THEN
       RETURN "l"
     END;
     RETURN "w"
@@ -808,7 +811,8 @@ PROCEDURE AllocLocal (t: INTEGER; VAR slot: QVal);
     ELSIF cls = SymTab.ClReal THEN
       W(" =l alloc8 8"); WL("");
       W("  stored d_0.0, "); WL(slot)
-    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong) THEN
+    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
+       OR (cls = SymTab.ClProc) THEN
       W(" =l alloc8 8"); WL("");
       W("  storel 0, "); WL(slot)
     ELSE
@@ -974,6 +978,27 @@ PROCEDURE EmitRet (q: ARRAY OF CHAR; hasVal: BOOLEAN);
     dead := TRUE
   END EmitRet;
 
+PROCEDURE ProcAddr (mangled: ARRAY OF CHAR; VAR q: QVal);
+  BEGIN
+    Cpy(q, "$");
+    App(q, mangled)
+  END ProcAddr;
+
+PROCEDURE CallBeginInd (callee: ARRAY OF CHAR; resT: INTEGER;
+                         isExt: BOOLEAN);
+(* Indirect call through the code pointer in `callee`. *)
+  BEGIN
+    IF callDepth > HIGH(stkName) THEN RETURN END;
+    Cpy(stkName[callDepth], callee);
+    stkRes[callDepth] := ResClass(resT);
+    stkExt[callDepth] := isExt;
+    stkInd[callDepth] := TRUE;
+    Cpy(stkLink[callDepth], "0");
+    stkArg[callDepth][0] := CHR(0);
+    stkN[callDepth] := 0;
+    INC(callDepth)
+  END CallBeginInd;
+
 PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
                        fdep: CARDINAL; isExt: BOOLEAN);
 (* Pushes a call level; the static link is resolved now (caller
@@ -987,6 +1012,7 @@ PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
     Cpy(stkName[callDepth], mangled);
     stkRes[callDepth] := ResClass(resT);
     stkExt[callDepth] := isExt;
+    stkInd[callDepth] := FALSE;
     stkArg[callDepth][0] := CHR(0);
     stkN[callDepth] := 0;
     IF isExt THEN
@@ -1060,7 +1086,11 @@ PROCEDURE CallEnd (wantRes: BOOLEAN; VAR q: QVal);
     ELSE
       W("  ")
     END;
-    W(" call $"); W(funcName); W("(");
+    IF stkInd[d] THEN
+      W(" call "); W(funcName); W("(")   (* callee operand already %-prefixed *)
+    ELSE
+      W(" call $"); W(funcName); W("(")
+    END;
     IF stkExt[d] THEN
       W(body)                       (* C callee: no static link *)
     ELSE
@@ -1204,7 +1234,7 @@ PROCEDURE LoadDesignator (name: ARRAY OF CHAR; t: INTEGER; k: INTEGER;
       IF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
          OR (cls = SymTab.ClChar) OR (cls = SymTab.ClReal) THEN
         LoadVar(name, cls = SymTab.ClReal, q); RETURN TRUE
-      ELSIF cls = SymTab.ClPtr THEN
+      ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
         LoadPtr(name, q); RETURN TRUE
       ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
          OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN

compiler/src/SymTab.def

@@ -44,6 +44,7 @@ CONST
   ClClass   = 11;
   ClNil     = 12;
   ClLong    = 13;
+  ClProc    = 14;
 
   (* operator codes for RelCheck *)
   OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
@@ -403,6 +404,28 @@ PROCEDURE SetCount (t: TypeIndex): CARDINAL;
 (* Base span in values (0 when unsuitable). *)
 PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
 
+(* ---------------- procedure types (step 8.5) ---------------- *)
+(* PROCEDURE (params): result as a value type. Values are code
+   pointers (pointer-sized); calls through them are indirect. Param
+   lists are collected with ProcTypeBegin/ProcTypeAdd and finalised
+   by NewProcType (same pattern as array bounds). *)
+
+PROCEDURE NewProcType (res: TypeIndex): TypeIndex;
+(* Fresh procedure type (result may be InvalidType, set later). Its
+   parameters are appended in order with ProcTypeAdd. *)
+PROCEDURE ProcTypeAdd (t: TypeIndex; isVar: BOOLEAN; pt: TypeIndex);
+PROCEDURE SetProcTypeRes (t: TypeIndex; res: TypeIndex);
+
+PROCEDURE ProcTypeNPar (t: TypeIndex): CARDINAL;
+PROCEDURE ProcTypeParamType (t: TypeIndex; i: CARDINAL): TypeIndex;
+PROCEDURE ProcTypeParamIsVar (t: TypeIndex; i: CARDINAL): BOOLEAN;
+PROCEDURE ProcTypeRes (t: TypeIndex): TypeIndex;
+(* Accessors for a procedure type (0/InvalidType when not one). *)
+
+PROCEDURE ProcTypeOf (name: ARRAY OF CHAR): TypeIndex;
+(* Builds the procedure type descriptor for procedure name (for using
+   a procedure as a value). InvalidType if name is not a procedure. *)
+
 (* ---------------- predicates used by grammar checks ---------------- *)
 (* All return TRUE if either operand is InvalidType (no cascades). *)
 

compiler/src/SymTab.mod

@@ -9,12 +9,13 @@ CONST
   MaxPend   = 256;
   MaxMods   = 64;
   ResDepth  = 64;
+  MaxPP     = 1024;   (* total procedure-type parameter slots *)
 
   (* descriptor forms *)
   FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
   FRecord = 5; FSet = 6; FPtr = 7; FStr = 8;
   FInt = 9; FReal = 10; FChar = 11; FBool = 12;
-  FClass = 13; FOpenArr = 14; FNil = 15; FLong = 16;
+  FClass = 13; FOpenArr = 14; FNil = 15; FLong = 16; FProc = 17;
 
 TYPE
   SymPtr = POINTER TO SymNode;
@@ -96,6 +97,11 @@ VAR
   modImpl : ARRAY [0 .. MaxMods - 1] OF BOOLEAN;
   haveProg : BOOLEAN;
   typeBlockDepth : CARDINAL;  (* > 0 inside a TYPE block *)
+  procp    : ARRAY [0 .. MaxPP - 1] OF TypeIndex;  (* proc-type params *)
+  procvis  : ARRAY [0 .. MaxPP - 1] OF BOOLEAN;    (* VAR flags *)
+  procstart : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
+  procn    : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
+  nProcP   : CARDINAL;
 
 (* ---------------- strings ---------------- *)
 
@@ -567,6 +573,7 @@ PROCEDURE ClassOf (t: TypeIndex): INTEGER;
     | FPtr : RETURN ClPtr
     | FStr : RETURN ClStr
     | FClass : RETURN ClClass
+    | FProc : RETURN ClProc
     | FNil : RETURN ClNil
     | FSub : IF tref[r] = InvalidType THEN RETURN ClInt
              ELSE RETURN ClassOf(tref[r]) END
@@ -735,6 +742,99 @@ PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
     RETURN tref[r]
   END PtrBase;
 
+(* ---------------- procedure types (step 8.5) ---------------- *)
+
+PROCEDURE NewProcType (res: TypeIndex): TypeIndex;
+  VAR t: TypeIndex;
+  BEGIN
+    t := NewDesc(FProc, res);
+    IF t = InvalidType THEN RETURN t END;
+    procstart[t] := nProcP;
+    procn[t] := 0;
+    RETURN t
+  END NewProcType;
+
+PROCEDURE ProcTypeAdd (t: TypeIndex; isVar: BOOLEAN; pt: TypeIndex);
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FProc) THEN RETURN END;
+    IF nProcP < MaxPP THEN
+      procp[nProcP] := pt;
+      procvis[nProcP] := isVar;
+      INC(nProcP); INC(procn[r])
+    END
+  END ProcTypeAdd;
+
+PROCEDURE SetProcTypeRes (t: TypeIndex; res: TypeIndex);
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r # InvalidType) AND (tform[r] = FProc) THEN tref[r] := res END
+  END SetProcTypeRes;
+
+PROCEDURE ProcTypeNPar (t: TypeIndex): CARDINAL;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FProc) THEN RETURN 0 END;
+    RETURN procn[r]
+  END ProcTypeNPar;
+
+PROCEDURE ProcTypeParamType (t: TypeIndex; i: CARDINAL): TypeIndex;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FProc) OR (i >= procn[r]) THEN
+      RETURN InvalidType
+    END;
+    RETURN procp[procstart[r] + i]
+  END ProcTypeParamType;
+
+PROCEDURE ProcTypeParamIsVar (t: TypeIndex; i: CARDINAL): BOOLEAN;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FProc) OR (i >= procn[r]) THEN
+      RETURN FALSE
+    END;
+    RETURN procvis[procstart[r] + i]
+  END ProcTypeParamIsVar;
+
+PROCEDURE ProcTypeRes (t: TypeIndex): TypeIndex;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FProc) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END ProcTypeRes;
+
+PROCEDURE ProcTypeOf (name: ARRAY OF CHAR): TypeIndex;
+  VAR node, p: SymPtr;
+    t: TypeIndex;
+    k: CARDINAL;
+  BEGIN
+    node := Find(name);
+    IF (node = NIL) OR (node^.kind # KindProc) THEN
+      RETURN InvalidType
+    END;
+    t := NewDesc(FProc, node^.rslt);
+    IF t = InvalidType THEN RETURN t END;
+    procstart[t] := nProcP;
+    k := 0;
+    p := node^.plink;
+    WHILE (p # NIL) AND (nProcP < MaxPP) DO
+      procp[nProcP] := p^.typ;
+      procvis[nProcP] := p^.isVar;
+      INC(nProcP); INC(k);
+      p := p^.plink
+    END;
+    procn[t] := k;
+    RETURN t
+  END ProcTypeOf;
+
 PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
 (* Inline footprint in bytes: scalars 4/8, sets words*4, pointers,
    open and fixed arrays 8 (descriptor address — array objects live
@@ -752,7 +852,7 @@ PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
     | FReal : RETURN 8
     | FEnum, FSub : RETURN 4
     | FSet : RETURN SetWords(t) * 4
-    | FPtr, FOpenArr, FArray : RETURN 8
+    | FPtr, FOpenArr, FArray, FProc : RETURN 8
     | FRecord, FClass :
         n := 0;
         f := fields;
@@ -782,7 +882,7 @@ PROCEDURE ElemBytes (t: TypeIndex): CARDINAL;
     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
+       OR (cls = ClClass) OR (cls = ClProc) THEN
       RETURN 8
     END;
     RETURN 4
@@ -1593,6 +1693,29 @@ PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
     RETURN BaseSpanOk(a) AND BaseSpanOk(b)
   END SetBasesOk;
 
+PROCEDURE ProcTypesOk (a, b: TypeIndex): BOOLEAN;
+(* Structural compatibility of two procedure types: same result and
+   same parameter types / VAR flags. *)
+  VAR i, n: CARDINAL;
+  BEGIN
+    IF (tform[a] # FProc) OR (tform[b] # FProc) THEN RETURN FALSE END;
+    IF NOT SameType(tref[a], tref[b]) THEN RETURN FALSE END;
+    n := procn[a];
+    IF n # procn[b] THEN RETURN FALSE END;
+    i := 0;
+    WHILE i < n DO
+      IF procvis[procstart[a] + i] # procvis[procstart[b] + i] THEN
+        RETURN FALSE
+      END;
+      IF NOT SameType(procp[procstart[a] + i],
+                      procp[procstart[b] + i]) THEN
+        RETURN FALSE
+      END;
+      INC(i)
+    END;
+    RETURN TRUE
+  END ProcTypesOk;
+
 PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
   VAR rs, rd: TypeIndex;
   BEGIN
@@ -1603,6 +1726,9 @@ PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
     IF (tform[rs] = FSet) AND (tform[rd] = FSet) THEN
       RETURN SetBasesOk(tref[rs], tref[rd])
     END;
+    IF (tform[rs] = FProc) AND (tform[rd] = FProc) THEN
+      RETURN ProcTypesOk(rs, rd)
+    END;
     IF (ClassOf(src) = ClArray) AND (ClassOf(dst) = ClArray) THEN
       (* a fixed 1-D array is compatible with an open formal of the
          same element type (value or VAR) *)

compiler/tests/t_proctype.mod

@@ -0,0 +1,24 @@
+MODULE TProcType;
+// Procedure types: alias, procedure-typed variable, assignment of a
+// procedure name, and indirect call. Both the named parameter form
+// (a, b : INTEGER) and the type-only shorthand (INTEGER) are used.
+// Exit 42.
+TYPE BinOp = PROCEDURE (a, b : INTEGER) : INTEGER;
+TYPE UnOp  = PROCEDURE (INTEGER) : INTEGER;
+
+VAR ExitCode : INTEGER;
+VAR f : BinOp;
+VAR g : UnOp;
+
+PROCEDURE Add (a, b : INTEGER) : INTEGER;
+BEGIN RETURN a + b END Add;
+
+PROCEDURE Neg (x : INTEGER) : INTEGER;
+BEGIN RETURN -x END Neg;
+
+BEGIN
+  f := Add;
+  ExitCode := f(40, 2);              // 42
+  g := Neg;
+  ExitCode := ExitCode + g(-5) - 5   // 42 + 5 - 5 = 42
+END TProcType.

docs/summary_proctypes.md

@@ -0,0 +1,68 @@
+# Procedure types + indirect calls (step 3)
+
+Tag `v3-proctypes`. Main suite 109/109 (new `t_proctype`).
+
+## What works
+
+- **Procedure types**: `TYPE Op = PROCEDURE (a, b : INTEGER) : INTEGER;`
+  and anonymous ones in declarations
+  (`VAR Error : PROCEDURE (nr, line, col : INTEGER; pos : INT32);`).
+- **Type-only parameter form** (GNU shorthand used by the Coco/R
+  scanner frame): `PROCEDURE (INT32) : CHAR`,
+  `PROCEDURE (INTEGER, INTEGER, INTEGER, INT32)`.
+- **Procedure-typed variables** (module-level and local), stored as
+  pointer-sized (`l`) code pointers, zero-initialised.
+- **Assigning a procedure to a procedure variable**: `f := Add;`
+  emits the procedure's code address (`storel $Mod_Add_N, $Mod_f`).
+- **Indirect calls**: `f(40, 2)` emits `%r =w call %t(l 0, w 40, w 2)`
+  (the leading `l 0` is the static link).
+- **Qualified proc-typed variables**: `M2S.Error(...)`,
+  `Error := Err;`.
+
+## Implementation
+
+- **SymTab**: new descriptor form `FProc` (result in `tref`) with
+  parameters in flat arrays (`procp`/`procvis`, per-type
+  `procstart`/`procn`); builder `NewProcType` + `ProcTypeAdd` +
+  `SetProcTypeRes`; accessors `ProcTypeNPar/ParamType/ParamIsVar/Res`;
+  `ProcTypeOf(name)` builds the type of a named procedure;
+  `ClassOf` → `ClProc`; `SizeOf` 8; `Assignable` compares procedure
+  types structurally (`ProcTypesOk`). Max 1024 param slots.
+- **QbeGen**: `ProcAddr` (a procedure's code address as a value);
+  `ClProc` handled in `DeclVar`/`AllocLocal`/`ResClass`/
+  `LoadDesignator`/`ResClass`; `CallBeginInd` + `CallEnd` emit
+  `call %<ptr>(...)`.
+- **Grammar**: `ProcType` in `Type`; `ProcTypeSection` accepts named
+  (`a, b : T`) and type-only (`T`) parameter lists; `Fact` yields a
+  procedure's code address when a procedure name is used as a value
+  (not followed by `(`); `ArgList`/`ActParam` gained a proc-type +
+  callee path for indirect calls (used from both statement and
+  expression calls).
+
+## Limitations / follow-ups
+
+- **Nested procedure values** are not supported: only the code
+  address is stored, so the static link passed to an indirect call is
+  always `0` (fine for top-level procedures). The Coco/R driver's
+  `Error := StoreError` (StoreError nested in `ListHandler`) will
+  need this, or a source-level restructuring.
+- **Type-only parameters that are composite** (`PROCEDURE (ARRAY OF
+  CHAR)`) are not parsed; only identifier type names are.
+
+## M2S status after this step
+
+`M2S` compiled under V3 drops from 30 errors to **3**, none
+procedure-type related:
+
+1. `M2S.mod:111` — `LENGTH(s)` (GNU builtin; V3 has `LEN`).
+2. `M2S.mod:201` — empty `ELSE` in a CASE (`ELSE END`).
+3. `M2S.mod:206` — `&` used for AND (in CR's *generated* scanner
+   tables, not our `scanner.frm`).
+
+These are small language-compatibility items (aliases / empty
+branches), separate from procedure types.
+
+## Files
+
+`compiler/src/{SymTab.def,SymTab.mod,QbeGen.def,QbeGen.mod,M2.atg}`,
+`compiler/tests/t_proctype.mod`, `compiler/run_tests.sh`.