lang: VIRTUAL dispatch via vtables + subtype pointer assignment

- SymTab: per-class vtable pool (vtBase/nVirt/vtName/vtUid), BuildVTable
  (inherited slots first; same-named virtual overrides in place; new
  ones append; method nodes record vslot), VptrOffset (vptr at 0, or
  after the parent's fields when it is introduced), HasVTable, VirtSlot,
  VtCount/VtName/VtUid/VtHasBody, VtClassCount/VtClassAt, IsSubclass.
- Layout: a class that introduces a vptr reserves 8 bytes;
  Computation in ComputeOffsets/TypeSizeD.
- QbeGen: VtRef, EmitVTables (data $vt_<t> = { l $Method_uid, ... };
  unimplemented -> l 0), VirtCallBegin (load vptr, fetch slot, indirect
  call), vptr init in DeclRec (static class vars) and InitHeap (NEW).
- M2.atg: ArgList dispatches through the vtable when the method is
  virtual; Assignable allows POINTER TO Derived -> POINTER TO Base.
- tests: t_virtual (3) -- a Shape pointer holds a Circle then a Square
  and dispatches to each override. Suite 143/143.
- Fixpoint OK (2,310,300 bytes).

compiler/run_tests.sh

@@ -79,6 +79,7 @@ expect_run t_setchar.mod 77
 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_fail t_bad_parent.mod "undeclared identifier"
 expect_run showcase3.mod 183

compiler/src/M2.atg

@@ -1113,6 +1113,7 @@ PRODUCTIONS
           want: BOOLEAN; methCls: SymTab.TypeIndex;
           VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
           VAR called: BOOLEAN>          (. VAR i, np: CARDINAL;
+                                             vs: INTEGER;
                                              res: SymTab.TypeIndex;
                                              mg: QbeGen.QVal;
                                              ok, ind, isMeth: BOOLEAN; .)
@@ -1123,15 +1124,25 @@ PRODUCTIONS
                                              SymTab.InvalidType;
                                            IF isMeth THEN
                                              (* class method: the
-                                                receiver is armed, so
-                                                CallBegin prepends it *)
+                                                receiver is armed.
+                                                Virtual -> dispatch
+                                                through the vtable;
+                                                otherwise a static
+                                                call. *)
                                              res := SymTab.ClassMethodRes(
                                                methCls, pn);
-                                             QbeGen.Mangled(pn,
-                                               SymTab.ClassMethodUid(
-                                               methCls, pn), mg);
-                                             QbeGen.CallBegin(mg, res, 0,
-                                               FALSE)
+                                             vs := SymTab.VirtSlot(
+                                               methCls, pn);
+                                             IF vs >= 0 THEN
+                                               QbeGen.VirtCallBegin(
+                                                 callee, vs, res)
+                                             ELSE
+                                               QbeGen.Mangled(pn,
+                                                 SymTab.ClassMethodUid(
+                                                 methCls, pn), mg);
+                                               QbeGen.CallBegin(mg, res, 0,
+                                                 FALSE)
+                                             END
                                            ELSIF SymTab.SymKind(pn) =
                                               SymTab.KindProc THEN
                                              res := SymTab.ProcRes(pn);

compiler/src/M2.lst

@@ -1130,1503 +1130,1514 @@ Listing:
  1113            want: BOOLEAN; methCls: SymTab.TypeIndex;
  1114            VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
  1115            VAR called: BOOLEAN>          (. VAR i, np: CARDINAL;
- 1116                                               res: SymTab.TypeIndex;
- 1117                                               mg: QbeGen.QVal;
- 1118                                               ok, ind, isMeth: BOOLEAN; .)
- 1119      = "("                               (. called := TRUE;
- 1120                                             ok := TRUE;
- 1121                                             ind := FALSE;
- 1122                                             isMeth := methCls #
- 1123                                               SymTab.InvalidType;
- 1124                                             IF isMeth THEN
- 1125                                               (* class method: the
- 1126                                                  receiver is armed, so
- 1127                                                  CallBegin prepends it *)
- 1128                                               res := SymTab.ClassMethodRes(
- 1129                                                 methCls, pn);
- 1130                                               QbeGen.Mangled(pn,
- 1131                                                 SymTab.ClassMethodUid(
- 1132                                                 methCls, pn), mg);
- 1133                                               QbeGen.CallBegin(mg, res, 0,
- 1134                                                 FALSE)
- 1135                                             ELSIF SymTab.SymKind(pn) =
- 1136                                                SymTab.KindProc THEN
- 1137                                               res := SymTab.ProcRes(pn);
- 1138                                               QbeGen.Mangled(pn,
- 1139                                                 SymTab.ProcUid(pn), mg);
- 1140                                               QbeGen.CallBegin(mg, res,
- 1141                                                 SymTab.ProcDepthOf(pn),
- 1142                                                 SymTab.IsExternal(pn))
- 1143                                             ELSIF (pt # SymTab.InvalidType)
- 1144    AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
- 1145                                               ind := TRUE;
- 1146                                               res :=
- 1147                                                 SymTab.ProcTypeRes(pt);
- 1148                                               QbeGen.CallBeginInd(callee,
- 1149                                                 res, FALSE)
- 1150                                             ELSE SemError(233);
- 1151                                               ok := FALSE;
- 1152                                               res := SymTab.InvalidType
- 1153                                             END;
- 1154                                             i := 0; .)
- 1155        [ ActParam<pn, pt, ind, methCls, i>        (. INC(i); .)
- 1156          { "," ActParam<pn, pt, ind, methCls, i>  (. INC(i); .) } ]
- 1157        ")"                               (. IF ok THEN
- 1158                                               IF isMeth THEN
- 1159                                                 np := SymTab.ClassMethodNPar(
- 1160                                                   methCls, pn)
- 1161                                               ELSIF ind THEN
- 1162                                                 np := SymTab.ProcTypeNPar(pt)
- 1163                                               ELSE np := SymTab.ProcNPar(pn)
- 1164                                               END;
- 1165                                               IF i # np THEN
- 1166                                                 SemError(233); ok := FALSE
- 1167                                               END
- 1168                                             END;
- 1169                                             IF NOT ok THEN
- 1170                                               t := SymTab.InvalidType;
- 1171                                               QbeGen.CopyOp("0", q)
- 1172                                             ELSIF want THEN
- 1173                                               IF res =
- 1174                                                  SymTab.InvalidType THEN
- 1175                                                 SemError(233);
- 1176                                                 t := SymTab.InvalidType;
- 1177                                                 QbeGen.CopyOp("0", q)
- 1178                                               ELSE t := res;
- 1179                                                 QbeGen.CallEnd(TRUE, q)
- 1180                                               END
- 1181                                             ELSE
- 1182                                               IF res #
- 1183                                                  SymTab.InvalidType THEN
- 1184                                                 SemError(233)
- 1185                                               END;
- 1186                                               t := SymTab.InvalidType;
- 1187                                               QbeGen.CopyOp("0", q);
- 1188                                               QbeGen.CallEnd(FALSE, q)
- 1189                                             END; .) .
- 1190    (* One actual: VAR formals take recorded designator addresses
- 1191       (233 otherwise); value formals take converted expressions. *)
- 1192    ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
- 1193             methCls: SymTab.TypeIndex; i: CARDINAL>
- 1194                                          (. VAR at, ft: SymTab.TypeIndex;
- 1195                                               qe, qa, qt: QbeGen.QVal;
- 1196                                               isV, conv: BOOLEAN; .)
- 1197      = Expr<at, qe>                      (. IF ind THEN
- 1198                                               ft :=
- 1199                                                 SymTab.ProcTypeParamType(pt,
- 1200                                                   i);
- 1201                                               isV :=
- 1202                                                 SymTab.ProcTypeParamIsVar(pt,
- 1203                                                   i)
- 1204                                             ELSIF methCls #
- 1205                                                SymTab.InvalidType THEN
- 1206                                               ft :=
- 1207                                                 SymTab.ClassMethodParamType(
- 1208                                                 methCls, pn, i);
- 1209                                               isV :=
- 1210                                                 SymTab.ClassMethodParamIsVar(
- 1211                                                 methCls, pn, i)
- 1212                                             ELSE
- 1213                                               ft := SymTab.ParamType(pn, i);
- 1214                                               isV := SymTab.ParamIsVar(pn, i)
- 1215                                             END;
- 1216                                             IF (at = SymTab.InvalidType)
- 1217                                                OR (ft =
- 1218                                                   SymTab.InvalidType) THEN
- 1219                                             ELSIF isV THEN
- 1220                                               IF (SymTab.ClassOf(at)
- 1221                                                  = SymTab.ClChar)
- 1222    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1223    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1224         = SymTab.ClChar)
- 1225    AND QbeGen.IsImm(qe) THEN
- 1226                                                 (* 1-char string
- 1227                                                    literal passed to
- 1228                                                    a VAR ARRAY OF CHAR *)
- 1229                                                 QbeGen.DeclCharStr(qe,
- 1230                                                      qa);
- 1231                                                 IF NOT QbeGen.CallArg(qa,
- 1232                                                    "l") THEN
- 1233                                                   SemError(233)
- 1234                                                 END
- 1235                                               ELSIF NOT QbeGen.AddrOfVal(qe,
- 1236                                                    qa) THEN
- 1237                                                 SemError(233)
- 1238                                               ELSIF NOT SymTab.VarParamOk(at,
- 1239                                                        ft) THEN
- 1240                                                 SemError(233)
- 1241                                               ELSIF NOT QbeGen.CallArg(qa,
- 1242                                                        "l") THEN
- 1243                                                 SemError(233)
- 1244                                               END
- 1245                                             ELSE
- 1246                                               IF (SymTab.ClassOf(at)
- 1247                                                  = SymTab.ClChar)
- 1248    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1249    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1250         = SymTab.ClChar)
- 1251    AND QbeGen.IsImm(qe) THEN
- 1252                                                 (* 1-char string
- 1253                                                    literal passed to
- 1254                                                    ARRAY OF CHAR *)
- 1255                                                 QbeGen.DeclCharStr(qe,
- 1256                                                      qa);
- 1257                                                 IF NOT QbeGen.CallArg(qa,
- 1258                                                    "l") THEN
- 1259                                                   SemError(233)
- 1260                                                 END
- 1261                                               ELSIF NOT SymTab.Assignable(at,
- 1262                                                    ft) THEN
- 1263                                                 SemError(233)
- 1264                                               ELSE
- 1265                                                 conv := (SymTab.ClassOf(
- 1266                                                   ft) = SymTab.ClReal)
- 1267   AND SymTab.IsIntFamily(at);
- 1268                                                 IF conv THEN
- 1269                                                   QbeGen.ConvIR(qe, qt);
- 1270                                                   IF NOT QbeGen.CallArg(qt,
- 1271                                                      "d") THEN
- 1272                                                     SemError(233)
- 1273                                                   END
- 1274                                                 ELSIF NOT QbeGen.CallArg(qe,
- 1275                                                   QbeGen.ArgClass(ft)) THEN
- 1276                                                   SemError(233)
- 1277                                                 END
- 1278                                               END
- 1279                                             END; .) .
- 1280    IfStat                                (. VAR t: SymTab.TypeIndex;
- 1281                                               q, lThen, lElse, lEnd:
- 1282                                                 QbeGen.QVal;
- 1283                                               hasElse: BOOLEAN; .)
- 1284      = "IF"                              (. hasElse := FALSE; .)
- 1285        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
- 1286                                               SemError(214) END;
- 1287                                             QbeGen.NewLabel(lThen);
- 1288                                             QbeGen.NewLabel(lElse);
- 1289                                             QbeGen.NewLabel(lEnd);
- 1290                                             QbeGen.Jnz(q, lThen, lElse);
- 1291                                             QbeGen.EmitLabel(lThen); .)
- 1292        "THEN" [ StatSeq ]                (. QbeGen.Jmp(lEnd); .)
- 1293        { "ELSIF"                         (. QbeGen.EmitLabel(lElse);
- 1294                                             QbeGen.NewLabel(lElse); .)
- 1295          Expr<t, q>                      (. IF NOT SymTab.BoolCheck(t) THEN
- 1296                                               SemError(214) END;
- 1297                                             QbeGen.NewLabel(lThen);
- 1298                                             QbeGen.Jnz(q, lThen, lElse);
- 1299                                             QbeGen.EmitLabel(lThen); .)
- 1300          "THEN" [ StatSeq ]              (. QbeGen.Jmp(lEnd); .) }
- 1301        [ "ELSE"                          (. QbeGen.EmitLabel(lElse);
- 1302                                             hasElse := TRUE; .)
- 1303          [ StatSeq ] ]
- 1304        "END"                             (. IF hasElse THEN
- 1305                                               QbeGen.EmitLabel(lEnd)
- 1306                                             ELSE QbeGen.EmitLabel(lElse);
- 1307                                               QbeGen.EmitLabel(lEnd)
- 1308                                             END; .) .
- 1309    WhileStat                             (. VAR t: SymTab.TypeIndex;
- 1310                                               q, lTop, lBody, lEnd:
- 1311                                                 QbeGen.QVal; .)
- 1312      = "WHILE"                           (. QbeGen.NewLabel(lTop);
- 1313                                             QbeGen.NewLabel(lBody);
- 1314                                             QbeGen.NewLabel(lEnd);
- 1315                                             QbeGen.EmitLabel(lTop); .)
- 1316        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
- 1317                                               SemError(214) END;
- 1318                                             QbeGen.Jnz(q, lBody, lEnd);
- 1319                                             QbeGen.EmitLabel(lBody); .)
- 1320        "DO" [ StatSeq ]                      (. QbeGen.Jmp(lTop); .)
- 1321        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
- 1322    RepeatStat                            (. VAR t: SymTab.TypeIndex;
- 1323                                               q, lTop, lEnd: QbeGen.QVal; .)
- 1324      = "REPEAT"                          (. QbeGen.NewLabel(lTop);
+ 1116                                               vs: INTEGER;
+ 1117                                               res: SymTab.TypeIndex;
+ 1118                                               mg: QbeGen.QVal;
+ 1119                                               ok, ind, isMeth: BOOLEAN; .)
+ 1120      = "("                               (. called := TRUE;
+ 1121                                             ok := TRUE;
+ 1122                                             ind := FALSE;
+ 1123                                             isMeth := methCls #
+ 1124                                               SymTab.InvalidType;
+ 1125                                             IF isMeth THEN
+ 1126                                               (* class method: the
+ 1127                                                  receiver is armed.
+ 1128                                                  Virtual -> dispatch
+ 1129                                                  through the vtable;
+ 1130                                                  otherwise a static
+ 1131                                                  call. *)
+ 1132                                               res := SymTab.ClassMethodRes(
+ 1133                                                 methCls, pn);
+ 1134                                               vs := SymTab.VirtSlot(
+ 1135                                                 methCls, pn);
+ 1136                                               IF vs >= 0 THEN
+ 1137                                                 QbeGen.VirtCallBegin(
+ 1138                                                   callee, vs, res)
+ 1139                                               ELSE
+ 1140                                                 QbeGen.Mangled(pn,
+ 1141                                                   SymTab.ClassMethodUid(
+ 1142                                                   methCls, pn), mg);
+ 1143                                                 QbeGen.CallBegin(mg, res, 0,
+ 1144                                                   FALSE)
+ 1145                                               END
+ 1146                                             ELSIF SymTab.SymKind(pn) =
+ 1147                                                SymTab.KindProc THEN
+ 1148                                               res := SymTab.ProcRes(pn);
+ 1149                                               QbeGen.Mangled(pn,
+ 1150                                                 SymTab.ProcUid(pn), mg);
+ 1151                                               QbeGen.CallBegin(mg, res,
+ 1152                                                 SymTab.ProcDepthOf(pn),
+ 1153                                                 SymTab.IsExternal(pn))
+ 1154                                             ELSIF (pt # SymTab.InvalidType)
+ 1155    AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
+ 1156                                               ind := TRUE;
+ 1157                                               res :=
+ 1158                                                 SymTab.ProcTypeRes(pt);
+ 1159                                               QbeGen.CallBeginInd(callee,
+ 1160                                                 res, FALSE)
+ 1161                                             ELSE SemError(233);
+ 1162                                               ok := FALSE;
+ 1163                                               res := SymTab.InvalidType
+ 1164                                             END;
+ 1165                                             i := 0; .)
+ 1166        [ ActParam<pn, pt, ind, methCls, i>        (. INC(i); .)
+ 1167          { "," ActParam<pn, pt, ind, methCls, i>  (. INC(i); .) } ]
+ 1168        ")"                               (. IF ok THEN
+ 1169                                               IF isMeth THEN
+ 1170                                                 np := SymTab.ClassMethodNPar(
+ 1171                                                   methCls, pn)
+ 1172                                               ELSIF ind THEN
+ 1173                                                 np := SymTab.ProcTypeNPar(pt)
+ 1174                                               ELSE np := SymTab.ProcNPar(pn)
+ 1175                                               END;
+ 1176                                               IF i # np THEN
+ 1177                                                 SemError(233); ok := FALSE
+ 1178                                               END
+ 1179                                             END;
+ 1180                                             IF NOT ok THEN
+ 1181                                               t := SymTab.InvalidType;
+ 1182                                               QbeGen.CopyOp("0", q)
+ 1183                                             ELSIF want THEN
+ 1184                                               IF res =
+ 1185                                                  SymTab.InvalidType THEN
+ 1186                                                 SemError(233);
+ 1187                                                 t := SymTab.InvalidType;
+ 1188                                                 QbeGen.CopyOp("0", q)
+ 1189                                               ELSE t := res;
+ 1190                                                 QbeGen.CallEnd(TRUE, q)
+ 1191                                               END
+ 1192                                             ELSE
+ 1193                                               IF res #
+ 1194                                                  SymTab.InvalidType THEN
+ 1195                                                 SemError(233)
+ 1196                                               END;
+ 1197                                               t := SymTab.InvalidType;
+ 1198                                               QbeGen.CopyOp("0", q);
+ 1199                                               QbeGen.CallEnd(FALSE, q)
+ 1200                                             END; .) .
+ 1201    (* One actual: VAR formals take recorded designator addresses
+ 1202       (233 otherwise); value formals take converted expressions. *)
+ 1203    ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
+ 1204             methCls: SymTab.TypeIndex; i: CARDINAL>
+ 1205                                          (. VAR at, ft: SymTab.TypeIndex;
+ 1206                                               qe, qa, qt: QbeGen.QVal;
+ 1207                                               isV, conv: BOOLEAN; .)
+ 1208      = Expr<at, qe>                      (. IF ind THEN
+ 1209                                               ft :=
+ 1210                                                 SymTab.ProcTypeParamType(pt,
+ 1211                                                   i);
+ 1212                                               isV :=
+ 1213                                                 SymTab.ProcTypeParamIsVar(pt,
+ 1214                                                   i)
+ 1215                                             ELSIF methCls #
+ 1216                                                SymTab.InvalidType THEN
+ 1217                                               ft :=
+ 1218                                                 SymTab.ClassMethodParamType(
+ 1219                                                 methCls, pn, i);
+ 1220                                               isV :=
+ 1221                                                 SymTab.ClassMethodParamIsVar(
+ 1222                                                 methCls, pn, i)
+ 1223                                             ELSE
+ 1224                                               ft := SymTab.ParamType(pn, i);
+ 1225                                               isV := SymTab.ParamIsVar(pn, i)
+ 1226                                             END;
+ 1227                                             IF (at = SymTab.InvalidType)
+ 1228                                                OR (ft =
+ 1229                                                   SymTab.InvalidType) THEN
+ 1230                                             ELSIF isV THEN
+ 1231                                               IF (SymTab.ClassOf(at)
+ 1232                                                  = SymTab.ClChar)
+ 1233    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+ 1234    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
+ 1235         = SymTab.ClChar)
+ 1236    AND QbeGen.IsImm(qe) THEN
+ 1237                                                 (* 1-char string
+ 1238                                                    literal passed to
+ 1239                                                    a VAR ARRAY OF CHAR *)
+ 1240                                                 QbeGen.DeclCharStr(qe,
+ 1241                                                      qa);
+ 1242                                                 IF NOT QbeGen.CallArg(qa,
+ 1243                                                    "l") THEN
+ 1244                                                   SemError(233)
+ 1245                                                 END
+ 1246                                               ELSIF NOT QbeGen.AddrOfVal(qe,
+ 1247                                                    qa) THEN
+ 1248                                                 SemError(233)
+ 1249                                               ELSIF NOT SymTab.VarParamOk(at,
+ 1250                                                        ft) THEN
+ 1251                                                 SemError(233)
+ 1252                                               ELSIF NOT QbeGen.CallArg(qa,
+ 1253                                                        "l") THEN
+ 1254                                                 SemError(233)
+ 1255                                               END
+ 1256                                             ELSE
+ 1257                                               IF (SymTab.ClassOf(at)
+ 1258                                                  = SymTab.ClChar)
+ 1259    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+ 1260    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
+ 1261         = SymTab.ClChar)
+ 1262    AND QbeGen.IsImm(qe) THEN
+ 1263                                                 (* 1-char string
+ 1264                                                    literal passed to
+ 1265                                                    ARRAY OF CHAR *)
+ 1266                                                 QbeGen.DeclCharStr(qe,
+ 1267                                                      qa);
+ 1268                                                 IF NOT QbeGen.CallArg(qa,
+ 1269                                                    "l") THEN
+ 1270                                                   SemError(233)
+ 1271                                                 END
+ 1272                                               ELSIF NOT SymTab.Assignable(at,
+ 1273                                                    ft) THEN
+ 1274                                                 SemError(233)
+ 1275                                               ELSE
+ 1276                                                 conv := (SymTab.ClassOf(
+ 1277                                                   ft) = SymTab.ClReal)
+ 1278   AND SymTab.IsIntFamily(at);
+ 1279                                                 IF conv THEN
+ 1280                                                   QbeGen.ConvIR(qe, qt);
+ 1281                                                   IF NOT QbeGen.CallArg(qt,
+ 1282                                                      "d") THEN
+ 1283                                                     SemError(233)
+ 1284                                                   END
+ 1285                                                 ELSIF NOT QbeGen.CallArg(qe,
+ 1286                                                   QbeGen.ArgClass(ft)) THEN
+ 1287                                                   SemError(233)
+ 1288                                                 END
+ 1289                                               END
+ 1290                                             END; .) .
+ 1291    IfStat                                (. VAR t: SymTab.TypeIndex;
+ 1292                                               q, lThen, lElse, lEnd:
+ 1293                                                 QbeGen.QVal;
+ 1294                                               hasElse: BOOLEAN; .)
+ 1295      = "IF"                              (. hasElse := FALSE; .)
+ 1296        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
+ 1297                                               SemError(214) END;
+ 1298                                             QbeGen.NewLabel(lThen);
+ 1299                                             QbeGen.NewLabel(lElse);
+ 1300                                             QbeGen.NewLabel(lEnd);
+ 1301                                             QbeGen.Jnz(q, lThen, lElse);
+ 1302                                             QbeGen.EmitLabel(lThen); .)
+ 1303        "THEN" [ StatSeq ]                (. QbeGen.Jmp(lEnd); .)
+ 1304        { "ELSIF"                         (. QbeGen.EmitLabel(lElse);
+ 1305                                             QbeGen.NewLabel(lElse); .)
+ 1306          Expr<t, q>                      (. IF NOT SymTab.BoolCheck(t) THEN
+ 1307                                               SemError(214) END;
+ 1308                                             QbeGen.NewLabel(lThen);
+ 1309                                             QbeGen.Jnz(q, lThen, lElse);
+ 1310                                             QbeGen.EmitLabel(lThen); .)
+ 1311          "THEN" [ StatSeq ]              (. QbeGen.Jmp(lEnd); .) }
+ 1312        [ "ELSE"                          (. QbeGen.EmitLabel(lElse);
+ 1313                                             hasElse := TRUE; .)
+ 1314          [ StatSeq ] ]
+ 1315        "END"                             (. IF hasElse THEN
+ 1316                                               QbeGen.EmitLabel(lEnd)
+ 1317                                             ELSE QbeGen.EmitLabel(lElse);
+ 1318                                               QbeGen.EmitLabel(lEnd)
+ 1319                                             END; .) .
+ 1320    WhileStat                             (. VAR t: SymTab.TypeIndex;
+ 1321                                               q, lTop, lBody, lEnd:
+ 1322                                                 QbeGen.QVal; .)
+ 1323      = "WHILE"                           (. QbeGen.NewLabel(lTop);
+ 1324                                             QbeGen.NewLabel(lBody);
  1325                                             QbeGen.NewLabel(lEnd);
  1326                                             QbeGen.EmitLabel(lTop); .)
- 1327        [ StatSeq ]
- 1328        "UNTIL" Expr<t, q>                (. IF NOT SymTab.BoolCheck(t) THEN
- 1329                                               SemError(214) END;
- 1330                                             QbeGen.Jnz(q, lEnd, lTop);
- 1331                                             QbeGen.EmitLabel(lEnd); .) .
- 1332    LoopStat                              (. VAR lTop, lEnd: QbeGen.QVal; .)
- 1333      = "LOOP"                            (. QbeGen.NewLabel(lTop);
- 1334                                             QbeGen.NewLabel(lEnd);
- 1335                                             QbeGen.PushLoop(lEnd);
- 1336                                             QbeGen.EmitLabel(lTop); .)
- 1337        [ StatSeq ]
- 1338        "END"                             (. QbeGen.Jmp(lTop);
- 1339                                             QbeGen.PopLoop;
- 1340                                             QbeGen.EmitLabel(lEnd); .) .
- 1341    (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
- 1342       Runtime direction would need a compare-select; the literal
- 1343       sign picks cslew/csegew at "DO" time. *)
- 1344    ForStat                               (. VAR lv: SymTab.Name;
- 1345                                               tlo, thi, tby:
- 1346                                                 SymTab.TypeIndex;
- 1347                                               qlo, qhi, qby, qt, qk, qb:
- 1348                                                 QbeGen.QVal;
- 1349                                               lTop, lBody, lEnd:
- 1350                                                 QbeGen.QVal;
- 1351                                               by: INTEGER;
- 1352                                               ok: BOOLEAN; .)
- 1353      = "FOR"                             (. by := 1; .)
- 1354        GetIdent<lv>                      (. ok := SymTab.Lookup(lv);
- 1355                                             IF NOT ok THEN
- 1356                                               SemError(201)
- 1357                                             ELSIF (SymTab.SymKind(lv) #
- 1358                                                    SymTab.KindVar)
- 1359   AND (SymTab.SymKind(lv) #
- 1360                                                   SymTab.KindParam) THEN
- 1361                                               SemError(220); ok := FALSE
- 1362                                             ELSIF NOT SymTab.IsIntFamily(
- 1363                                                     SymTab.SymType(lv)) THEN
- 1364                                               SemError(220); ok := FALSE
- 1365                                             END; .)
- 1366        ":=" Expr<tlo, qlo>               (. IF NOT SymTab.IsIntFamily(tlo) THEN
- 1367                                               SemError(220); ok := FALSE
- 1368                                             END; .)
- 1369        "TO" Expr<thi, qhi>               (. IF NOT SymTab.IsIntFamily(thi) THEN
- 1370                                               SemError(220); ok := FALSE
- 1371                                             END; .)
- 1372        [ "BY" Expr<tby, qby>             (. IF (tby #
- 1373                                               SymTab.InvalidType)
- 1374   AND NOT SymTab.IsIntFamily(tby) THEN
+ 1327        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
+ 1328                                               SemError(214) END;
+ 1329                                             QbeGen.Jnz(q, lBody, lEnd);
+ 1330                                             QbeGen.EmitLabel(lBody); .)
+ 1331        "DO" [ StatSeq ]                      (. QbeGen.Jmp(lTop); .)
+ 1332        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
+ 1333    RepeatStat                            (. VAR t: SymTab.TypeIndex;
+ 1334                                               q, lTop, lEnd: QbeGen.QVal; .)
+ 1335      = "REPEAT"                          (. QbeGen.NewLabel(lTop);
+ 1336                                             QbeGen.NewLabel(lEnd);
+ 1337                                             QbeGen.EmitLabel(lTop); .)
+ 1338        [ StatSeq ]
+ 1339        "UNTIL" Expr<t, q>                (. IF NOT SymTab.BoolCheck(t) THEN
+ 1340                                               SemError(214) END;
+ 1341                                             QbeGen.Jnz(q, lEnd, lTop);
+ 1342                                             QbeGen.EmitLabel(lEnd); .) .
+ 1343    LoopStat                              (. VAR lTop, lEnd: QbeGen.QVal; .)
+ 1344      = "LOOP"                            (. QbeGen.NewLabel(lTop);
+ 1345                                             QbeGen.NewLabel(lEnd);
+ 1346                                             QbeGen.PushLoop(lEnd);
+ 1347                                             QbeGen.EmitLabel(lTop); .)
+ 1348        [ StatSeq ]
+ 1349        "END"                             (. QbeGen.Jmp(lTop);
+ 1350                                             QbeGen.PopLoop;
+ 1351                                             QbeGen.EmitLabel(lEnd); .) .
+ 1352    (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
+ 1353       Runtime direction would need a compare-select; the literal
+ 1354       sign picks cslew/csegew at "DO" time. *)
+ 1355    ForStat                               (. VAR lv: SymTab.Name;
+ 1356                                               tlo, thi, tby:
+ 1357                                                 SymTab.TypeIndex;
+ 1358                                               qlo, qhi, qby, qt, qk, qb:
+ 1359                                                 QbeGen.QVal;
+ 1360                                               lTop, lBody, lEnd:
+ 1361                                                 QbeGen.QVal;
+ 1362                                               by: INTEGER;
+ 1363                                               ok: BOOLEAN; .)
+ 1364      = "FOR"                             (. by := 1; .)
+ 1365        GetIdent<lv>                      (. ok := SymTab.Lookup(lv);
+ 1366                                             IF NOT ok THEN
+ 1367                                               SemError(201)
+ 1368                                             ELSIF (SymTab.SymKind(lv) #
+ 1369                                                    SymTab.KindVar)
+ 1370   AND (SymTab.SymKind(lv) #
+ 1371                                                   SymTab.KindParam) THEN
+ 1372                                               SemError(220); ok := FALSE
+ 1373                                             ELSIF NOT SymTab.IsIntFamily(
+ 1374                                                     SymTab.SymType(lv)) THEN
  1375                                               SemError(220); ok := FALSE
- 1376                                             END;
- 1377                                             IF NOT SymTab.ConstInt(qby, by) THEN
- 1378                                               SemError(230); by := 1
- 1379                                             ELSIF by = 0 THEN
- 1380                                               SemError(220); by := 1
- 1381                                             END; .) ]
- 1382        "DO"                              (. IF ok THEN
- 1383                                               QbeGen.StoreVar(lv, qlo,
- 1384                                                 FALSE) END;
- 1385                                             QbeGen.NewLabel(lTop);
- 1386                                             QbeGen.NewLabel(lBody);
- 1387                                             QbeGen.NewLabel(lEnd);
- 1388                                             QbeGen.EmitLabel(lTop);
- 1389                                             QbeGen.LoadVar(lv, FALSE, qt);
- 1390                                             QbeGen.NewTemp(qk);
- 1391                                             IF by > 0 THEN
- 1392                                               QbeGen.Op3("cslew", qk,
- 1393                                                 qt, qhi, FALSE)
- 1394                                             ELSE QbeGen.Op3("csgew", qk,
- 1395                                               qt, qhi, FALSE)
- 1396                                             END;
- 1397                                             QbeGen.Jnz(qk, lBody, lEnd);
- 1398                                             QbeGen.EmitLabel(lBody); .)
- 1399        [ StatSeq ]
- 1400        "END"                             (. IF ok THEN
- 1401                                               QbeGen.LoadVar(lv, FALSE,
- 1402                                                 qt);
- 1403                                               QbeGen.IntStr(by, qb);
- 1404                                               QbeGen.NewTemp(qk);
- 1405                                               QbeGen.Op3("add", qk,
- 1406                                                 qt, qb, FALSE);
- 1407                                               QbeGen.StoreVar(lv, qk,
- 1408                                                 FALSE) END;
- 1409                                             QbeGen.Jmp(lTop);
- 1410                                             QbeGen.EmitLabel(lEnd); .) .
- 1411    CaseStat                              (. VAR tsel: SymTab.TypeIndex;
- 1412                                               qsel, lEnd: QbeGen.QVal; .)
- 1413      = "CASE" Expr<tsel, qsel>           (. QbeGen.NewLabel(lEnd); .)
- 1414        "OF" CaseAlt<tsel, qsel, lEnd>
- 1415        { "|" CaseAlt<tsel, qsel, lEnd> }
- 1416        [ "ELSE" [ StatSeq ] ]
- 1417        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
- 1418    (* Compare-chain lowering: each alternative ends its match-tests
- 1419       with "jmp lAfter", so the no-match fallthrough skips the body:
- 1420       "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
- 1421       lAfter:". Falls into the next alternative, ELSE, or END. *)
- 1422    CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1423            lEnd: QbeGen.QVal>            (. VAR lBody, lAfter: QbeGen.QVal; .)
- 1424      =                                   (. QbeGen.NewLabel(lBody);
- 1425                                             QbeGen.NewLabel(lAfter); .)
- 1426        CaseLabel<tsel, qsel, lBody>
- 1427        { "," CaseLabel<tsel, qsel, lBody> }
- 1428        ":"                               (. QbeGen.Jmp(lAfter);
- 1429                                             QbeGen.EmitLabel(lBody); .)
- 1430        [ StatSeq ]                       (. QbeGen.Jmp(lEnd);
- 1431                                             QbeGen.EmitLabel(lAfter); .) .
- 1432    CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1433              lBody: QbeGen.QVal>         (. VAR t2, t3: SymTab.TypeIndex;
- 1434                                               q2, q3, qc, qd, qe:
- 1435                                                 QbeGen.QVal;
- 1436                                               lNext: QbeGen.QVal; .)
- 1437      = Expr<t2, q2>                      (. IF (t2 #
- 1438                                               SymTab.InvalidType)
- 1439   AND (tsel #
- 1440                                                 SymTab.InvalidType)
- 1441   AND ((SymTab.ClassOf(t2) =
- 1442                                                  SymTab.ClSet)
- 1443                                                 OR (SymTab.ClassOf(tsel) =
- 1444                                                     SymTab.ClSet)) THEN
- 1445                                               SemError(230)
- 1446                                             ELSIF (t2 #
- 1447                                               SymTab.InvalidType)
- 1448   AND (tsel #
- 1449                                                 SymTab.InvalidType)
- 1450   AND NOT SymTab.EqCheck(t2,
- 1451                                                   tsel) THEN
- 1452                                               SemError(213) END;
- 1453                                             IF NOT QbeGen.IsImm(q2) THEN
- 1454                                               SemError(230);
- 1455                                               QbeGen.CopyOp("0", q2)
- 1456                                             END;
- 1457                                             QbeGen.NewLabel(lNext);
- 1458                                             QbeGen.Cmp(SymTab.OpEq,
- 1459                                               qsel, q2, qc, FALSE);
- 1460                                             QbeGen.Jnz(qc, lBody, lNext);
- 1461                                             QbeGen.EmitLabel(lNext); .)
- 1462        [ ".." Expr<t3, q3>               (. IF (t3 #
- 1463                                               SymTab.InvalidType)
- 1464   AND (tsel #
- 1465                                                 SymTab.InvalidType)
- 1466   AND NOT SymTab.EqCheck(t3,
- 1467                                                   tsel) THEN
- 1468                                               SemError(213) END;
- 1469                                             IF NOT QbeGen.IsImm(q3) THEN
- 1470                                               SemError(230);
- 1471                                               QbeGen.CopyOp("0", q3)
- 1472                                             END;
- 1473                                             QbeGen.Cmp(SymTab.OpGe,
- 1474                                               qsel, q2, qc, FALSE);
- 1475                                             QbeGen.Cmp(SymTab.OpLe,
- 1476                                               qsel, q3, qd, FALSE);
- 1477                                             QbeGen.NewTemp(qe);
- 1478                                             QbeGen.Op3("and", qe, qc, qd,
- 1479                                               FALSE);
- 1480                                             QbeGen.NewLabel(lNext);
- 1481                                             QbeGen.Jnz(qe, lBody, lNext);
- 1482                                             QbeGen.EmitLabel(lNext); .) ] .
- 1483    ReturnStat                            (. VAR t: SymTab.TypeIndex;
- 1484                                               q, qt: QbeGen.QVal;
- 1485                                               res: SymTab.TypeIndex;
- 1486                                               hadE, conv: BOOLEAN; .)
- 1487      = "RETURN"                          (. hadE := FALSE; .)
- 1488        [ Expr<t, q>                      (. hadE := TRUE; .) ]
- 1489                                          (. conv := FALSE;
- 1490                                             IF NOT SymTab.InProc() THEN
- 1491                                               SemError(232)
- 1492                                             ELSE res := SymTab.CurRes();
- 1493                                               IF NOT hadE THEN
- 1494                                                 IF res #
- 1495                                                    SymTab.InvalidType THEN
- 1496                                                   SemError(232)
- 1497                                                 ELSE QbeGen.EmitRet(q,
- 1498                                                   FALSE)
- 1499                                                 END
- 1500                                               ELSIF (res =
- 1501                                                      SymTab.InvalidType)
- 1502                                                  OR (t #
- 1503                                                      SymTab.InvalidType)
- 1504   AND NOT SymTab.Assignable(t,
- 1505                                                       res) THEN
- 1506                                                 SemError(232)
- 1507                                               ELSE
- 1508                                                 conv := (SymTab.ClassOf(
- 1509                                                   res) = SymTab.ClReal)
- 1510   AND SymTab.IsIntFamily(t);
- 1511                                                 IF conv THEN
- 1512                                                   QbeGen.ConvIR(q, qt);
- 1513                                                   QbeGen.EmitRet(qt, TRUE)
- 1514                                                 ELSE QbeGen.EmitRet(q, TRUE)
- 1515                                                 END
- 1516                                               END
- 1517                                             END; .) .
- 1518    HaltStat                              (. VAR t: SymTab.TypeIndex;
- 1519                                               q: QbeGen.QVal; .)
- 1520      = "HALT" [ "(" Expr<t, q> ")" ]     (. QbeGen.HaltQ; .) .
- 1521    (* Designator: scalar loads, array addresses, and index suffixes.
- 1522       Each index descends one level (bounds-checked, trap on breach);
- 1523       nested levels reload the inner descriptor address. q ends as the
- 1524       value (scalars), the descriptor address (plain arrays), or the
- 1525       element address (indexed); sfx marks the indexed form. *)
- 1526    Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
- 1527           VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
- 1528                                          (. VAR n, fn, mal: SymTab.Name;
- 1529                                               cls: INTEGER;
- 1530                                               curT, it, eT, bt:
- 1531                                                 SymTab.TypeIndex;
- 1532                                               iq, ql, qlo, qhi, qe:
- 1533                                                 QbeGen.QVal;
- 1534                                               lo, hi: INTEGER;
- 1535                                               fo: INTEGER;
- 1536                                               isOpen: BOOLEAN;
- 1537                                               qb, cv: QbeGen.QVal; .)
- 1538      = GetIdent<n>                       (. methCls := SymTab.InvalidType;
- 1539                                             QbeGen.CopyOp(n, qn);
- 1540                                             sfx := FALSE;
- 1541                                             IF NOT SymTab.Lookup(n) THEN
- 1542                                               SemError(201);
- 1543                                               t := SymTab.InvalidType;
- 1544                                               k := -1;
- 1545                                               QbeGen.CopyOp("0", q)
- 1546                                             ELSE
- 1547                                               t := SymTab.SymType(n);
- 1548                                               k := SymTab.SymKind(n);
- 1549                                               IF k = SymTab.KindConst THEN
- 1550                                                 IF SymTab.Equal(n,
- 1551                                                    "TRUE") THEN
- 1552                                                   t := SymTab.BoolType();
- 1553                                                   QbeGen.CopyOp("1", q)
- 1554                                                 ELSIF SymTab.Equal(n,
- 1555                                                    "FALSE") THEN
- 1556                                                   t := SymTab.BoolType();
- 1557                                                   QbeGen.CopyOp("0", q)
- 1558                                                 ELSIF SymTab.Equal(n,
- 1559                                                    "NIL") THEN
- 1560                                                   QbeGen.CopyOp("0", q)
- 1561                                                 ELSE
- 1562                                                   cls :=
- 1563                                                     SymTab.ClassOf(t);
- 1564                                                   IF (t #
- 1565                                                       SymTab.InvalidType)
- 1566   AND ((cls = SymTab.ClInt)
- 1567                                                      OR (cls
- 1568                                                          = SymTab.ClChar)
- 1569                                                      OR (cls
- 1570                                                          = SymTab.ClEnum)
- 1571                                                      OR (cls
- 1572                                                          = SymTab.ClReal)
- 1573                                                      OR (cls
- 1574                                                          = SymTab.ClNil)) THEN
- 1575                                                     IF cls = SymTab.ClNil THEN
- 1576                                                       QbeGen.CopyOp("0", q)
- 1577                                                     ELSIF ((cls
- 1578                                                         = SymTab.ClInt)
- 1579                                                       OR (cls
- 1580                                                         = SymTab.ClChar)
- 1581                                                       OR (cls
- 1582                                                         = SymTab.ClEnum))
- 1583    AND SymTab.GetSymVal(n, cv)
- 1584    AND QbeGen.IsImm(cv) THEN
- 1585                                                       QbeGen.CopyOp(cv, q)
- 1586                                                     ELSE
- 1587                                                       QbeGen.LoadVar(n,
- 1588                                                         cls = SymTab.ClReal,
- 1589                                                         q)
- 1590                                                     END
- 1591                                                   ELSE
- 1592                                                     IF t #
- 1593                                                        SymTab.InvalidType THEN
- 1594                                                       SemError(230)
- 1595                                                     END;
- 1596                                                     QbeGen.CopyOp("0", q)
- 1597                                                   END
- 1598                                                 END
- 1599                                               ELSIF (k = SymTab.KindVar)
- 1600                                                  OR (k = SymTab.KindParam) THEN
- 1601                                                 cls :=
- 1602                                                   SymTab.ClassOf(t);
- 1603                                                 IF (cls = SymTab.ClInt)
- 1604                                                    OR (cls = SymTab.ClBool)
- 1605                                                    OR (cls = SymTab.ClChar)
- 1606                                                    OR (cls = SymTab.ClUChar)
- 1607                                                    OR (cls = SymTab.ClEnum)
- 1608                                                    OR (cls
- 1609                                                        = SymTab.ClReal) THEN
- 1610                                                   QbeGen.LoadVar(n,
- 1611                                                     cls = SymTab.ClReal, q)
- 1612                                                 ELSIF (cls = SymTab.ClPtr)
- 1613                                                    OR (cls = SymTab.ClProc) THEN
- 1614                                                   QbeGen.LoadPtr(n, q)
- 1615                                                 ELSIF cls = SymTab.ClLong THEN
- 1616                                                   QbeGen.LoadLong(n, q)
- 1617                                                 ELSIF (cls
- 1618                                                         = SymTab.ClArray)
+ 1376                                             END; .)
+ 1377        ":=" Expr<tlo, qlo>               (. IF NOT SymTab.IsIntFamily(tlo) THEN
+ 1378                                               SemError(220); ok := FALSE
+ 1379                                             END; .)
+ 1380        "TO" Expr<thi, qhi>               (. IF NOT SymTab.IsIntFamily(thi) THEN
+ 1381                                               SemError(220); ok := FALSE
+ 1382                                             END; .)
+ 1383        [ "BY" Expr<tby, qby>             (. IF (tby #
+ 1384                                               SymTab.InvalidType)
+ 1385   AND NOT SymTab.IsIntFamily(tby) THEN
+ 1386                                               SemError(220); ok := FALSE
+ 1387                                             END;
+ 1388                                             IF NOT SymTab.ConstInt(qby, by) THEN
+ 1389                                               SemError(230); by := 1
+ 1390                                             ELSIF by = 0 THEN
+ 1391                                               SemError(220); by := 1
+ 1392                                             END; .) ]
+ 1393        "DO"                              (. IF ok THEN
+ 1394                                               QbeGen.StoreVar(lv, qlo,
+ 1395                                                 FALSE) END;
+ 1396                                             QbeGen.NewLabel(lTop);
+ 1397                                             QbeGen.NewLabel(lBody);
+ 1398                                             QbeGen.NewLabel(lEnd);
+ 1399                                             QbeGen.EmitLabel(lTop);
+ 1400                                             QbeGen.LoadVar(lv, FALSE, qt);
+ 1401                                             QbeGen.NewTemp(qk);
+ 1402                                             IF by > 0 THEN
+ 1403                                               QbeGen.Op3("cslew", qk,
+ 1404                                                 qt, qhi, FALSE)
+ 1405                                             ELSE QbeGen.Op3("csgew", qk,
+ 1406                                               qt, qhi, FALSE)
+ 1407                                             END;
+ 1408                                             QbeGen.Jnz(qk, lBody, lEnd);
+ 1409                                             QbeGen.EmitLabel(lBody); .)
+ 1410        [ StatSeq ]
+ 1411        "END"                             (. IF ok THEN
+ 1412                                               QbeGen.LoadVar(lv, FALSE,
+ 1413                                                 qt);
+ 1414                                               QbeGen.IntStr(by, qb);
+ 1415                                               QbeGen.NewTemp(qk);
+ 1416                                               QbeGen.Op3("add", qk,
+ 1417                                                 qt, qb, FALSE);
+ 1418                                               QbeGen.StoreVar(lv, qk,
+ 1419                                                 FALSE) END;
+ 1420                                             QbeGen.Jmp(lTop);
+ 1421                                             QbeGen.EmitLabel(lEnd); .) .
+ 1422    CaseStat                              (. VAR tsel: SymTab.TypeIndex;
+ 1423                                               qsel, lEnd: QbeGen.QVal; .)
+ 1424      = "CASE" Expr<tsel, qsel>           (. QbeGen.NewLabel(lEnd); .)
+ 1425        "OF" CaseAlt<tsel, qsel, lEnd>
+ 1426        { "|" CaseAlt<tsel, qsel, lEnd> }
+ 1427        [ "ELSE" [ StatSeq ] ]
+ 1428        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
+ 1429    (* Compare-chain lowering: each alternative ends its match-tests
+ 1430       with "jmp lAfter", so the no-match fallthrough skips the body:
+ 1431       "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
+ 1432       lAfter:". Falls into the next alternative, ELSE, or END. *)
+ 1433    CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
+ 1434            lEnd: QbeGen.QVal>            (. VAR lBody, lAfter: QbeGen.QVal; .)
+ 1435      =                                   (. QbeGen.NewLabel(lBody);
+ 1436                                             QbeGen.NewLabel(lAfter); .)
+ 1437        CaseLabel<tsel, qsel, lBody>
+ 1438        { "," CaseLabel<tsel, qsel, lBody> }
+ 1439        ":"                               (. QbeGen.Jmp(lAfter);
+ 1440                                             QbeGen.EmitLabel(lBody); .)
+ 1441        [ StatSeq ]                       (. QbeGen.Jmp(lEnd);
+ 1442                                             QbeGen.EmitLabel(lAfter); .) .
+ 1443    CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
+ 1444              lBody: QbeGen.QVal>         (. VAR t2, t3: SymTab.TypeIndex;
+ 1445                                               q2, q3, qc, qd, qe:
+ 1446                                                 QbeGen.QVal;
+ 1447                                               lNext: QbeGen.QVal; .)
+ 1448      = Expr<t2, q2>                      (. IF (t2 #
+ 1449                                               SymTab.InvalidType)
+ 1450   AND (tsel #
+ 1451                                                 SymTab.InvalidType)
+ 1452   AND ((SymTab.ClassOf(t2) =
+ 1453                                                  SymTab.ClSet)
+ 1454                                                 OR (SymTab.ClassOf(tsel) =
+ 1455                                                     SymTab.ClSet)) THEN
+ 1456                                               SemError(230)
+ 1457                                             ELSIF (t2 #
+ 1458                                               SymTab.InvalidType)
+ 1459   AND (tsel #
+ 1460                                                 SymTab.InvalidType)
+ 1461   AND NOT SymTab.EqCheck(t2,
+ 1462                                                   tsel) THEN
+ 1463                                               SemError(213) END;
+ 1464                                             IF NOT QbeGen.IsImm(q2) THEN
+ 1465                                               SemError(230);
+ 1466                                               QbeGen.CopyOp("0", q2)
+ 1467                                             END;
+ 1468                                             QbeGen.NewLabel(lNext);
+ 1469                                             QbeGen.Cmp(SymTab.OpEq,
+ 1470                                               qsel, q2, qc, FALSE);
+ 1471                                             QbeGen.Jnz(qc, lBody, lNext);
+ 1472                                             QbeGen.EmitLabel(lNext); .)
+ 1473        [ ".." Expr<t3, q3>               (. IF (t3 #
+ 1474                                               SymTab.InvalidType)
+ 1475   AND (tsel #
+ 1476                                                 SymTab.InvalidType)
+ 1477   AND NOT SymTab.EqCheck(t3,
+ 1478                                                   tsel) THEN
+ 1479                                               SemError(213) END;
+ 1480                                             IF NOT QbeGen.IsImm(q3) THEN
+ 1481                                               SemError(230);
+ 1482                                               QbeGen.CopyOp("0", q3)
+ 1483                                             END;
+ 1484                                             QbeGen.Cmp(SymTab.OpGe,
+ 1485                                               qsel, q2, qc, FALSE);
+ 1486                                             QbeGen.Cmp(SymTab.OpLe,
+ 1487                                               qsel, q3, qd, FALSE);
+ 1488                                             QbeGen.NewTemp(qe);
+ 1489                                             QbeGen.Op3("and", qe, qc, qd,
+ 1490                                               FALSE);
+ 1491                                             QbeGen.NewLabel(lNext);
+ 1492                                             QbeGen.Jnz(qe, lBody, lNext);
+ 1493                                             QbeGen.EmitLabel(lNext); .) ] .
+ 1494    ReturnStat                            (. VAR t: SymTab.TypeIndex;
+ 1495                                               q, qt: QbeGen.QVal;
+ 1496                                               res: SymTab.TypeIndex;
+ 1497                                               hadE, conv: BOOLEAN; .)
+ 1498      = "RETURN"                          (. hadE := FALSE; .)
+ 1499        [ Expr<t, q>                      (. hadE := TRUE; .) ]
+ 1500                                          (. conv := FALSE;
+ 1501                                             IF NOT SymTab.InProc() THEN
+ 1502                                               SemError(232)
+ 1503                                             ELSE res := SymTab.CurRes();
+ 1504                                               IF NOT hadE THEN
+ 1505                                                 IF res #
+ 1506                                                    SymTab.InvalidType THEN
+ 1507                                                   SemError(232)
+ 1508                                                 ELSE QbeGen.EmitRet(q,
+ 1509                                                   FALSE)
+ 1510                                                 END
+ 1511                                               ELSIF (res =
+ 1512                                                      SymTab.InvalidType)
+ 1513                                                  OR (t #
+ 1514                                                      SymTab.InvalidType)
+ 1515   AND NOT SymTab.Assignable(t,
+ 1516                                                       res) THEN
+ 1517                                                 SemError(232)
+ 1518                                               ELSE
+ 1519                                                 conv := (SymTab.ClassOf(
+ 1520                                                   res) = SymTab.ClReal)
+ 1521   AND SymTab.IsIntFamily(t);
+ 1522                                                 IF conv THEN
+ 1523                                                   QbeGen.ConvIR(q, qt);
+ 1524                                                   QbeGen.EmitRet(qt, TRUE)
+ 1525                                                 ELSE QbeGen.EmitRet(q, TRUE)
+ 1526                                                 END
+ 1527                                               END
+ 1528                                             END; .) .
+ 1529    HaltStat                              (. VAR t: SymTab.TypeIndex;
+ 1530                                               q: QbeGen.QVal; .)
+ 1531      = "HALT" [ "(" Expr<t, q> ")" ]     (. QbeGen.HaltQ; .) .
+ 1532    (* Designator: scalar loads, array addresses, and index suffixes.
+ 1533       Each index descends one level (bounds-checked, trap on breach);
+ 1534       nested levels reload the inner descriptor address. q ends as the
+ 1535       value (scalars), the descriptor address (plain arrays), or the
+ 1536       element address (indexed); sfx marks the indexed form. *)
+ 1537    Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+ 1538           VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
+ 1539                                          (. VAR n, fn, mal: SymTab.Name;
+ 1540                                               cls: INTEGER;
+ 1541                                               curT, it, eT, bt:
+ 1542                                                 SymTab.TypeIndex;
+ 1543                                               iq, ql, qlo, qhi, qe:
+ 1544                                                 QbeGen.QVal;
+ 1545                                               lo, hi: INTEGER;
+ 1546                                               fo: INTEGER;
+ 1547                                               isOpen: BOOLEAN;
+ 1548                                               qb, cv: QbeGen.QVal; .)
+ 1549      = GetIdent<n>                       (. methCls := SymTab.InvalidType;
+ 1550                                             QbeGen.CopyOp(n, qn);
+ 1551                                             sfx := FALSE;
+ 1552                                             IF NOT SymTab.Lookup(n) THEN
+ 1553                                               SemError(201);
+ 1554                                               t := SymTab.InvalidType;
+ 1555                                               k := -1;
+ 1556                                               QbeGen.CopyOp("0", q)
+ 1557                                             ELSE
+ 1558                                               t := SymTab.SymType(n);
+ 1559                                               k := SymTab.SymKind(n);
+ 1560                                               IF k = SymTab.KindConst THEN
+ 1561                                                 IF SymTab.Equal(n,
+ 1562                                                    "TRUE") THEN
+ 1563                                                   t := SymTab.BoolType();
+ 1564                                                   QbeGen.CopyOp("1", q)
+ 1565                                                 ELSIF SymTab.Equal(n,
+ 1566                                                    "FALSE") THEN
+ 1567                                                   t := SymTab.BoolType();
+ 1568                                                   QbeGen.CopyOp("0", q)
+ 1569                                                 ELSIF SymTab.Equal(n,
+ 1570                                                    "NIL") THEN
+ 1571                                                   QbeGen.CopyOp("0", q)
+ 1572                                                 ELSE
+ 1573                                                   cls :=
+ 1574                                                     SymTab.ClassOf(t);
+ 1575                                                   IF (t #
+ 1576                                                       SymTab.InvalidType)
+ 1577   AND ((cls = SymTab.ClInt)
+ 1578                                                      OR (cls
+ 1579                                                          = SymTab.ClChar)
+ 1580                                                      OR (cls
+ 1581                                                          = SymTab.ClEnum)
+ 1582                                                      OR (cls
+ 1583                                                          = SymTab.ClReal)
+ 1584                                                      OR (cls
+ 1585                                                          = SymTab.ClNil)) THEN
+ 1586                                                     IF cls = SymTab.ClNil THEN
+ 1587                                                       QbeGen.CopyOp("0", q)
+ 1588                                                     ELSIF ((cls
+ 1589                                                         = SymTab.ClInt)
+ 1590                                                       OR (cls
+ 1591                                                         = SymTab.ClChar)
+ 1592                                                       OR (cls
+ 1593                                                         = SymTab.ClEnum))
+ 1594    AND SymTab.GetSymVal(n, cv)
+ 1595    AND QbeGen.IsImm(cv) THEN
+ 1596                                                       QbeGen.CopyOp(cv, q)
+ 1597                                                     ELSE
+ 1598                                                       QbeGen.LoadVar(n,
+ 1599                                                         cls = SymTab.ClReal,
+ 1600                                                         q)
+ 1601                                                     END
+ 1602                                                   ELSE
+ 1603                                                     IF t #
+ 1604                                                        SymTab.InvalidType THEN
+ 1605                                                       SemError(230)
+ 1606                                                     END;
+ 1607                                                     QbeGen.CopyOp("0", q)
+ 1608                                                   END
+ 1609                                                 END
+ 1610                                               ELSIF (k = SymTab.KindVar)
+ 1611                                                  OR (k = SymTab.KindParam) THEN
+ 1612                                                 cls :=
+ 1613                                                   SymTab.ClassOf(t);
+ 1614                                                 IF (cls = SymTab.ClInt)
+ 1615                                                    OR (cls = SymTab.ClBool)
+ 1616                                                    OR (cls = SymTab.ClChar)
+ 1617                                                    OR (cls = SymTab.ClUChar)
+ 1618                                                    OR (cls = SymTab.ClEnum)
  1619                                                    OR (cls
- 1620                                                        = SymTab.ClSet)
- 1621                                                    OR (cls
- 1622                                                        = SymTab.ClRecord)
- 1623                                                    OR (cls
- 1624                                                        = SymTab.ClUStr)
- 1625                                                    OR (cls
- 1626                                                        = SymTab.ClClass) THEN
- 1627                                                   QbeGen.AddrOf(n, q)
- 1628                                                 ELSE SemError(230);
- 1629                                                   QbeGen.CopyOp("0", q)
- 1630                                                 END
- 1631                                               ELSE QbeGen.CopyOp("0", q);
- 1632                                                 IF k = SymTab.KindImport THEN
- 1633                                                   SemError(230)
- 1634                                                 ELSIF k =
- 1635                                                    SymTab.KindProc THEN
- 1636                                                   (* bare procedure name:
- 1637                                                      a following ArgList
- 1638                                                      makes it a call;
- 1639                                                      otherwise Fact
- 1640                                                      reports 230 *)
- 1641                                                 ELSE
- 1642                                                   IF k = SymTab.KindField THEN
- 1643                                                     IF QbeGen.TopWith(qb) THEN
- 1644                                                       fo :=
- 1645                                                         SymTab.FieldOffset(
- 1646                                                         SymTab.FieldOwner(n),
- 1647                                                         n);
- 1648                                                       QbeGen.FieldAddr(qb,
- 1649                                                         fo, q);
- 1650                                                       sfx := TRUE
- 1651                                                     ELSE SemError(230);
- 1652                                                       QbeGen.CopyOp("0", q)
- 1653                                                     END
- 1654                                                   END
- 1655                                                 END
- 1656                                               END
- 1657                                             END; .)
- 1658        { "[" Expr<it, iq>
- 1659                                          (. IF t = SymTab.InvalidType THEN
- 1660                                             ELSIF SymTab.ClassOf(t) #
- 1661                                                   SymTab.ClArray THEN
- 1662                                               SemError(217);
- 1663                                               t := SymTab.InvalidType
- 1664                                             ELSIF NOT SymTab.IsIntFamily(it)
- 1665   AND (SymTab.ClassOf(it) #
- 1666                                                   SymTab.ClChar) THEN
- 1667                                               SemError(218);
- 1668                                               t := SymTab.InvalidType
- 1669                                             ELSE
- 1670                                               QbeGen.WidenIndex(iq, ql);
- 1671                                               isOpen :=
- 1672                                                 SymTab.IsOpenArray(t);
- 1673                                               IF isOpen THEN
- 1674                                                 QbeGen.CopyOp("0", qlo);
- 1675                                                 IF SymTab.IsCharArray(t)
- 1676    OR SymTab.IsUCharArray(t) THEN
- 1677                                                   QbeGen.OpenHiChar(q, qhi)
- 1678                                                 ELSE QbeGen.OpenHi(q, qhi)
- 1679                                                 END
- 1680                                               ELSE
- 1681                                                 lo := SymTab.ArrayLo(t);
- 1682                                                 hi := SymTab.ArrayHi(t);
- 1683                                                 IF SymTab.IsCharArray(t)
- 1684    OR SymTab.IsUCharArray(t) THEN
- 1685                                                   hi := hi + 1
- 1686                                                 END;
- 1687                                                 QbeGen.IntStr(lo, qlo);
- 1688                                                 QbeGen.IntStr(hi, qhi)
- 1689                                               END;
- 1690                                               QbeGen.CheckRange(ql, qlo,
- 1691                                                 qhi);
- 1692                                               eT := SymTab.ArrayElem(t);
- 1693                                               QbeGen.ElemAddr(q, ql, qlo,
- 1694                                                 t, qe);
- 1695                                               IF SymTab.ClassOf(eT) =
- 1696                                                  SymTab.ClArray THEN
- 1697                                                 QbeGen.ElemLoad(qe, eT, q)
- 1698                                               ELSE QbeGen.CopyOp(qe, q)
- 1699                                               END;
- 1700                                               t := eT; sfx := TRUE
- 1701                                             END; .)
- 1702          { "," Expr<it, iq>
- 1703                                          (. IF t = SymTab.InvalidType THEN
- 1704                                             ELSIF SymTab.ClassOf(t) #
- 1705                                                   SymTab.ClArray THEN
- 1706                                               SemError(217);
- 1707                                               t := SymTab.InvalidType
- 1708                                             ELSIF NOT SymTab.IsIntFamily(it)
- 1709   AND (SymTab.ClassOf(it) #
- 1710                                                   SymTab.ClChar) THEN
- 1711                                               SemError(218);
- 1712                                               t := SymTab.InvalidType
- 1713                                             ELSE
- 1714                                               QbeGen.WidenIndex(iq, ql);
- 1715                                               isOpen :=
- 1716                                                 SymTab.IsOpenArray(t);
- 1717                                               IF isOpen THEN
- 1718                                                 QbeGen.CopyOp("0", qlo);
- 1719                                                 IF SymTab.IsCharArray(t)
- 1720    OR SymTab.IsUCharArray(t) THEN
- 1721                                                   QbeGen.OpenHiChar(q, qhi)
- 1722                                                 ELSE QbeGen.OpenHi(q, qhi)
- 1723                                                 END
- 1724                                               ELSE
- 1725                                                 lo := SymTab.ArrayLo(t);
- 1726                                                 hi := SymTab.ArrayHi(t);
- 1727                                                 IF SymTab.IsCharArray(t)
- 1728    OR SymTab.IsUCharArray(t) THEN
- 1729                                                   hi := hi + 1
- 1730                                                 END;
- 1731                                                 QbeGen.IntStr(lo, qlo);
- 1732                                                 QbeGen.IntStr(hi, qhi)
- 1733                                               END;
- 1734                                               QbeGen.CheckRange(ql, qlo,
- 1735                                                 qhi);
- 1736                                               eT := SymTab.ArrayElem(t);
- 1737                                               QbeGen.ElemAddr(q, ql, qlo,
- 1738                                                 t, qe);
- 1739                                               IF SymTab.ClassOf(eT) =
- 1740                                                  SymTab.ClArray THEN
- 1741                                                 QbeGen.ElemLoad(qe, eT, q)
- 1742                                               ELSE QbeGen.CopyOp(qe, q)
- 1743                                               END;
- 1744                                               t := eT; sfx := TRUE
- 1745                                             END; .) }
- 1746          "]"
- 1747        | "." GetIdent<fn>
- 1748                                          (. IF k = SymTab.KindModule THEN
- 1749                                               (* qualified L.x: materialize
- 1750                                                  the export, then load it *)
- 1751                                               IF NOT SymTab.MaterializeAlias(n,
- 1752                                                    fn, mal) THEN
- 1753                                                 SemError(201);
- 1754                                                 t := SymTab.InvalidType;
- 1755                                                 QbeGen.CopyOp("0", q)
- 1756                                               ELSE
- 1757                                                 QbeGen.CopyOp(mal, qn);
- 1758                                                 t := SymTab.SymType(mal);
- 1759                                                 k := SymTab.SymKind(mal);
- 1760                                                 sfx := FALSE;
- 1761                                                 IF k = SymTab.KindProc THEN
- 1762                                                   (* call: ArgList supplies
- 1763                                                      the value *)
- 1764                                                   QbeGen.CopyOp("0", q)
- 1765                                                 ELSIF NOT QbeGen.LoadDesignator(
- 1766                                                      mal, t, k, q) THEN
- 1767                                                   SemError(230);
- 1768                                                   QbeGen.CopyOp("0", q)
- 1769                                                 END
- 1770                                               END
- 1771                                             ELSIF t = SymTab.InvalidType THEN
- 1772                                             ELSIF (SymTab.ClassOf(t) #
- 1773                                                    SymTab.ClRecord)
- 1774   AND (SymTab.ClassOf(t) #
- 1775                                                   SymTab.ClClass) THEN
- 1776                                               SemError(215);
- 1777                                               t := SymTab.InvalidType
- 1778                                             ELSIF (SymTab.ClassOf(t) =
- 1779                                                    SymTab.ClClass)
- 1780    AND SymTab.MethodExists(t, fn) THEN
- 1781                                               (* obj.Method: bind the
- 1782                                                  method and pass obj as
- 1783                                                  the hidden receiver; q
- 1784                                                  already holds the
- 1785                                                  object's address *)
- 1786                                               QbeGen.ArmRecv(q);
- 1787                                               QbeGen.CopyOp(fn, n);
- 1788                                               QbeGen.CopyOp(fn, qn);
- 1789                                               methCls := t;
- 1790                                               k := SymTab.KindProc;
- 1791                                               t := SymTab.InvalidType
- 1792                                             ELSIF NOT SymTab.FieldExists(t,
- 1793                                                      fn) THEN
- 1794                                               SemError(216);
- 1795                                               t := SymTab.InvalidType
- 1796                                             ELSE
- 1797                                               fo := SymTab.FieldOffset(t,
- 1798                                                 fn);
- 1799                                               t := SymTab.FieldType(t, fn);
- 1800                                               QbeGen.FieldAddr(q, fo, qe);
- 1801                                               (* array fields are inline:
- 1802                                                  the field address is the
- 1803                                                  descriptor, like records *)
- 1804                                               QbeGen.CopyOp(qe, q);
- 1805                                               sfx := TRUE
- 1806                                             END; .)
- 1807        | "^"
- 1808                                          (. IF t = SymTab.InvalidType THEN
- 1809                                             ELSIF SymTab.ClassOf(t) #
- 1810                                                   SymTab.ClPtr THEN
- 1811                                               SemError(219);
- 1812                                               t := SymTab.InvalidType
- 1813                                             ELSE
- 1814                                               bt := SymTab.PtrBase(t);
- 1815                                               IF bt = SymTab.InvalidType THEN
- 1816                                               ELSE
- 1817                                                 IF sfx THEN
- 1818                                                   QbeGen.ElemLoad(q, t,
- 1819                                                     qb);
- 1820                                                   QbeGen.CopyOp(qb, q)
- 1821                                                 END;
- 1822                                                 t := bt;
- 1823                                                 (* q holds the pointee
- 1824                                                    address: Fact loads
- 1825                                                    scalars/pointers and uses
- 1826                                                    the address for
- 1827                                                    aggregates; the VAR-actual
- 1828                                                    note is q itself. *)
- 1829                                                 sfx := TRUE
- 1830                                               END
- 1831                                             END; .) } .
- 1832    Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1833                                          (. VAR t2: SymTab.TypeIndex;
- 1834                                               op: INTEGER;
- 1835                                               q2, qt, wl: QbeGen.QVal;
- 1836                                               isR: BOOLEAN; .)
- 1837      = SimExpr<t, q>
- 1838        [ Rel<op> SimExpr<t2, q2>
- 1839          (. IF op = SymTab.OpIn THEN
- 1840               IF SymTab.InCheck(t, t2) THEN
- 1841                 IF (t = SymTab.InvalidType)
- 1842                    OR (t2 = SymTab.InvalidType) THEN
- 1843                   t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1844                 ELSE
- 1845                   QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
- 1846                     SymTab.SetCount(t2), qt);
- 1847                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1848                 END
- 1849               ELSE SemError(222); t := SymTab.InvalidType;
- 1850                 QbeGen.CopyOp("0", q)
- 1851               END
- 1852             ELSIF SymTab.RelCheck(t, t2, op) THEN
- 1853               IF (t = SymTab.InvalidType)
- 1854                  OR (t2 = SymTab.InvalidType) THEN
- 1855                 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1856               ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
- 1857                  OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
- 1858                 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
- 1859   AND (op # SymTab.OpNeq2) THEN
- 1860                   SemError(213); t := SymTab.InvalidType;
- 1861                   QbeGen.CopyOp("0", q)
- 1862                 ELSE
- 1863                   QbeGen.CmpL(op, q, q2, qt);
- 1864                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1865                 END
- 1866               ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
- 1867                  OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1868                 QbeGen.CmpSet(op, q, q2,
- 1869                   SymTab.SetWords(t), SymTab.SetWords(t2), qt);
- 1870                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1871               ELSIF SymTab.StrCompat(t, t2) THEN
- 1872                 QbeGen.StrEq(op, q, q2, qt);
- 1873                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1874               ELSIF SymTab.IsLongFamily(t)
- 1875                  OR SymTab.IsLongFamily(t2) THEN
- 1876                 IF SymTab.IsIntFamily(t) THEN
- 1877                   QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
- 1878                 END;
- 1879                 IF SymTab.IsIntFamily(t2) THEN
- 1880                   QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
- 1881                 END;
- 1882                 QbeGen.CmpLong(op, q, q2, qt);
- 1883                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1884               ELSE
- 1885                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1886                 t := SymTab.BoolType();
- 1887                 QbeGen.Cmp(op, q, q2, qt, isR);
- 1888                 QbeGen.CopyOp(qt, q)
- 1889               END
- 1890             ELSE SemError(213); t := SymTab.InvalidType;
- 1891               QbeGen.CopyOp("0", q)
- 1892             END; .) ] .
- 1893    Rel<VAR op: INTEGER>
- 1894      = "="                               (. op := SymTab.OpEq; .)
- 1895      | "#"                               (. op := SymTab.OpNeq1; .)
- 1896      | "<"                               (. op := SymTab.OpLt; .)
- 1897      | "<="                              (. op := SymTab.OpLe; .)
- 1898      | ">"                               (. op := SymTab.OpGt; .)
- 1899      | ">="                              (. op := SymTab.OpGe; .)
- 1900      | "IN"                              (. op := SymTab.OpIn; .) .
- 1901    SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1902                                          (. VAR t2, res2, lt, rt:
- 1903                                                 SymTab.TypeIndex;
- 1904                                               op: INTEGER;
- 1905                                               q2, qt, wq, qf, q2a, q2b:
- 1906                                                 QbeGen.QVal;
- 1907                                               neg, isR, isL, folded:
- 1908                                                 BOOLEAN;
- 1909                                               lw, rw, mw: CARDINAL;
- 1910                                               lTrue, lNext, lDone, qr, qs:
- 1911                                                 QbeGen.QVal; .)
- 1912      =                                   (. neg := FALSE; .)
- 1913        [ "+" | "-"                       (. neg := TRUE; .) ]
- 1914        Term<t, q>                        (. IF neg THEN
- 1915                                             IF QbeGen.IsImm(q) THEN
- 1916                                               QbeGen.NegFold(q, q)
- 1917                                             ELSE QbeGen.NewTemp(qt);
- 1918                                               QbeGen.NegQ(q, qt,
- 1919                                                 SymTab.ClassOf(t)
- 1920                                                 = SymTab.ClReal);
- 1921                                               QbeGen.CopyOp(qt, q)
- 1922                                             END
- 1923                                           END; .)
- 1924        { AddOp<op>                       (. IF op = SymTab.OpOr THEN
- 1925                                               QbeGen.DelayBegin END; .)
- 1926          Term<t2, q2>                     (. IF op = SymTab.OpOr THEN
- 1927                                               QbeGen.DelayEnd END; .)
- 1928          (. IF op = SymTab.OpOr THEN
- 1929               (* short-circuit: if q is true the RHS is skipped *)
- 1930               IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 1931                 t := SymTab.BoolType()
- 1932               ELSE SemError(212); t := SymTab.InvalidType END;
- 1933               IF t # SymTab.InvalidType THEN
- 1934                 QbeGen.Slot4(qs);
- 1935                 QbeGen.NewLabel(lTrue);
- 1936                 QbeGen.NewLabel(lNext);
- 1937                 QbeGen.NewLabel(lDone);
- 1938                 QbeGen.Jnz(q, lTrue, lNext);
- 1939                 QbeGen.EmitLabel(lTrue);
- 1940                 QbeGen.StoreW(qs, "1");
- 1941                 QbeGen.Jmp(lDone);
- 1942                 QbeGen.EmitLabel(lNext);
- 1943                 QbeGen.DelayFlush;
- 1944                 QbeGen.StoreW(qs, q2);
- 1945                 QbeGen.Jmp(lDone);
- 1946                 QbeGen.EmitLabel(lDone);
- 1947                 QbeGen.LoadW(qs, qr);
- 1948                 QbeGen.CopyOp(qr, q)
- 1949               ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
- 1950               END
- 1951             ELSIF (op = SymTab.OpAdd)
- 1952               AND (SymTab.UStrCompat(t, t2)
- 1953                 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
- 1954                   AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
- 1955                 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
- 1956                   AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
- 1957                 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
- 1958                   AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
- 1959               (* UString concatenation: a UCHAR operand becomes a
- 1960                  1-codepoint UString; the result is a descriptor in the
- 1961                  shim's concat buffer.  Work on copies so neither
- 1962                  operand is clobbered. *)
- 1963               IF SymTab.ClassOf(t) = SymTab.ClUStr THEN
- 1964                 QbeGen.CopyOp(q, q2a)
- 1965               ELSE
- 1966                 QbeGen.UStrFrom(q, q2a)
- 1967               END;
- 1968               IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN
- 1969                 QbeGen.UStrCat(q2a, q2, qt)
- 1970               ELSE
- 1971                 QbeGen.UStrFrom(q2, q2b);
- 1972                 QbeGen.UStrCat(q2a, q2b, qt)
- 1973               END;
- 1974               t := SymTab.NewUStr();
- 1975               QbeGen.CopyOp(qt, q)
- 1976             ELSIF (op = SymTab.OpAdd)
- 1977               AND (SymTab.StrCompat(t, t2)
- 1978                 OR (SymTab.IsStrType(t)
- 1979                   AND (SymTab.ClassOf(t2) = SymTab.ClChar))
- 1980                 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
- 1981                   AND SymTab.IsStrType(t2))) THEN
- 1982               (* string concatenation; a CHAR operand becomes a
- 1983                  1-character string literal *)
- 1984               IF SymTab.StrCompat(t, t2) THEN
- 1985                 QbeGen.StrCat(q, q2, qt)
- 1986               ELSIF SymTab.IsStrType(t) THEN
- 1987                 QbeGen.DeclCharStr(q2, qs);
- 1988                 QbeGen.StrCat(q, qs, qt)
- 1989               ELSE
- 1990                 QbeGen.DeclCharStr(q, qs);
- 1991                 QbeGen.StrCat(qs, q2, qt)
- 1992               END;
- 1993               t := SymTab.NewStr();
- 1994               QbeGen.CopyOp(qt, q)
- 1995             ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 1996   AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 1997   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1998               lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1999               mw := lw;
- 2000               IF rw > mw THEN mw := rw END;
- 2001               IF op = SymTab.OpAdd THEN
- 2002                 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
- 2003               ELSE
- 2004                 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
- 2005               END;
- 2006               t := SymTab.NewSet(
- 2007                      SymTab.NewSubR(0,
- 2008                        VAL(INTEGER, mw) * 32 - 1));
- 2009               QbeGen.CopyOp(qt, q)
- 2010             ELSE
- 2011               IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
- 2012                 lt := t; rt := t2; t := res2
- 2013               ELSE SemError(211); t := SymTab.InvalidType END;
- 2014               IF t # SymTab.InvalidType THEN
- 2015                 isL := SymTab.IsLongFamily(t);
- 2016                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 2017                 folded := FALSE;
- 2018                 IF (NOT isL) AND (NOT isR)
- 2019    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 2020                   IF op = SymTab.OpAdd THEN
- 2021                     folded := QbeGen.Fold2(0, q, q2, qf)
- 2022                   ELSE
- 2023                     folded := QbeGen.Fold2(1, q, q2, qf)
- 2024                   END
- 2025                 END;
- 2026                 IF folded THEN QbeGen.CopyOp(qf, q)
- 2027                 ELSE
- 2028                 IF isL THEN
- 2029                   IF SymTab.IsIntFamily(lt) THEN
- 2030                     QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 2031                   END;
- 2032                   IF SymTab.IsIntFamily(rt) THEN
- 2033                     QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 2034                   END;
- 2035                   QbeGen.NewTemp(qt);
- 2036                   IF op = SymTab.OpAdd THEN
- 2037                     QbeGen.Op3L("add", qt, q, q2)
- 2038                   ELSE
- 2039                     QbeGen.Op3L("sub", qt, q, q2)
- 2040                   END
- 2041                 ELSE
- 2042                   QbeGen.NewTemp(qt);
- 2043                   IF op = SymTab.OpAdd THEN
- 2044                     QbeGen.Op3("add", qt, q, q2, isR)
- 2045                   ELSE
- 2046                     QbeGen.Op3("sub", qt, q, q2, isR)
- 2047                   END
- 2048                 END;
- 2049                 QbeGen.CopyOp(qt, q)
- 2050                 END
- 2051               ELSE QbeGen.CopyOp("0", q)
- 2052               END
- 2053             END; .) } .
- 2054    AddOp<VAR op: INTEGER>
- 2055      = "+"                               (. op := SymTab.OpAdd; .)
- 2056      | "-"                               (. op := SymTab.OpSub; .)
- 2057      | "OR"                              (. op := SymTab.OpOr; .) .
- 2058    Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2059                                          (. VAR t2, res2, lt, rt:
- 2060                                                 SymTab.TypeIndex;
- 2061                                               op: INTEGER;
- 2062                                               q2, qt, wq, qf:
- 2063                                                 QbeGen.QVal;
- 2064                                               isR, isL, folded: BOOLEAN;
- 2065                                               lw, rw, mw: CARDINAL;
- 2066                                               lNext, lFalse, lDone, qr, qs:
- 2067                                                 QbeGen.QVal; .)
- 2068      = Fact<t, q> { MulOp<op>            (. IF op = SymTab.OpAnd THEN
- 2069                                               QbeGen.DelayBegin END; .)
- 2070          Fact<t2, q2>                    (. IF op = SymTab.OpAnd THEN
- 2071                                               QbeGen.DelayEnd END; .)
- 2072        (. IF op = SymTab.OpAnd THEN
- 2073             (* short-circuit: if q is false the RHS is skipped *)
- 2074             IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 2075               t := SymTab.BoolType()
- 2076             ELSE SemError(212); t := SymTab.InvalidType END;
- 2077             IF t # SymTab.InvalidType THEN
- 2078               QbeGen.Slot4(qs);
- 2079               QbeGen.NewLabel(lNext);
- 2080               QbeGen.NewLabel(lFalse);
- 2081               QbeGen.NewLabel(lDone);
- 2082               QbeGen.Jnz(q, lNext, lFalse);
- 2083               QbeGen.EmitLabel(lNext);
- 2084               QbeGen.DelayFlush;
- 2085               QbeGen.StoreW(qs, q2);
- 2086               QbeGen.Jmp(lDone);
- 2087               QbeGen.EmitLabel(lFalse);
- 2088               QbeGen.StoreW(qs, "0");
- 2089               QbeGen.Jmp(lDone);
- 2090               QbeGen.EmitLabel(lDone);
- 2091               QbeGen.LoadW(qs, qr);
- 2092               QbeGen.CopyOp(qr, q)
- 2093             ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
- 2094             END
- 2095           ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 2096   AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 2097   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 2098             lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 2099             mw := lw;
- 2100             IF rw > mw THEN mw := rw END;
- 2101             IF op = SymTab.OpTimes THEN
- 2102               QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
- 2103             ELSE
- 2104               QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
- 2105             END;
- 2106             t := SymTab.NewSet(
- 2107                    SymTab.NewSubR(0,
- 2108                      VAL(INTEGER, mw) * 32 - 1));
- 2109             QbeGen.CopyOp(qt, q)
- 2110           ELSE
- 2111             IF SymTab.ArithCheck(t, t2,
- 2112                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
- 2113                  res2) THEN
- 2114               lt := t; rt := t2; t := res2
- 2115             ELSE SemError(211); t := SymTab.InvalidType END;
- 2116             IF t # SymTab.InvalidType THEN
- 2117               isL := SymTab.IsLongFamily(t);
- 2118               isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 2119               folded := FALSE;
- 2120               IF (NOT isL) AND (NOT isR)
- 2121    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 2122                 IF op = SymTab.OpTimes THEN
- 2123                   folded := QbeGen.Fold2(2, q, q2, qf)
- 2124                 ELSIF op = SymTab.OpDiv THEN
- 2125                   folded := QbeGen.Fold2(3, q, q2, qf)
- 2126                 ELSIF op = SymTab.OpMod THEN
- 2127                   folded := QbeGen.Fold2(4, q, q2, qf)
- 2128                 END
- 2129               END;
- 2130               IF folded THEN QbeGen.CopyOp(qf, q)
- 2131               ELSE
- 2132               IF isL THEN
- 2133                 IF SymTab.IsIntFamily(lt) THEN
- 2134                   QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 2135                 END;
- 2136                 IF SymTab.IsIntFamily(rt) THEN
- 2137                   QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 2138                 END;
- 2139                 QbeGen.NewTemp(qt);
- 2140                 IF op = SymTab.OpTimes THEN
- 2141                   QbeGen.Op3L("mul", qt, q, q2)
- 2142                 ELSIF (op = SymTab.OpDiv)
- 2143                    OR (op = SymTab.OpSlash) THEN
- 2144                   QbeGen.Op3L("div", qt, q, q2)
- 2145                 ELSE
- 2146                   QbeGen.Op3L("rem", qt, q, q2)
- 2147                 END
- 2148               ELSE
- 2149                 QbeGen.NewTemp(qt);
- 2150                 IF op = SymTab.OpTimes THEN
- 2151                   QbeGen.Op3("mul", qt, q, q2, isR)
- 2152                 ELSIF (op = SymTab.OpDiv)
- 2153                    OR (op = SymTab.OpSlash) THEN
- 2154                   QbeGen.Op3("div", qt, q, q2, isR)
- 2155                 ELSE
- 2156                   QbeGen.Op3("rem", qt, q, q2, isR)
- 2157                 END
- 2158               END;
- 2159               QbeGen.CopyOp(qt, q)
- 2160               END
- 2161             ELSE QbeGen.CopyOp("0", q)
- 2162             END
- 2163           END; .) } .
- 2164    MulOp<VAR op: INTEGER>
- 2165      = "*"                               (. op := SymTab.OpTimes; .)
- 2166      | "/"                               (. op := SymTab.OpSlash; .)
- 2167      | "DIV"                             (. op := SymTab.OpDiv; .)
- 2168      | "MOD"                             (. op := SymTab.OpMod; .)
- 2169      | ( "AND" | "&" )                   (. op := SymTab.OpAnd; .) .
- 2170    Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2171                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
- 2172                                               et, dt, t2, st, ct2:
- 2173                                                 SymTab.TypeIndex;
- 2174                                               dk: INTEGER;
- 2175                                               qd, q2, sq, qa, qm0, qr:
- 2176                                                 QbeGen.QVal;
- 2177                                               qn, vn: SymTab.Name;
- 2178                                               vt: SymTab.TypeIndex;
- 2179                                               c1, c2: INTEGER;
- 2180                                               called, isHigh, sfx, isCh,
- 2181                                               isU, uok, isStr: BOOLEAN;
- 2182                                               ucp: INTEGER; .)
- 2183      = integer                           (. LexString(s);
- 2184                                             QbeGen.NormInt(s, q);
- 2185                                             t := SymTab.IntType(); .)
- 2186      | charConst                         (. LexString(s);
- 2187                                             QbeGen.NormLit(s, q, isCh);
- 2188                                             t := SymTab.CharType(); .)
- 2189      | real                              (. LexString(s);
- 2190                                             QbeGen.NormReal(s, q);
- 2191                                             t := SymTab.RealType(); .)
- 2192      | string                            (. LexString(s);
- 2193                                             IF SymTab.StrLen(s) = 3 THEN
- 2194                                               t := SymTab.CharType();
- 2195                                               QbeGen.IntStr(
- 2196                                                 QbeGen.CharVal(s), q)
- 2197                                             ELSE t := SymTab.NewStr();
- 2198                                               QbeGen.DeclStr(s, q);
- 2199                                               (* a literal's value IS its
- 2200                                                  static descriptor address *)
- 2201                                               QbeGen.NoteAddr(q, q)
- 2202                                             END; .)
- 2203      | ustring                           (. LexString(s);
- 2204                                             QbeGen.DeclUStr(s, q, isU, ucp,
- 2205                                               uok);
- 2206                                             IF NOT uok THEN
- 2207                                               SemError(234);
- 2208                                               t := SymTab.InvalidType
- 2209                                             ELSIF isU THEN
- 2210                                               t := SymTab.UCharType();
- 2211                                               QbeGen.IntStr(ucp, q)
- 2212                                             ELSE
- 2213                                               t := SymTab.NewUStr();
- 2214                                               QbeGen.NoteAddr(q, q)
- 2215                                             END; .)
- 2216      | Design<dt, dk, qd, qn, sfx>       (. called := FALSE;
- 2217                                             t := dt;
- 2218                                             IF sfx THEN
- 2219                                               IF dt =
- 2220                                                  SymTab.InvalidType THEN
- 2221                                                 QbeGen.CopyOp("0", q)
- 2222                                               ELSIF (SymTab.ClassOf(dt) =
- 2223                                                      SymTab.ClRecord)
- 2224                                                  OR (SymTab.ClassOf(dt) =
- 2225                                                      SymTab.ClSet)
- 2226                                                  OR (SymTab.ClassOf(dt) =
- 2227                                                      SymTab.ClArray)
- 2228                                                  OR (SymTab.ClassOf(dt) =
- 2229                                                      SymTab.ClClass) THEN
- 2230                                                 QbeGen.CopyOp(qd, q)
- 2231                                               ELSE QbeGen.ElemLoad(qd, dt,
- 2232                                                 q)
- 2233                                               END
- 2234                                             ELSE QbeGen.CopyOp(qd, q)
- 2235                                             END;
- 2236                                             IF (dk = SymTab.KindVar)
- 2237                                                OR (dk = SymTab.KindParam)
- 2238                                                OR (dk =
- 2239                                                   SymTab.KindField) THEN
- 2240                                               IF sfx THEN
- 2241                                                 QbeGen.NoteAddr(q, qd)
- 2242                                               ELSE
- 2243                                                 QbeGen.AddrOf(qn, qa);
- 2244                                                 QbeGen.NoteAddr(q, qa)
- 2245                                               END
- 2246                                             ELSIF sfx
- 2247   AND (dt #
- 2248                                                   SymTab.InvalidType)
- 2249   AND ((SymTab.ClassOf(dt) =
- 2250                                                    SymTab.ClArray)
- 2251                                                   OR (SymTab.ClassOf(dt) =
- 2252                                                       SymTab.ClSet)
- 2253                                                   OR (SymTab.ClassOf(dt) =
- 2254                                                       SymTab.ClRecord)) THEN
- 2255                                               QbeGen.NoteAddr(qd, qd)
- 2256                                             END; .)
- 2257        [ TypedSetLit<dt, q>              (. t := dt; .) ]
- 2258        [ ArgList<qn, dt, qd, TRUE, methCls, ct2, q2, called>
- 2259                                          (. t := ct2;
- 2260                                             QbeGen.CopyOp(q2, q); .) ]
- 2261                                          (. IF NOT called
- 2262   AND (dk = SymTab.KindProc) THEN
- 2263                                               (* bare zero-arg function
- 2264                                                  call (parentheses may be
- 2265                                                  omitted); a proper or
- 2266                                                  parameterised proc here
- 2267                                                  is 230 *)
- 2268                                               IF (SymTab.ProcNPar(qn) = 0)
- 2269   AND (SymTab.ProcRes(qn) #
- 2270                                                     SymTab.InvalidType) THEN
- 2271                                                 QbeGen.Mangled(qn,
- 2272                                                   SymTab.ProcUid(qn), qm0);
- 2273                                                 QbeGen.CallBegin(qm0,
- 2274                                                   SymTab.ProcRes(qn),
- 2275                                                   SymTab.ProcDepthOf(qn),
- 2276                                                   SymTab.IsExternal(qn));
- 2277                                                 QbeGen.CallEnd(TRUE, q);
- 2278                                                 t := SymTab.ProcRes(qn)
- 2279                                               ELSE
- 2280                                                 (* procedure used as a
- 2281                                                    value (assign to a
- 2282                                                    procedure variable):
- 2283                                                    its code address *)
- 2284                                                 t := SymTab.ProcTypeOf(qn);
- 2285                                                 QbeGen.Mangled(qn,
- 2286                                                   SymTab.ProcUid(qn), qm0);
- 2287                                                 QbeGen.ProcAddr(qm0, q)
- 2288                                               END
- 2289                                             END; .)
- 2290      | ( "HIGH"                          (. isHigh := TRUE; .)
- 2291        | ( "LEN" | "LENGTH" )            (. isHigh := FALSE; .) )
- 2292        "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
- 2293                                              isU := FALSE; .)
- 2294            | string                       (. LexString(s);
- 2295                                              isStr := TRUE;
- 2296                                              isU := FALSE;
- 2297                                              IF SymTab.StrLen(s) = 3 THEN
- 2298                                                dt := SymTab.CharType();
- 2299                                                QbeGen.IntStr(QbeGen.CharVal(s),
- 2300                                                  qd)
- 2301                                              ELSE
- 2302                                                dt := SymTab.NewStr();
- 2303                                                QbeGen.DeclStr(s, qd);
- 2304                                                QbeGen.NoteAddr(qd, qd)
- 2305                                              END;
- 2306                                              dk := -1;
- 2307                                              qn[0] := CHR(0); .)
- 2308            | ustring                      (. LexString(s);
- 2309                                              QbeGen.DeclUStr(s, qd, isU, ucp,
- 2310                                                uok);
- 2311                                              isStr := FALSE;
- 2312                                              IF NOT uok THEN
- 2313                                                SemError(234);
- 2314                                                dt := SymTab.InvalidType
- 2315                                              ELSIF isU THEN
- 2316                                                (* one codepoint: a UCHAR;
- 2317                                                   LEN is 1, HIGH is 0 *)
- 2318                                                dt := SymTab.UCharType();
- 2319                                                QbeGen.IntStr(ucp, qd)
- 2320                                              ELSE
- 2321                                                dt := SymTab.NewUStr();
- 2322                                                QbeGen.NoteAddr(qd, qd)
- 2323                                              END;
- 2324                                              dk := -1;
- 2325                                              qn[0] := CHR(0); .) )
- 2326        ")"
- 2327                                          (. IF (dt # SymTab.InvalidType)
- 2328    AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
- 2329                                               (* UString: the count is
- 2330                                                  the descriptor header *)
- 2331                                               IF isHigh THEN
- 2332                                                 QbeGen.UStrLen(qd, qr);
- 2333                                                 QbeGen.DecQ(qr)
- 2334                                               ELSE
- 2335                                                 QbeGen.UStrLen(qd, qr)
- 2336                                               END;
- 2337                                               t := SymTab.IntType();
- 2338                                               QbeGen.CopyOp(qr, q)
- 2339                                             ELSIF (dt # SymTab.InvalidType)
- 2340    AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
- 2341                                               (* single UCHAR codepoint *)
+ 1620                                                        = SymTab.ClReal) THEN
+ 1621                                                   QbeGen.LoadVar(n,
+ 1622                                                     cls = SymTab.ClReal, q)
+ 1623                                                 ELSIF (cls = SymTab.ClPtr)
+ 1624                                                    OR (cls = SymTab.ClProc) THEN
+ 1625                                                   QbeGen.LoadPtr(n, q)
+ 1626                                                 ELSIF cls = SymTab.ClLong THEN
+ 1627                                                   QbeGen.LoadLong(n, q)
+ 1628                                                 ELSIF (cls
+ 1629                                                         = SymTab.ClArray)
+ 1630                                                    OR (cls
+ 1631                                                        = SymTab.ClSet)
+ 1632                                                    OR (cls
+ 1633                                                        = SymTab.ClRecord)
+ 1634                                                    OR (cls
+ 1635                                                        = SymTab.ClUStr)
+ 1636                                                    OR (cls
+ 1637                                                        = SymTab.ClClass) THEN
+ 1638                                                   QbeGen.AddrOf(n, q)
+ 1639                                                 ELSE SemError(230);
+ 1640                                                   QbeGen.CopyOp("0", q)
+ 1641                                                 END
+ 1642                                               ELSE QbeGen.CopyOp("0", q);
+ 1643                                                 IF k = SymTab.KindImport THEN
+ 1644                                                   SemError(230)
+ 1645                                                 ELSIF k =
+ 1646                                                    SymTab.KindProc THEN
+ 1647                                                   (* bare procedure name:
+ 1648                                                      a following ArgList
+ 1649                                                      makes it a call;
+ 1650                                                      otherwise Fact
+ 1651                                                      reports 230 *)
+ 1652                                                 ELSE
+ 1653                                                   IF k = SymTab.KindField THEN
+ 1654                                                     IF QbeGen.TopWith(qb) THEN
+ 1655                                                       fo :=
+ 1656                                                         SymTab.FieldOffset(
+ 1657                                                         SymTab.FieldOwner(n),
+ 1658                                                         n);
+ 1659                                                       QbeGen.FieldAddr(qb,
+ 1660                                                         fo, q);
+ 1661                                                       sfx := TRUE
+ 1662                                                     ELSE SemError(230);
+ 1663                                                       QbeGen.CopyOp("0", q)
+ 1664                                                     END
+ 1665                                                   END
+ 1666                                                 END
+ 1667                                               END
+ 1668                                             END; .)
+ 1669        { "[" Expr<it, iq>
+ 1670                                          (. IF t = SymTab.InvalidType THEN
+ 1671                                             ELSIF SymTab.ClassOf(t) #
+ 1672                                                   SymTab.ClArray THEN
+ 1673                                               SemError(217);
+ 1674                                               t := SymTab.InvalidType
+ 1675                                             ELSIF NOT SymTab.IsIntFamily(it)
+ 1676   AND (SymTab.ClassOf(it) #
+ 1677                                                   SymTab.ClChar) THEN
+ 1678                                               SemError(218);
+ 1679                                               t := SymTab.InvalidType
+ 1680                                             ELSE
+ 1681                                               QbeGen.WidenIndex(iq, ql);
+ 1682                                               isOpen :=
+ 1683                                                 SymTab.IsOpenArray(t);
+ 1684                                               IF isOpen THEN
+ 1685                                                 QbeGen.CopyOp("0", qlo);
+ 1686                                                 IF SymTab.IsCharArray(t)
+ 1687    OR SymTab.IsUCharArray(t) THEN
+ 1688                                                   QbeGen.OpenHiChar(q, qhi)
+ 1689                                                 ELSE QbeGen.OpenHi(q, qhi)
+ 1690                                                 END
+ 1691                                               ELSE
+ 1692                                                 lo := SymTab.ArrayLo(t);
+ 1693                                                 hi := SymTab.ArrayHi(t);
+ 1694                                                 IF SymTab.IsCharArray(t)
+ 1695    OR SymTab.IsUCharArray(t) THEN
+ 1696                                                   hi := hi + 1
+ 1697                                                 END;
+ 1698                                                 QbeGen.IntStr(lo, qlo);
+ 1699                                                 QbeGen.IntStr(hi, qhi)
+ 1700                                               END;
+ 1701                                               QbeGen.CheckRange(ql, qlo,
+ 1702                                                 qhi);
+ 1703                                               eT := SymTab.ArrayElem(t);
+ 1704                                               QbeGen.ElemAddr(q, ql, qlo,
+ 1705                                                 t, qe);
+ 1706                                               IF SymTab.ClassOf(eT) =
+ 1707                                                  SymTab.ClArray THEN
+ 1708                                                 QbeGen.ElemLoad(qe, eT, q)
+ 1709                                               ELSE QbeGen.CopyOp(qe, q)
+ 1710                                               END;
+ 1711                                               t := eT; sfx := TRUE
+ 1712                                             END; .)
+ 1713          { "," Expr<it, iq>
+ 1714                                          (. IF t = SymTab.InvalidType THEN
+ 1715                                             ELSIF SymTab.ClassOf(t) #
+ 1716                                                   SymTab.ClArray THEN
+ 1717                                               SemError(217);
+ 1718                                               t := SymTab.InvalidType
+ 1719                                             ELSIF NOT SymTab.IsIntFamily(it)
+ 1720   AND (SymTab.ClassOf(it) #
+ 1721                                                   SymTab.ClChar) THEN
+ 1722                                               SemError(218);
+ 1723                                               t := SymTab.InvalidType
+ 1724                                             ELSE
+ 1725                                               QbeGen.WidenIndex(iq, ql);
+ 1726                                               isOpen :=
+ 1727                                                 SymTab.IsOpenArray(t);
+ 1728                                               IF isOpen THEN
+ 1729                                                 QbeGen.CopyOp("0", qlo);
+ 1730                                                 IF SymTab.IsCharArray(t)
+ 1731    OR SymTab.IsUCharArray(t) THEN
+ 1732                                                   QbeGen.OpenHiChar(q, qhi)
+ 1733                                                 ELSE QbeGen.OpenHi(q, qhi)
+ 1734                                                 END
+ 1735                                               ELSE
+ 1736                                                 lo := SymTab.ArrayLo(t);
+ 1737                                                 hi := SymTab.ArrayHi(t);
+ 1738                                                 IF SymTab.IsCharArray(t)
+ 1739    OR SymTab.IsUCharArray(t) THEN
+ 1740                                                   hi := hi + 1
+ 1741                                                 END;
+ 1742                                                 QbeGen.IntStr(lo, qlo);
+ 1743                                                 QbeGen.IntStr(hi, qhi)
+ 1744                                               END;
+ 1745                                               QbeGen.CheckRange(ql, qlo,
+ 1746                                                 qhi);
+ 1747                                               eT := SymTab.ArrayElem(t);
+ 1748                                               QbeGen.ElemAddr(q, ql, qlo,
+ 1749                                                 t, qe);
+ 1750                                               IF SymTab.ClassOf(eT) =
+ 1751                                                  SymTab.ClArray THEN
+ 1752                                                 QbeGen.ElemLoad(qe, eT, q)
+ 1753                                               ELSE QbeGen.CopyOp(qe, q)
+ 1754                                               END;
+ 1755                                               t := eT; sfx := TRUE
+ 1756                                             END; .) }
+ 1757          "]"
+ 1758        | "." GetIdent<fn>
+ 1759                                          (. IF k = SymTab.KindModule THEN
+ 1760                                               (* qualified L.x: materialize
+ 1761                                                  the export, then load it *)
+ 1762                                               IF NOT SymTab.MaterializeAlias(n,
+ 1763                                                    fn, mal) THEN
+ 1764                                                 SemError(201);
+ 1765                                                 t := SymTab.InvalidType;
+ 1766                                                 QbeGen.CopyOp("0", q)
+ 1767                                               ELSE
+ 1768                                                 QbeGen.CopyOp(mal, qn);
+ 1769                                                 t := SymTab.SymType(mal);
+ 1770                                                 k := SymTab.SymKind(mal);
+ 1771                                                 sfx := FALSE;
+ 1772                                                 IF k = SymTab.KindProc THEN
+ 1773                                                   (* call: ArgList supplies
+ 1774                                                      the value *)
+ 1775                                                   QbeGen.CopyOp("0", q)
+ 1776                                                 ELSIF NOT QbeGen.LoadDesignator(
+ 1777                                                      mal, t, k, q) THEN
+ 1778                                                   SemError(230);
+ 1779                                                   QbeGen.CopyOp("0", q)
+ 1780                                                 END
+ 1781                                               END
+ 1782                                             ELSIF t = SymTab.InvalidType THEN
+ 1783                                             ELSIF (SymTab.ClassOf(t) #
+ 1784                                                    SymTab.ClRecord)
+ 1785   AND (SymTab.ClassOf(t) #
+ 1786                                                   SymTab.ClClass) THEN
+ 1787                                               SemError(215);
+ 1788                                               t := SymTab.InvalidType
+ 1789                                             ELSIF (SymTab.ClassOf(t) =
+ 1790                                                    SymTab.ClClass)
+ 1791    AND SymTab.MethodExists(t, fn) THEN
+ 1792                                               (* obj.Method: bind the
+ 1793                                                  method and pass obj as
+ 1794                                                  the hidden receiver; q
+ 1795                                                  already holds the
+ 1796                                                  object's address *)
+ 1797                                               QbeGen.ArmRecv(q);
+ 1798                                               QbeGen.CopyOp(fn, n);
+ 1799                                               QbeGen.CopyOp(fn, qn);
+ 1800                                               methCls := t;
+ 1801                                               k := SymTab.KindProc;
+ 1802                                               t := SymTab.InvalidType
+ 1803                                             ELSIF NOT SymTab.FieldExists(t,
+ 1804                                                      fn) THEN
+ 1805                                               SemError(216);
+ 1806                                               t := SymTab.InvalidType
+ 1807                                             ELSE
+ 1808                                               fo := SymTab.FieldOffset(t,
+ 1809                                                 fn);
+ 1810                                               t := SymTab.FieldType(t, fn);
+ 1811                                               QbeGen.FieldAddr(q, fo, qe);
+ 1812                                               (* array fields are inline:
+ 1813                                                  the field address is the
+ 1814                                                  descriptor, like records *)
+ 1815                                               QbeGen.CopyOp(qe, q);
+ 1816                                               sfx := TRUE
+ 1817                                             END; .)
+ 1818        | "^"
+ 1819                                          (. IF t = SymTab.InvalidType THEN
+ 1820                                             ELSIF SymTab.ClassOf(t) #
+ 1821                                                   SymTab.ClPtr THEN
+ 1822                                               SemError(219);
+ 1823                                               t := SymTab.InvalidType
+ 1824                                             ELSE
+ 1825                                               bt := SymTab.PtrBase(t);
+ 1826                                               IF bt = SymTab.InvalidType THEN
+ 1827                                               ELSE
+ 1828                                                 IF sfx THEN
+ 1829                                                   QbeGen.ElemLoad(q, t,
+ 1830                                                     qb);
+ 1831                                                   QbeGen.CopyOp(qb, q)
+ 1832                                                 END;
+ 1833                                                 t := bt;
+ 1834                                                 (* q holds the pointee
+ 1835                                                    address: Fact loads
+ 1836                                                    scalars/pointers and uses
+ 1837                                                    the address for
+ 1838                                                    aggregates; the VAR-actual
+ 1839                                                    note is q itself. *)
+ 1840                                                 sfx := TRUE
+ 1841                                               END
+ 1842                                             END; .) } .
+ 1843    Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1844                                          (. VAR t2: SymTab.TypeIndex;
+ 1845                                               op: INTEGER;
+ 1846                                               q2, qt, wl: QbeGen.QVal;
+ 1847                                               isR: BOOLEAN; .)
+ 1848      = SimExpr<t, q>
+ 1849        [ Rel<op> SimExpr<t2, q2>
+ 1850          (. IF op = SymTab.OpIn THEN
+ 1851               IF SymTab.InCheck(t, t2) THEN
+ 1852                 IF (t = SymTab.InvalidType)
+ 1853                    OR (t2 = SymTab.InvalidType) THEN
+ 1854                   t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
+ 1855                 ELSE
+ 1856                   QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
+ 1857                     SymTab.SetCount(t2), qt);
+ 1858                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1859                 END
+ 1860               ELSE SemError(222); t := SymTab.InvalidType;
+ 1861                 QbeGen.CopyOp("0", q)
+ 1862               END
+ 1863             ELSIF SymTab.RelCheck(t, t2, op) THEN
+ 1864               IF (t = SymTab.InvalidType)
+ 1865                  OR (t2 = SymTab.InvalidType) THEN
+ 1866                 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
+ 1867               ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
+ 1868                  OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
+ 1869                 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
+ 1870   AND (op # SymTab.OpNeq2) THEN
+ 1871                   SemError(213); t := SymTab.InvalidType;
+ 1872                   QbeGen.CopyOp("0", q)
+ 1873                 ELSE
+ 1874                   QbeGen.CmpL(op, q, q2, qt);
+ 1875                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1876                 END
+ 1877               ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1878                  OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1879                 QbeGen.CmpSet(op, q, q2,
+ 1880                   SymTab.SetWords(t), SymTab.SetWords(t2), qt);
+ 1881                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1882               ELSIF SymTab.StrCompat(t, t2) THEN
+ 1883                 QbeGen.StrEq(op, q, q2, qt);
+ 1884                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1885               ELSIF SymTab.IsLongFamily(t)
+ 1886                  OR SymTab.IsLongFamily(t2) THEN
+ 1887                 IF SymTab.IsIntFamily(t) THEN
+ 1888                   QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
+ 1889                 END;
+ 1890                 IF SymTab.IsIntFamily(t2) THEN
+ 1891                   QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
+ 1892                 END;
+ 1893                 QbeGen.CmpLong(op, q, q2, qt);
+ 1894                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1895               ELSE
+ 1896                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 1897                 t := SymTab.BoolType();
+ 1898                 QbeGen.Cmp(op, q, q2, qt, isR);
+ 1899                 QbeGen.CopyOp(qt, q)
+ 1900               END
+ 1901             ELSE SemError(213); t := SymTab.InvalidType;
+ 1902               QbeGen.CopyOp("0", q)
+ 1903             END; .) ] .
+ 1904    Rel<VAR op: INTEGER>
+ 1905      = "="                               (. op := SymTab.OpEq; .)
+ 1906      | "#"                               (. op := SymTab.OpNeq1; .)
+ 1907      | "<"                               (. op := SymTab.OpLt; .)
+ 1908      | "<="                              (. op := SymTab.OpLe; .)
+ 1909      | ">"                               (. op := SymTab.OpGt; .)
+ 1910      | ">="                              (. op := SymTab.OpGe; .)
+ 1911      | "IN"                              (. op := SymTab.OpIn; .) .
+ 1912    SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1913                                          (. VAR t2, res2, lt, rt:
+ 1914                                                 SymTab.TypeIndex;
+ 1915                                               op: INTEGER;
+ 1916                                               q2, qt, wq, qf, q2a, q2b:
+ 1917                                                 QbeGen.QVal;
+ 1918                                               neg, isR, isL, folded:
+ 1919                                                 BOOLEAN;
+ 1920                                               lw, rw, mw: CARDINAL;
+ 1921                                               lTrue, lNext, lDone, qr, qs:
+ 1922                                                 QbeGen.QVal; .)
+ 1923      =                                   (. neg := FALSE; .)
+ 1924        [ "+" | "-"                       (. neg := TRUE; .) ]
+ 1925        Term<t, q>                        (. IF neg THEN
+ 1926                                             IF QbeGen.IsImm(q) THEN
+ 1927                                               QbeGen.NegFold(q, q)
+ 1928                                             ELSE QbeGen.NewTemp(qt);
+ 1929                                               QbeGen.NegQ(q, qt,
+ 1930                                                 SymTab.ClassOf(t)
+ 1931                                                 = SymTab.ClReal);
+ 1932                                               QbeGen.CopyOp(qt, q)
+ 1933                                             END
+ 1934                                           END; .)
+ 1935        { AddOp<op>                       (. IF op = SymTab.OpOr THEN
+ 1936                                               QbeGen.DelayBegin END; .)
+ 1937          Term<t2, q2>                     (. IF op = SymTab.OpOr THEN
+ 1938                                               QbeGen.DelayEnd END; .)
+ 1939          (. IF op = SymTab.OpOr THEN
+ 1940               (* short-circuit: if q is true the RHS is skipped *)
+ 1941               IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
+ 1942                 t := SymTab.BoolType()
+ 1943               ELSE SemError(212); t := SymTab.InvalidType END;
+ 1944               IF t # SymTab.InvalidType THEN
+ 1945                 QbeGen.Slot4(qs);
+ 1946                 QbeGen.NewLabel(lTrue);
+ 1947                 QbeGen.NewLabel(lNext);
+ 1948                 QbeGen.NewLabel(lDone);
+ 1949                 QbeGen.Jnz(q, lTrue, lNext);
+ 1950                 QbeGen.EmitLabel(lTrue);
+ 1951                 QbeGen.StoreW(qs, "1");
+ 1952                 QbeGen.Jmp(lDone);
+ 1953                 QbeGen.EmitLabel(lNext);
+ 1954                 QbeGen.DelayFlush;
+ 1955                 QbeGen.StoreW(qs, q2);
+ 1956                 QbeGen.Jmp(lDone);
+ 1957                 QbeGen.EmitLabel(lDone);
+ 1958                 QbeGen.LoadW(qs, qr);
+ 1959                 QbeGen.CopyOp(qr, q)
+ 1960               ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
+ 1961               END
+ 1962             ELSIF (op = SymTab.OpAdd)
+ 1963               AND (SymTab.UStrCompat(t, t2)
+ 1964                 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
+ 1965                   AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
+ 1966                 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
+ 1967                   AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
+ 1968                 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
+ 1969                   AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
+ 1970               (* UString concatenation: a UCHAR operand becomes a
+ 1971                  1-codepoint UString; the result is a descriptor in the
+ 1972                  shim's concat buffer.  Work on copies so neither
+ 1973                  operand is clobbered. *)
+ 1974               IF SymTab.ClassOf(t) = SymTab.ClUStr THEN
+ 1975                 QbeGen.CopyOp(q, q2a)
+ 1976               ELSE
+ 1977                 QbeGen.UStrFrom(q, q2a)
+ 1978               END;
+ 1979               IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN
+ 1980                 QbeGen.UStrCat(q2a, q2, qt)
+ 1981               ELSE
+ 1982                 QbeGen.UStrFrom(q2, q2b);
+ 1983                 QbeGen.UStrCat(q2a, q2b, qt)
+ 1984               END;
+ 1985               t := SymTab.NewUStr();
+ 1986               QbeGen.CopyOp(qt, q)
+ 1987             ELSIF (op = SymTab.OpAdd)
+ 1988               AND (SymTab.StrCompat(t, t2)
+ 1989                 OR (SymTab.IsStrType(t)
+ 1990                   AND (SymTab.ClassOf(t2) = SymTab.ClChar))
+ 1991                 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
+ 1992                   AND SymTab.IsStrType(t2))) THEN
+ 1993               (* string concatenation; a CHAR operand becomes a
+ 1994                  1-character string literal *)
+ 1995               IF SymTab.StrCompat(t, t2) THEN
+ 1996                 QbeGen.StrCat(q, q2, qt)
+ 1997               ELSIF SymTab.IsStrType(t) THEN
+ 1998                 QbeGen.DeclCharStr(q2, qs);
+ 1999                 QbeGen.StrCat(q, qs, qt)
+ 2000               ELSE
+ 2001                 QbeGen.DeclCharStr(q, qs);
+ 2002                 QbeGen.StrCat(qs, q2, qt)
+ 2003               END;
+ 2004               t := SymTab.NewStr();
+ 2005               QbeGen.CopyOp(qt, q)
+ 2006             ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
+ 2007   AND (SymTab.ClassOf(t) = SymTab.ClSet)
+ 2008   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 2009               lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
+ 2010               mw := lw;
+ 2011               IF rw > mw THEN mw := rw END;
+ 2012               IF op = SymTab.OpAdd THEN
+ 2013                 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
+ 2014               ELSE
+ 2015                 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
+ 2016               END;
+ 2017               t := SymTab.NewSet(
+ 2018                      SymTab.NewSubR(0,
+ 2019                        VAL(INTEGER, mw) * 32 - 1));
+ 2020               QbeGen.CopyOp(qt, q)
+ 2021             ELSE
+ 2022               IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
+ 2023                 lt := t; rt := t2; t := res2
+ 2024               ELSE SemError(211); t := SymTab.InvalidType END;
+ 2025               IF t # SymTab.InvalidType THEN
+ 2026                 isL := SymTab.IsLongFamily(t);
+ 2027                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 2028                 folded := FALSE;
+ 2029                 IF (NOT isL) AND (NOT isR)
+ 2030    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
+ 2031                   IF op = SymTab.OpAdd THEN
+ 2032                     folded := QbeGen.Fold2(0, q, q2, qf)
+ 2033                   ELSE
+ 2034                     folded := QbeGen.Fold2(1, q, q2, qf)
+ 2035                   END
+ 2036                 END;
+ 2037                 IF folded THEN QbeGen.CopyOp(qf, q)
+ 2038                 ELSE
+ 2039                 IF isL THEN
+ 2040                   IF SymTab.IsIntFamily(lt) THEN
+ 2041                     QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
+ 2042                   END;
+ 2043                   IF SymTab.IsIntFamily(rt) THEN
+ 2044                     QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
+ 2045                   END;
+ 2046                   QbeGen.NewTemp(qt);
+ 2047                   IF op = SymTab.OpAdd THEN
+ 2048                     QbeGen.Op3L("add", qt, q, q2)
+ 2049                   ELSE
+ 2050                     QbeGen.Op3L("sub", qt, q, q2)
+ 2051                   END
+ 2052                 ELSE
+ 2053                   QbeGen.NewTemp(qt);
+ 2054                   IF op = SymTab.OpAdd THEN
+ 2055                     QbeGen.Op3("add", qt, q, q2, isR)
+ 2056                   ELSE
+ 2057                     QbeGen.Op3("sub", qt, q, q2, isR)
+ 2058                   END
+ 2059                 END;
+ 2060                 QbeGen.CopyOp(qt, q)
+ 2061                 END
+ 2062               ELSE QbeGen.CopyOp("0", q)
+ 2063               END
+ 2064             END; .) } .
+ 2065    AddOp<VAR op: INTEGER>
+ 2066      = "+"                               (. op := SymTab.OpAdd; .)
+ 2067      | "-"                               (. op := SymTab.OpSub; .)
+ 2068      | "OR"                              (. op := SymTab.OpOr; .) .
+ 2069    Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2070                                          (. VAR t2, res2, lt, rt:
+ 2071                                                 SymTab.TypeIndex;
+ 2072                                               op: INTEGER;
+ 2073                                               q2, qt, wq, qf:
+ 2074                                                 QbeGen.QVal;
+ 2075                                               isR, isL, folded: BOOLEAN;
+ 2076                                               lw, rw, mw: CARDINAL;
+ 2077                                               lNext, lFalse, lDone, qr, qs:
+ 2078                                                 QbeGen.QVal; .)
+ 2079      = Fact<t, q> { MulOp<op>            (. IF op = SymTab.OpAnd THEN
+ 2080                                               QbeGen.DelayBegin END; .)
+ 2081          Fact<t2, q2>                    (. IF op = SymTab.OpAnd THEN
+ 2082                                               QbeGen.DelayEnd END; .)
+ 2083        (. IF op = SymTab.OpAnd THEN
+ 2084             (* short-circuit: if q is false the RHS is skipped *)
+ 2085             IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
+ 2086               t := SymTab.BoolType()
+ 2087             ELSE SemError(212); t := SymTab.InvalidType END;
+ 2088             IF t # SymTab.InvalidType THEN
+ 2089               QbeGen.Slot4(qs);
+ 2090               QbeGen.NewLabel(lNext);
+ 2091               QbeGen.NewLabel(lFalse);
+ 2092               QbeGen.NewLabel(lDone);
+ 2093               QbeGen.Jnz(q, lNext, lFalse);
+ 2094               QbeGen.EmitLabel(lNext);
+ 2095               QbeGen.DelayFlush;
+ 2096               QbeGen.StoreW(qs, q2);
+ 2097               QbeGen.Jmp(lDone);
+ 2098               QbeGen.EmitLabel(lFalse);
+ 2099               QbeGen.StoreW(qs, "0");
+ 2100               QbeGen.Jmp(lDone);
+ 2101               QbeGen.EmitLabel(lDone);
+ 2102               QbeGen.LoadW(qs, qr);
+ 2103               QbeGen.CopyOp(qr, q)
+ 2104             ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
+ 2105             END
+ 2106           ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
+ 2107   AND (SymTab.ClassOf(t) = SymTab.ClSet)
+ 2108   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 2109             lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
+ 2110             mw := lw;
+ 2111             IF rw > mw THEN mw := rw END;
+ 2112             IF op = SymTab.OpTimes THEN
+ 2113               QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
+ 2114             ELSE
+ 2115               QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
+ 2116             END;
+ 2117             t := SymTab.NewSet(
+ 2118                    SymTab.NewSubR(0,
+ 2119                      VAL(INTEGER, mw) * 32 - 1));
+ 2120             QbeGen.CopyOp(qt, q)
+ 2121           ELSE
+ 2122             IF SymTab.ArithCheck(t, t2,
+ 2123                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+ 2124                  res2) THEN
+ 2125               lt := t; rt := t2; t := res2
+ 2126             ELSE SemError(211); t := SymTab.InvalidType END;
+ 2127             IF t # SymTab.InvalidType THEN
+ 2128               isL := SymTab.IsLongFamily(t);
+ 2129               isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 2130               folded := FALSE;
+ 2131               IF (NOT isL) AND (NOT isR)
+ 2132    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
+ 2133                 IF op = SymTab.OpTimes THEN
+ 2134                   folded := QbeGen.Fold2(2, q, q2, qf)
+ 2135                 ELSIF op = SymTab.OpDiv THEN
+ 2136                   folded := QbeGen.Fold2(3, q, q2, qf)
+ 2137                 ELSIF op = SymTab.OpMod THEN
+ 2138                   folded := QbeGen.Fold2(4, q, q2, qf)
+ 2139                 END
+ 2140               END;
+ 2141               IF folded THEN QbeGen.CopyOp(qf, q)
+ 2142               ELSE
+ 2143               IF isL THEN
+ 2144                 IF SymTab.IsIntFamily(lt) THEN
+ 2145                   QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
+ 2146                 END;
+ 2147                 IF SymTab.IsIntFamily(rt) THEN
+ 2148                   QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
+ 2149                 END;
+ 2150                 QbeGen.NewTemp(qt);
+ 2151                 IF op = SymTab.OpTimes THEN
+ 2152                   QbeGen.Op3L("mul", qt, q, q2)
+ 2153                 ELSIF (op = SymTab.OpDiv)
+ 2154                    OR (op = SymTab.OpSlash) THEN
+ 2155                   QbeGen.Op3L("div", qt, q, q2)
+ 2156                 ELSE
+ 2157                   QbeGen.Op3L("rem", qt, q, q2)
+ 2158                 END
+ 2159               ELSE
+ 2160                 QbeGen.NewTemp(qt);
+ 2161                 IF op = SymTab.OpTimes THEN
+ 2162                   QbeGen.Op3("mul", qt, q, q2, isR)
+ 2163                 ELSIF (op = SymTab.OpDiv)
+ 2164                    OR (op = SymTab.OpSlash) THEN
+ 2165                   QbeGen.Op3("div", qt, q, q2, isR)
+ 2166                 ELSE
+ 2167                   QbeGen.Op3("rem", qt, q, q2, isR)
+ 2168                 END
+ 2169               END;
+ 2170               QbeGen.CopyOp(qt, q)
+ 2171               END
+ 2172             ELSE QbeGen.CopyOp("0", q)
+ 2173             END
+ 2174           END; .) } .
+ 2175    MulOp<VAR op: INTEGER>
+ 2176      = "*"                               (. op := SymTab.OpTimes; .)
+ 2177      | "/"                               (. op := SymTab.OpSlash; .)
+ 2178      | "DIV"                             (. op := SymTab.OpDiv; .)
+ 2179      | "MOD"                             (. op := SymTab.OpMod; .)
+ 2180      | ( "AND" | "&" )                   (. op := SymTab.OpAnd; .) .
+ 2181    Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2182                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
+ 2183                                               et, dt, t2, st, ct2:
+ 2184                                                 SymTab.TypeIndex;
+ 2185                                               dk: INTEGER;
+ 2186                                               qd, q2, sq, qa, qm0, qr:
+ 2187                                                 QbeGen.QVal;
+ 2188                                               qn, vn: SymTab.Name;
+ 2189                                               vt: SymTab.TypeIndex;
+ 2190                                               c1, c2: INTEGER;
+ 2191                                               called, isHigh, sfx, isCh,
+ 2192                                               isU, uok, isStr: BOOLEAN;
+ 2193                                               ucp: INTEGER; .)
+ 2194      = integer                           (. LexString(s);
+ 2195                                             QbeGen.NormInt(s, q);
+ 2196                                             t := SymTab.IntType(); .)
+ 2197      | charConst                         (. LexString(s);
+ 2198                                             QbeGen.NormLit(s, q, isCh);
+ 2199                                             t := SymTab.CharType(); .)
+ 2200      | real                              (. LexString(s);
+ 2201                                             QbeGen.NormReal(s, q);
+ 2202                                             t := SymTab.RealType(); .)
+ 2203      | string                            (. LexString(s);
+ 2204                                             IF SymTab.StrLen(s) = 3 THEN
+ 2205                                               t := SymTab.CharType();
+ 2206                                               QbeGen.IntStr(
+ 2207                                                 QbeGen.CharVal(s), q)
+ 2208                                             ELSE t := SymTab.NewStr();
+ 2209                                               QbeGen.DeclStr(s, q);
+ 2210                                               (* a literal's value IS its
+ 2211                                                  static descriptor address *)
+ 2212                                               QbeGen.NoteAddr(q, q)
+ 2213                                             END; .)
+ 2214      | ustring                           (. LexString(s);
+ 2215                                             QbeGen.DeclUStr(s, q, isU, ucp,
+ 2216                                               uok);
+ 2217                                             IF NOT uok THEN
+ 2218                                               SemError(234);
+ 2219                                               t := SymTab.InvalidType
+ 2220                                             ELSIF isU THEN
+ 2221                                               t := SymTab.UCharType();
+ 2222                                               QbeGen.IntStr(ucp, q)
+ 2223                                             ELSE
+ 2224                                               t := SymTab.NewUStr();
+ 2225                                               QbeGen.NoteAddr(q, q)
+ 2226                                             END; .)
+ 2227      | Design<dt, dk, qd, qn, sfx>       (. called := FALSE;
+ 2228                                             t := dt;
+ 2229                                             IF sfx THEN
+ 2230                                               IF dt =
+ 2231                                                  SymTab.InvalidType THEN
+ 2232                                                 QbeGen.CopyOp("0", q)
+ 2233                                               ELSIF (SymTab.ClassOf(dt) =
+ 2234                                                      SymTab.ClRecord)
+ 2235                                                  OR (SymTab.ClassOf(dt) =
+ 2236                                                      SymTab.ClSet)
+ 2237                                                  OR (SymTab.ClassOf(dt) =
+ 2238                                                      SymTab.ClArray)
+ 2239                                                  OR (SymTab.ClassOf(dt) =
+ 2240                                                      SymTab.ClClass) THEN
+ 2241                                                 QbeGen.CopyOp(qd, q)
+ 2242                                               ELSE QbeGen.ElemLoad(qd, dt,
+ 2243                                                 q)
+ 2244                                               END
+ 2245                                             ELSE QbeGen.CopyOp(qd, q)
+ 2246                                             END;
+ 2247                                             IF (dk = SymTab.KindVar)
+ 2248                                                OR (dk = SymTab.KindParam)
+ 2249                                                OR (dk =
+ 2250                                                   SymTab.KindField) THEN
+ 2251                                               IF sfx THEN
+ 2252                                                 QbeGen.NoteAddr(q, qd)
+ 2253                                               ELSE
+ 2254                                                 QbeGen.AddrOf(qn, qa);
+ 2255                                                 QbeGen.NoteAddr(q, qa)
+ 2256                                               END
+ 2257                                             ELSIF sfx
+ 2258   AND (dt #
+ 2259                                                   SymTab.InvalidType)
+ 2260   AND ((SymTab.ClassOf(dt) =
+ 2261                                                    SymTab.ClArray)
+ 2262                                                   OR (SymTab.ClassOf(dt) =
+ 2263                                                       SymTab.ClSet)
+ 2264                                                   OR (SymTab.ClassOf(dt) =
+ 2265                                                       SymTab.ClRecord)) THEN
+ 2266                                               QbeGen.NoteAddr(qd, qd)
+ 2267                                             END; .)
+ 2268        [ TypedSetLit<dt, q>              (. t := dt; .) ]
+ 2269        [ ArgList<qn, dt, qd, TRUE, methCls, ct2, q2, called>
+ 2270                                          (. t := ct2;
+ 2271                                             QbeGen.CopyOp(q2, q); .) ]
+ 2272                                          (. IF NOT called
+ 2273   AND (dk = SymTab.KindProc) THEN
+ 2274                                               (* bare zero-arg function
+ 2275                                                  call (parentheses may be
+ 2276                                                  omitted); a proper or
+ 2277                                                  parameterised proc here
+ 2278                                                  is 230 *)
+ 2279                                               IF (SymTab.ProcNPar(qn) = 0)
+ 2280   AND (SymTab.ProcRes(qn) #
+ 2281                                                     SymTab.InvalidType) THEN
+ 2282                                                 QbeGen.Mangled(qn,
+ 2283                                                   SymTab.ProcUid(qn), qm0);
+ 2284                                                 QbeGen.CallBegin(qm0,
+ 2285                                                   SymTab.ProcRes(qn),
+ 2286                                                   SymTab.ProcDepthOf(qn),
+ 2287                                                   SymTab.IsExternal(qn));
+ 2288                                                 QbeGen.CallEnd(TRUE, q);
+ 2289                                                 t := SymTab.ProcRes(qn)
+ 2290                                               ELSE
+ 2291                                                 (* procedure used as a
+ 2292                                                    value (assign to a
+ 2293                                                    procedure variable):
+ 2294                                                    its code address *)
+ 2295                                                 t := SymTab.ProcTypeOf(qn);
+ 2296                                                 QbeGen.Mangled(qn,
+ 2297                                                   SymTab.ProcUid(qn), qm0);
+ 2298                                                 QbeGen.ProcAddr(qm0, q)
+ 2299                                               END
+ 2300                                             END; .)
+ 2301      | ( "HIGH"                          (. isHigh := TRUE; .)
+ 2302        | ( "LEN" | "LENGTH" )            (. isHigh := FALSE; .) )
+ 2303        "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
+ 2304                                              isU := FALSE; .)
+ 2305            | string                       (. LexString(s);
+ 2306                                              isStr := TRUE;
+ 2307                                              isU := FALSE;
+ 2308                                              IF SymTab.StrLen(s) = 3 THEN
+ 2309                                                dt := SymTab.CharType();
+ 2310                                                QbeGen.IntStr(QbeGen.CharVal(s),
+ 2311                                                  qd)
+ 2312                                              ELSE
+ 2313                                                dt := SymTab.NewStr();
+ 2314                                                QbeGen.DeclStr(s, qd);
+ 2315                                                QbeGen.NoteAddr(qd, qd)
+ 2316                                              END;
+ 2317                                              dk := -1;
+ 2318                                              qn[0] := CHR(0); .)
+ 2319            | ustring                      (. LexString(s);
+ 2320                                              QbeGen.DeclUStr(s, qd, isU, ucp,
+ 2321                                                uok);
+ 2322                                              isStr := FALSE;
+ 2323                                              IF NOT uok THEN
+ 2324                                                SemError(234);
+ 2325                                                dt := SymTab.InvalidType
+ 2326                                              ELSIF isU THEN
+ 2327                                                (* one codepoint: a UCHAR;
+ 2328                                                   LEN is 1, HIGH is 0 *)
+ 2329                                                dt := SymTab.UCharType();
+ 2330                                                QbeGen.IntStr(ucp, qd)
+ 2331                                              ELSE
+ 2332                                                dt := SymTab.NewUStr();
+ 2333                                                QbeGen.NoteAddr(qd, qd)
+ 2334                                              END;
+ 2335                                              dk := -1;
+ 2336                                              qn[0] := CHR(0); .) )
+ 2337        ")"
+ 2338                                          (. IF (dt # SymTab.InvalidType)
+ 2339    AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
+ 2340                                               (* UString: the count is
+ 2341                                                  the descriptor header *)
  2342                                               IF isHigh THEN
- 2343                                                 QbeGen.CopyOp("0", qr)
- 2344                                               ELSE
- 2345                                                 QbeGen.CopyOp("1", qr)
- 2346                                               END;
- 2347                                               t := SymTab.IntType();
- 2348                                               QbeGen.CopyOp(qr, q)
- 2349                                             ELSIF isStr THEN
- 2350                                               (* fold: content length at
- 2351                                                  compile time *)
- 2352                                               IF SymTab.StrLen(s) = 3 THEN
- 2353                                                 c1 := 1
- 2354                                               ELSE
- 2355                                                 c1 :=
- 2356                                                   SymTab.StrLen(s) - 2
+ 2343                                                 QbeGen.UStrLen(qd, qr);
+ 2344                                                 QbeGen.DecQ(qr)
+ 2345                                               ELSE
+ 2346                                                 QbeGen.UStrLen(qd, qr)
+ 2347                                               END;
+ 2348                                               t := SymTab.IntType();
+ 2349                                               QbeGen.CopyOp(qr, q)
+ 2350                                             ELSIF (dt # SymTab.InvalidType)
+ 2351    AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
+ 2352                                               (* single UCHAR codepoint *)
+ 2353                                               IF isHigh THEN
+ 2354                                                 QbeGen.CopyOp("0", qr)
+ 2355                                               ELSE
+ 2356                                                 QbeGen.CopyOp("1", qr)
  2357                                               END;
- 2358                                               IF isHigh THEN
- 2359                                                 DEC(c1)
- 2360                                               END;
- 2361                                               QbeGen.IntStr(c1, qr);
- 2362                                               t := SymTab.IntType();
- 2363                                               QbeGen.CopyOp(qr, q)
- 2364                                             ELSIF dt = SymTab.InvalidType THEN
- 2365                                               t := SymTab.InvalidType;
- 2366                                               QbeGen.CopyOp("0", q)
- 2367                                             ELSIF SymTab.ClassOf(dt) #
- 2368                                                   SymTab.ClArray THEN
- 2369                                               SemError(217);
- 2370                                               t := SymTab.InvalidType;
- 2371                                               QbeGen.CopyOp("0", q)
- 2372                                             ELSE
- 2373                                               IF isHigh THEN
- 2374                                                 IF SymTab.IsOpenArray(dt) THEN
- 2375                                                   QbeGen.OpenHi(qd, qr)
- 2376                                                 ELSE
- 2377                                                   QbeGen.IntStr(
- 2378                                                     SymTab.ArrayHi(dt), qr)
- 2379                                                 END
- 2380                                               ELSE
- 2381                                                 IF SymTab.IsOpenArray(dt) THEN
- 2382                                                   QbeGen.LoadCount(qd, qr)
- 2383                                                 ELSE
- 2384                                                   QbeGen.IntStr(VAL(
- 2385                                                     INTEGER,
- 2386                                                     SymTab.ArrayLen(dt)),
- 2387                                                     qr)
- 2388                                                 END
- 2389                                               END;
- 2390                                                t := SymTab.IntType();
- 2391                                                QbeGen.CopyOp(qr, q)
- 2392                                              END; .)
- 2393      | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
- 2394                                          (. IF dt = SymTab.InvalidType THEN
- 2395                                               t := SymTab.InvalidType;
- 2396                                               QbeGen.CopyOp("0", q)
- 2397                                             ELSE
- 2398                                               QbeGen.IntStr(VAL(INTEGER,
- 2399                                                 SymTab.ObjectSize(dt)), q);
- 2400                                               t := SymTab.IntType()
- 2401                                             END; .)
- 2402      | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
- 2403                                          (. IF dt = SymTab.InvalidType THEN
- 2404                                               t := SymTab.InvalidType;
- 2405                                               QbeGen.CopyOp("0", q)
- 2406                                             ELSE
- 2407                                               IF sfx THEN
- 2408                                                 QbeGen.CopyOp(qd, q)
- 2409                                               ELSIF (dk = SymTab.KindVar)
- 2410                                                  OR (dk = SymTab.KindParam) THEN
- 2411                                                 QbeGen.AddrOf(qn, q)
- 2412                                               ELSE SemError(230);
- 2413                                                 QbeGen.CopyOp("0", q)
- 2414                                               END;
- 2415                                               t := SymTab.AddrType()
- 2416                                             END; .)
- 2417      | "CHR" "(" Expr<et, q> ")"
- 2418                                          (. IF (et # SymTab.InvalidType)
- 2419   AND NOT SymTab.IsIntFamily(et) THEN
- 2420                                               SemError(211) END;
- 2421                                             t := SymTab.CharType(); .)
- 2422      | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
- 2423                                          (. IF et # SymTab.InvalidType THEN
- 2424                                               IF (SymTab.ClassOf(et) #
- 2425                                                   SymTab.ClChar)
- 2426   AND (SymTab.ClassOf(et) #
- 2427                                                     SymTab.ClBool)
- 2428   AND (SymTab.ClassOf(et) #
- 2429                                                     SymTab.ClEnum)
+ 2358                                               t := SymTab.IntType();
+ 2359                                               QbeGen.CopyOp(qr, q)
+ 2360                                             ELSIF isStr THEN
+ 2361                                               (* fold: content length at
+ 2362                                                  compile time *)
+ 2363                                               IF SymTab.StrLen(s) = 3 THEN
+ 2364                                                 c1 := 1
+ 2365                                               ELSE
+ 2366                                                 c1 :=
+ 2367                                                   SymTab.StrLen(s) - 2
+ 2368                                               END;
+ 2369                                               IF isHigh THEN
+ 2370                                                 DEC(c1)
+ 2371                                               END;
+ 2372                                               QbeGen.IntStr(c1, qr);
+ 2373                                               t := SymTab.IntType();
+ 2374                                               QbeGen.CopyOp(qr, q)
+ 2375                                             ELSIF dt = SymTab.InvalidType THEN
+ 2376                                               t := SymTab.InvalidType;
+ 2377                                               QbeGen.CopyOp("0", q)
+ 2378                                             ELSIF SymTab.ClassOf(dt) #
+ 2379                                                   SymTab.ClArray THEN
+ 2380                                               SemError(217);
+ 2381                                               t := SymTab.InvalidType;
+ 2382                                               QbeGen.CopyOp("0", q)
+ 2383                                             ELSE
+ 2384                                               IF isHigh THEN
+ 2385                                                 IF SymTab.IsOpenArray(dt) THEN
+ 2386                                                   QbeGen.OpenHi(qd, qr)
+ 2387                                                 ELSE
+ 2388                                                   QbeGen.IntStr(
+ 2389                                                     SymTab.ArrayHi(dt), qr)
+ 2390                                                 END
+ 2391                                               ELSE
+ 2392                                                 IF SymTab.IsOpenArray(dt) THEN
+ 2393                                                   QbeGen.LoadCount(qd, qr)
+ 2394                                                 ELSE
+ 2395                                                   QbeGen.IntStr(VAL(
+ 2396                                                     INTEGER,
+ 2397                                                     SymTab.ArrayLen(dt)),
+ 2398                                                     qr)
+ 2399                                                 END
+ 2400                                               END;
+ 2401                                                t := SymTab.IntType();
+ 2402                                                QbeGen.CopyOp(qr, q)
+ 2403                                              END; .)
+ 2404      | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
+ 2405                                          (. IF dt = SymTab.InvalidType THEN
+ 2406                                               t := SymTab.InvalidType;
+ 2407                                               QbeGen.CopyOp("0", q)
+ 2408                                             ELSE
+ 2409                                               QbeGen.IntStr(VAL(INTEGER,
+ 2410                                                 SymTab.ObjectSize(dt)), q);
+ 2411                                               t := SymTab.IntType()
+ 2412                                             END; .)
+ 2413      | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
+ 2414                                          (. IF dt = SymTab.InvalidType THEN
+ 2415                                               t := SymTab.InvalidType;
+ 2416                                               QbeGen.CopyOp("0", q)
+ 2417                                             ELSE
+ 2418                                               IF sfx THEN
+ 2419                                                 QbeGen.CopyOp(qd, q)
+ 2420                                               ELSIF (dk = SymTab.KindVar)
+ 2421                                                  OR (dk = SymTab.KindParam) THEN
+ 2422                                                 QbeGen.AddrOf(qn, q)
+ 2423                                               ELSE SemError(230);
+ 2424                                                 QbeGen.CopyOp("0", q)
+ 2425                                               END;
+ 2426                                               t := SymTab.AddrType()
+ 2427                                             END; .)
+ 2428      | "CHR" "(" Expr<et, q> ")"
+ 2429                                          (. IF (et # SymTab.InvalidType)
  2430   AND NOT SymTab.IsIntFamily(et) THEN
- 2431                                                 SemError(211) END
- 2432                                             END;
- 2433                                             t := SymTab.IntType(); .)
- 2434      | "CAP" "(" Expr<et, q> ")"
- 2435                                          (. QbeGen.CapQ(q, qa);
- 2436                                             QbeGen.CopyOp(qa, q);
- 2437                                             t := SymTab.CharType(); .)
- 2438      | "UCHR" "(" Expr<et, q> ")"
- 2439                                          (. (* UCHR: the UCHAR constructor.
- 2440                                                CHAR -> UCHAR (identity);
- 2441                                                INTEGER familly -> UCHAR
- 2442                                                (codepoint value). *)
- 2443                                             IF (et # SymTab.InvalidType)
- 2444    AND (SymTab.ClassOf(et) # SymTab.ClChar)
- 2445    AND NOT SymTab.IsIntFamily(et) THEN
- 2446                                               SemError(211) END;
- 2447                                             t := SymTab.UCharType(); .)
- 2448      | "CHR8" "(" Expr<et, q> ")"
- 2449                                          (. IF (et # SymTab.InvalidType)
- 2450    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
- 2451                                               SemError(211) END;
- 2452                                             QbeGen.WidenLong(q, qa);
- 2453                                             QbeGen.CheckRange(qa, "0", "255");
- 2454                                             t := SymTab.CharType(); .)
- 2455      | "UORD" "(" Expr<et, q> ")"
- 2456                                          (. (* UORD(u): the codepoint as a
- 2457                                                32-bit ordinal (INTEGER),
- 2458                                                cf. ORD for CHAR. *)
- 2459                                             IF (et # SymTab.InvalidType)
- 2460    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
- 2461                                               SemError(211) END;
- 2462                                             t := SymTab.IntType(); .)
- 2463      | "ABS" "(" Expr<et, q> ")"
- 2464                                          (. IF (et # SymTab.InvalidType)
- 2465   AND NOT SymTab.IsIntFamily(et)
- 2466   AND (SymTab.ClassOf(et) #
- 2467                                                  SymTab.ClReal) THEN
- 2468                                               SemError(211)
- 2469                                             ELSE QbeGen.AbsQ(q, qa,
- 2470                                                    SymTab.ClassOf(et) =
- 2471                                                      SymTab.ClReal);
- 2472                                               QbeGen.CopyOp(qa, q)
- 2473                                             END;
- 2474                                             t := et; .)
- 2475      | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
- 2476                                          (. IF NOT SymTab.Lookup(vn) THEN
- 2477                                               SemError(201);
- 2478                                               t := SymTab.InvalidType
- 2479                                             ELSE vt := SymTab.SymType(vn);
- 2480                                               IF vt = SymTab.InvalidType THEN
- 2481                                                 t := SymTab.InvalidType
- 2482                                               ELSIF et =
- 2483                                                  SymTab.InvalidType THEN
- 2484                                                 t := vt
- 2485                                               ELSE
- 2486                                                 c1 := SymTab.ClassOf(et);
- 2487                                                 c2 := SymTab.ClassOf(vt);
- 2488                                                 IF ((c1 = SymTab.ClInt)
- 2489                                                     OR (c1 =
- 2490                                                        SymTab.ClChar)
- 2491                                                     OR (c1 =
- 2492                                                        SymTab.ClBool)
- 2493                                                     OR (c1 =
- 2494                                                        SymTab.ClEnum))
- 2495   AND ((c2 = SymTab.ClInt)
- 2496                                                     OR (c2 =
- 2497                                                        SymTab.ClChar)
- 2498                                                     OR (c2 =
- 2499                                                        SymTab.ClBool)
- 2500                                                     OR (c2 =
- 2501                                                        SymTab.ClEnum)) THEN
- 2502                                                   t := vt
- 2503                                                 ELSIF (c1 = SymTab.ClPtr)
- 2504   AND (c2 = SymTab.ClPtr) THEN
- 2505                                                   t := vt
- 2506                                                 ELSIF (c1 = SymTab.ClReal)
- 2507   AND (c2 = SymTab.ClReal) THEN
- 2508                                                   t := vt
- 2509                                                 ELSE SemError(230);
- 2510                                                   t := SymTab.InvalidType
- 2511                                                 END
- 2512                                               END
- 2513                                             END; .)
- 2514      | "(" Expr<et, q> ")"               (. t := et; .)
- 2515      | SetLit<st, sq>                    (. t := st;
- 2516                                             QbeGen.CopyOp(sq, q); .)
- 2517      | ( "NOT" | "~" ) Fact<t2, q2>      (. IF SymTab.BoolCheck(t2) THEN
- 2518                                               t := SymTab.BoolType()
- 2519                                             ELSE SemError(212);
- 2520                                               t := SymTab.InvalidType END;
- 2521                                             IF t # SymTab.InvalidType THEN
- 2522                                               QbeGen.NotQ(q2, q)
- 2523                                             ELSE QbeGen.CopyOp("0", q)
- 2524                                             END; .) .
- 2525    (* Set literals are SET OF [0..255] (8 words); elements validated
- 2526       0..255 statically when foldable (222 otherwise), runtime trap
- 2527       for computed elements. Ranges always lower via SetRange. *)
- 2528    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2529      = "{"                               (. t := SymTab.NewSet(
- 2530                                               SymTab.NewSubR(0, 255));
- 2531                                             QbeGen.NewSetTemp(8, q);
- 2532                                             QbeGen.SetZero(q, 8); .)
- 2533        [ SetElem<t, q> { "," SetElem<t, q> } ]
- 2534        "}" .
- 2535    (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
- 2536       BITSET{}.  The declared type (not SET OF [0..255]) sets the
- 2537       width and element span. *)
- 2538    TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2539                                          (. VAR nw: CARDINAL; .)
- 2540      = "{"                               (. IF SymTab.ClassOf(vt) #
- 2541                                                SymTab.ClSet THEN
- 2542                                               SemError(230); nw := 8
- 2543                                             ELSE nw := SymTab.SetWords(vt);
- 2544                                               IF nw = 0 THEN nw := 8 END
- 2545                                             END;
- 2546                                             QbeGen.NewSetTemp(nw, q);
- 2547                                             QbeGen.SetZero(q, nw); .)
- 2548        [ SetElem<vt, q> { "," SetElem<vt, q> } ]
- 2549        "}" .
- 2550    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
- 2551                                               qe, q2: QbeGen.QVal;
- 2552                                               v, v2: INTEGER;
- 2553                                               lo: INTEGER;
- 2554                                               span: CARDINAL;
- 2555                                               cl, cl2: INTEGER;
- 2556                                               hasR: BOOLEAN; .)
- 2557      =                                   (. hasR := FALSE; .)
- 2558        Expr<et, qe>
- 2559        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
- 2560                                          (. lo := SymTab.SetBaseLo(st);
- 2561                                             span := SymTab.SetCount(st);
- 2562                                             IF (et = SymTab.InvalidType)
- 2563                                                OR (hasR AND (et2 =
- 2564                                                   SymTab.InvalidType)) THEN
- 2565                                             ELSE cl :=
- 2566                                                    SymTab.ClassOf(et);
- 2567                                               IF hasR THEN
- 2568                                                 cl2 :=
- 2569                                                   SymTab.ClassOf(et2)
- 2570                                               ELSE cl2 := SymTab.ClInt
- 2571                                               END;
- 2572                                               IF ((cl # SymTab.ClInt)
- 2573   AND (cl # SymTab.ClChar)
- 2574   AND (cl # SymTab.ClBool))
- 2575                                                  OR (hasR AND 
- 2576                                                     ((cl2
- 2577                                                       # SymTab.ClInt)
- 2578   AND (cl2
- 2579                                                        # SymTab.ClChar)
- 2580   AND (cl2
- 2581                                                        # SymTab.ClBool))) THEN
- 2582                                                 SemError(222)
- 2583                                               ELSIF hasR
- 2584   AND SymTab.ConstInt(qe, v)
- 2585   AND SymTab.ConstInt(q2,
- 2586                                                     v2)
- 2587   AND ((v < lo)
- 2588                                                     OR (v2 < lo)
- 2589                                                     OR (v >= lo +
- 2590                                                        VAL(INTEGER, span))
- 2591                                                     OR (v2 >= lo +
- 2592                                                        VAL(INTEGER, span))
- 2593                                                     OR (v > v2)) THEN
- 2594                                                 SemError(222)
- 2595                                                ELSIF hasR THEN
- 2596                                                  QbeGen.SetRange(sq, qe, q2,
- 2597                                                    lo, span)
- 2598                                                ELSIF SymTab.ConstInt(qe,
- 2599                                                        v)
- 2600   AND ((v < lo)
- 2601                                                      OR (v >= lo +
- 2602                                                         VAL(INTEGER,
- 2603                                                           span))) THEN
- 2604                                                  SemError(222)
- 2605                                                ELSE QbeGen.SetBit(sq, qe,
- 2606                                                  lo, span)
- 2607                                               END
- 2608                                             END; .) .
- 2609    GetIdent<VAR n: SymTab.Name>
- 2610      = ident                             (. LexName(n); .) .
- 2611  
- 2612  END M2.
+ 2431                                               SemError(211) END;
+ 2432                                             t := SymTab.CharType(); .)
+ 2433      | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
+ 2434                                          (. IF et # SymTab.InvalidType THEN
+ 2435                                               IF (SymTab.ClassOf(et) #
+ 2436                                                   SymTab.ClChar)
+ 2437   AND (SymTab.ClassOf(et) #
+ 2438                                                     SymTab.ClBool)
+ 2439   AND (SymTab.ClassOf(et) #
+ 2440                                                     SymTab.ClEnum)
+ 2441   AND NOT SymTab.IsIntFamily(et) THEN
+ 2442                                                 SemError(211) END
+ 2443                                             END;
+ 2444                                             t := SymTab.IntType(); .)
+ 2445      | "CAP" "(" Expr<et, q> ")"
+ 2446                                          (. QbeGen.CapQ(q, qa);
+ 2447                                             QbeGen.CopyOp(qa, q);
+ 2448                                             t := SymTab.CharType(); .)
+ 2449      | "UCHR" "(" Expr<et, q> ")"
+ 2450                                          (. (* UCHR: the UCHAR constructor.
+ 2451                                                CHAR -> UCHAR (identity);
+ 2452                                                INTEGER familly -> UCHAR
+ 2453                                                (codepoint value). *)
+ 2454                                             IF (et # SymTab.InvalidType)
+ 2455    AND (SymTab.ClassOf(et) # SymTab.ClChar)
+ 2456    AND NOT SymTab.IsIntFamily(et) THEN
+ 2457                                               SemError(211) END;
+ 2458                                             t := SymTab.UCharType(); .)
+ 2459      | "CHR8" "(" Expr<et, q> ")"
+ 2460                                          (. IF (et # SymTab.InvalidType)
+ 2461    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
+ 2462                                               SemError(211) END;
+ 2463                                             QbeGen.WidenLong(q, qa);
+ 2464                                             QbeGen.CheckRange(qa, "0", "255");
+ 2465                                             t := SymTab.CharType(); .)
+ 2466      | "UORD" "(" Expr<et, q> ")"
+ 2467                                          (. (* UORD(u): the codepoint as a
+ 2468                                                32-bit ordinal (INTEGER),
+ 2469                                                cf. ORD for CHAR. *)
+ 2470                                             IF (et # SymTab.InvalidType)
+ 2471    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
+ 2472                                               SemError(211) END;
+ 2473                                             t := SymTab.IntType(); .)
+ 2474      | "ABS" "(" Expr<et, q> ")"
+ 2475                                          (. IF (et # SymTab.InvalidType)
+ 2476   AND NOT SymTab.IsIntFamily(et)
+ 2477   AND (SymTab.ClassOf(et) #
+ 2478                                                  SymTab.ClReal) THEN
+ 2479                                               SemError(211)
+ 2480                                             ELSE QbeGen.AbsQ(q, qa,
+ 2481                                                    SymTab.ClassOf(et) =
+ 2482                                                      SymTab.ClReal);
+ 2483                                               QbeGen.CopyOp(qa, q)
+ 2484                                             END;
+ 2485                                             t := et; .)
+ 2486      | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
+ 2487                                          (. IF NOT SymTab.Lookup(vn) THEN
+ 2488                                               SemError(201);
+ 2489                                               t := SymTab.InvalidType
+ 2490                                             ELSE vt := SymTab.SymType(vn);
+ 2491                                               IF vt = SymTab.InvalidType THEN
+ 2492                                                 t := SymTab.InvalidType
+ 2493                                               ELSIF et =
+ 2494                                                  SymTab.InvalidType THEN
+ 2495                                                 t := vt
+ 2496                                               ELSE
+ 2497                                                 c1 := SymTab.ClassOf(et);
+ 2498                                                 c2 := SymTab.ClassOf(vt);
+ 2499                                                 IF ((c1 = SymTab.ClInt)
+ 2500                                                     OR (c1 =
+ 2501                                                        SymTab.ClChar)
+ 2502                                                     OR (c1 =
+ 2503                                                        SymTab.ClBool)
+ 2504                                                     OR (c1 =
+ 2505                                                        SymTab.ClEnum))
+ 2506   AND ((c2 = SymTab.ClInt)
+ 2507                                                     OR (c2 =
+ 2508                                                        SymTab.ClChar)
+ 2509                                                     OR (c2 =
+ 2510                                                        SymTab.ClBool)
+ 2511                                                     OR (c2 =
+ 2512                                                        SymTab.ClEnum)) THEN
+ 2513                                                   t := vt
+ 2514                                                 ELSIF (c1 = SymTab.ClPtr)
+ 2515   AND (c2 = SymTab.ClPtr) THEN
+ 2516                                                   t := vt
+ 2517                                                 ELSIF (c1 = SymTab.ClReal)
+ 2518   AND (c2 = SymTab.ClReal) THEN
+ 2519                                                   t := vt
+ 2520                                                 ELSE SemError(230);
+ 2521                                                   t := SymTab.InvalidType
+ 2522                                                 END
+ 2523                                               END
+ 2524                                             END; .)
+ 2525      | "(" Expr<et, q> ")"               (. t := et; .)
+ 2526      | SetLit<st, sq>                    (. t := st;
+ 2527                                             QbeGen.CopyOp(sq, q); .)
+ 2528      | ( "NOT" | "~" ) Fact<t2, q2>      (. IF SymTab.BoolCheck(t2) THEN
+ 2529                                               t := SymTab.BoolType()
+ 2530                                             ELSE SemError(212);
+ 2531                                               t := SymTab.InvalidType END;
+ 2532                                             IF t # SymTab.InvalidType THEN
+ 2533                                               QbeGen.NotQ(q2, q)
+ 2534                                             ELSE QbeGen.CopyOp("0", q)
+ 2535                                             END; .) .
+ 2536    (* Set literals are SET OF [0..255] (8 words); elements validated
+ 2537       0..255 statically when foldable (222 otherwise), runtime trap
+ 2538       for computed elements. Ranges always lower via SetRange. *)
+ 2539    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2540      = "{"                               (. t := SymTab.NewSet(
+ 2541                                               SymTab.NewSubR(0, 255));
+ 2542                                             QbeGen.NewSetTemp(8, q);
+ 2543                                             QbeGen.SetZero(q, 8); .)
+ 2544        [ SetElem<t, q> { "," SetElem<t, q> } ]
+ 2545        "}" .
+ 2546    (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
+ 2547       BITSET{}.  The declared type (not SET OF [0..255]) sets the
+ 2548       width and element span. *)
+ 2549    TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2550                                          (. VAR nw: CARDINAL; .)
+ 2551      = "{"                               (. IF SymTab.ClassOf(vt) #
+ 2552                                                SymTab.ClSet THEN
+ 2553                                               SemError(230); nw := 8
+ 2554                                             ELSE nw := SymTab.SetWords(vt);
+ 2555                                               IF nw = 0 THEN nw := 8 END
+ 2556                                             END;
+ 2557                                             QbeGen.NewSetTemp(nw, q);
+ 2558                                             QbeGen.SetZero(q, nw); .)
+ 2559        [ SetElem<vt, q> { "," SetElem<vt, q> } ]
+ 2560        "}" .
+ 2561    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
+ 2562                                               qe, q2: QbeGen.QVal;
+ 2563                                               v, v2: INTEGER;
+ 2564                                               lo: INTEGER;
+ 2565                                               span: CARDINAL;
+ 2566                                               cl, cl2: INTEGER;
+ 2567                                               hasR: BOOLEAN; .)
+ 2568      =                                   (. hasR := FALSE; .)
+ 2569        Expr<et, qe>
+ 2570        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
+ 2571                                          (. lo := SymTab.SetBaseLo(st);
+ 2572                                             span := SymTab.SetCount(st);
+ 2573                                             IF (et = SymTab.InvalidType)
+ 2574                                                OR (hasR AND (et2 =
+ 2575                                                   SymTab.InvalidType)) THEN
+ 2576                                             ELSE cl :=
+ 2577                                                    SymTab.ClassOf(et);
+ 2578                                               IF hasR THEN
+ 2579                                                 cl2 :=
+ 2580                                                   SymTab.ClassOf(et2)
+ 2581                                               ELSE cl2 := SymTab.ClInt
+ 2582                                               END;
+ 2583                                               IF ((cl # SymTab.ClInt)
+ 2584   AND (cl # SymTab.ClChar)
+ 2585   AND (cl # SymTab.ClBool))
+ 2586                                                  OR (hasR AND 
+ 2587                                                     ((cl2
+ 2588                                                       # SymTab.ClInt)
+ 2589   AND (cl2
+ 2590                                                        # SymTab.ClChar)
+ 2591   AND (cl2
+ 2592                                                        # SymTab.ClBool))) THEN
+ 2593                                                 SemError(222)
+ 2594                                               ELSIF hasR
+ 2595   AND SymTab.ConstInt(qe, v)
+ 2596   AND SymTab.ConstInt(q2,
+ 2597                                                     v2)
+ 2598   AND ((v < lo)
+ 2599                                                     OR (v2 < lo)
+ 2600                                                     OR (v >= lo +
+ 2601                                                        VAL(INTEGER, span))
+ 2602                                                     OR (v2 >= lo +
+ 2603                                                        VAL(INTEGER, span))
+ 2604                                                     OR (v > v2)) THEN
+ 2605                                                 SemError(222)
+ 2606                                                ELSIF hasR THEN
+ 2607                                                  QbeGen.SetRange(sq, qe, q2,
+ 2608                                                    lo, span)
+ 2609                                                ELSIF SymTab.ConstInt(qe,
+ 2610                                                        v)
+ 2611   AND ((v < lo)
+ 2612                                                      OR (v >= lo +
+ 2613                                                         VAL(INTEGER,
+ 2614                                                           span))) THEN
+ 2615                                                  SemError(222)
+ 2616                                                ELSE QbeGen.SetBit(sq, qe,
+ 2617                                                  lo, span)
+ 2618                                               END
+ 2619                                             END; .) .
+ 2620    GetIdent<VAR n: SymTab.Name>
+ 2621      = ident                             (. LexName(n); .) .
+ 2622  
+ 2623  END M2.
 
     0 errors
 

compiler/src/QbeGen.def

@@ -98,6 +98,9 @@ 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 VirtCallBegin (obj: ARRAY OF CHAR; slot: INTEGER; resT: INTEGER);
+(* Begin a virtual (vtable) call: dispatch through obj's slot. *)
+
 PROCEDURE ArmRecv (q: ARRAY OF CHAR);
 (* Arms the receiver for the next class-method call (CallBegin passes
    it as the hidden first argument). *)
@@ -431,6 +434,12 @@ PROCEDURE UpAddrOf (flat: INTEGER; levels: CARDINAL; VAR q: QVal);
 PROCEDURE Revive;
 PROCEDURE FlushStrings;
 
+PROCEDURE EmitVTables;
+(* Emit a data array per class that has virtual methods. *)
+
+PROCEDURE VtRef (t: INTEGER; VAR q: QVal);
+(* The class's vtable symbol ($vt_<typeindex>). *)
+
 PROCEDURE FlushUStrings;
 (* Emit the recorded UString literal descriptors as top-level data. *)
 PROCEDURE ArrData (name: ARRAY OF CHAR; t: INTEGER);

compiler/src/QbeGen.mod

@@ -704,6 +704,7 @@ PROCEDURE EndModule (name: ARRAY OF CHAR);
     END;
     FlushStrings;
     FlushUStrings;
+    EmitVTables;
     (* the image is named after the program module *)
     fname[0] := CHR(0);
     App(fname, "gen_ssa/");
@@ -1082,9 +1083,30 @@ PROCEDURE CallBeginInd (callee: ARRAY OF CHAR; resT: INTEGER;
     Cpy(stkLink[callDepth], "0");
     stkArg[callDepth][0] := CHR(0);
     stkN[callDepth] := 0;
-    INC(callDepth)
+    INC(callDepth);
+    IF recvArmed THEN
+      IF NOT CallArg(recvQ, "l") THEN
+      END;
+      recvArmed := FALSE
+    END
   END CallBeginInd;
 
+PROCEDURE VirtCallBegin (obj: ARRAY OF CHAR; slot: INTEGER; resT: INTEGER);
+(* Virtual dispatch: load obj's vtable pointer, fetch slot `slot`,
+   and begin an indirect call through it.  The receiver (obj) must be
+   armed (ArmRecv). *)
+  VAR vt, off, ea, fp: QVal;
+  BEGIN
+    NewTemp(vt);
+    W("  "); W(vt); W(" =l loadl "); WL(obj);
+    IntStr(slot * 8, off);
+    NewTemp(ea);
+    Op3L("add", ea, vt, off);
+    NewTemp(fp);
+    W("  "); W(fp); W(" =l loadl "); WL(ea);
+    CallBeginInd(fp, resT, FALSE)
+  END VirtCallBegin;
+
 PROCEDURE ArmRecv (q: ARRAY OF CHAR);
 (* Arms the receiver for the next class-method call: CallBegin passes
    it as the hidden first argument. *)
@@ -1891,14 +1913,64 @@ PROCEDURE RecItems (t: SymTab.TypeIndex; prefix: ARRAY OF CHAR;
     END
   END RecItems;
 
+PROCEDURE VtRef (t: INTEGER; VAR q: QVal);
+(* The class's vtable symbol ($vt_<typeindex>). *)
+  VAR bv: QVal;
+  BEGIN
+    Cpy(q, "$vt_");
+    IntStr(t, bv);
+    App(q, bv)
+  END VtRef;
+
+PROCEDURE EmitVTables;
+(* One data array per class with a vtable: slots (inherited first) as
+   method code addresses. *)
+  VAR k, j, n: CARDINAL;
+    t: INTEGER;
+    nm: SymTab.Name;
+    mg, vt: QVal;
+  BEGIN
+    IF NOT opened THEN RETURN END;
+    k := 0;
+    WHILE k < SymTab.VtClassCount() DO
+      t := SymTab.VtClassAt(k);
+      n := SymTab.VtCount(t);
+      VtRef(t, vt);
+      W("data "); W(vt); W(" = { ");
+      j := 0;
+      WHILE j < n DO
+        IF SymTab.VtName(t, j, nm) THEN
+          IF j > 0 THEN W(", ") END;
+          IF SymTab.VtHasBody(t, j) THEN
+            Mangled(nm, SymTab.VtUid(t, j), mg);
+            W("l $"); W(mg)
+          ELSE
+            W("l 0")   (* declared but never implemented *)
+          END
+        END;
+        INC(j)
+      END;
+      IF n = 0 THEN W("l 0") END;
+      WL(" }");
+      INC(k)
+    END
+  END EmitVTables;
+
 PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
   VAR first: BOOLEAN;
+    vt: QVal;
   BEGIN
     IF NOT opened THEN RETURN END;
     RecStatics(name, t);
     W("data $"); W(name);
     W(" = { ");
     first := TRUE;
+    (* a class with a vtable stores its vtable pointer at offset 0 *)
+    IF (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
+      VtRef(t, vt);
+      W("l "); W(vt);
+      first := FALSE
+    END;
     RecItems(t, name, first);
     IF first THEN W("w 0") END;
     WL(" }")
@@ -2690,6 +2762,15 @@ PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
     nb, ea, eb, fa, fb: QVal;
   BEGIN
     cls := SymTab.ClassOf(t);
+    IF (cls = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
+      (* install the class's vtable pointer *)
+      VtRef(t, eb);
+      IntStr(SymTab.VptrOffset(t), nb);
+      NewTemp(ea);
+      Op3L("add", ea, addr, nb);
+      Revive;
+      W("  storel "); W(eb); W(", "); WL(ea)
+    END;
     IF cls = SymTab.ClArray THEN
       IntStr(VAL(INTEGER, SymTab.ArrayLen(t)), nb);
       Revive;

compiler/src/SymTab.def

@@ -313,6 +313,26 @@ PROCEDURE MethodExists (t: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
 PROCEDURE ResumeMethod (ct: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
 (* Resumes a declared class method for its CLASS IMPLEMENTATION body. *)
 
+PROCEDURE HasVTable (ct: TypeIndex): BOOLEAN;
+(* TRUE when the class (or an ancestor) has virtual methods. *)
+PROCEDURE VirtSlot (ct: TypeIndex; name: ARRAY OF CHAR): INTEGER;
+(* Vtable slot of the method, or -1 when it is not virtual. *)
+PROCEDURE IsSubclass (sub, sup: TypeIndex): BOOLEAN;
+(* TRUE when sub is sup or inherits (transitively) from sup. *)
+
+PROCEDURE VptrOffset (ct: TypeIndex): INTEGER;
+(* Byte offset of the class's vptr field (-1 when it has none). *)
+PROCEDURE VtClassCount (): CARDINAL;
+PROCEDURE VtClassAt (k: CARDINAL): TypeIndex;
+(* Classes that have a vtable, in build order. *)
+
+PROCEDURE VtCount (ct: TypeIndex): CARDINAL;
+PROCEDURE VtName (ct: TypeIndex; k: CARDINAL; VAR name: Name): BOOLEAN;
+PROCEDURE VtHasBody (ct: TypeIndex; k: CARDINAL): BOOLEAN;
+(* TRUE when slot k's method has an emitted body. *)
+PROCEDURE VtUid (ct: TypeIndex; k: CARDINAL): CARDINAL;
+(* Virtual-method slot k of ct (inherited slots first). *)
+
 PROCEDURE MethUid (): CARDINAL;
 (* uid of the procedure currently being headed (0 when none). *)
 

compiler/src/SymTab.mod

@@ -5,6 +5,7 @@ FROM Storage IMPORT ALLOCATE;  (* gm2 needs this for NEW substitution *)
 
 CONST
   MaxTypes  = 4096;
+  MaxVt     = 1024;   (* total virtual-method slots across all classes *)
   MaxPend   = 256;
   MaxMods   = 64;
   ResDepth  = 64;
@@ -44,6 +45,8 @@ TYPE
     snapV : ARRAY [0 .. MaxSnap - 1] OF BOOLEAN;    (* DEF formal VARs *)
     nSnap : CARDINAL;   (* KindProc: number of snapshot formals *)
     fsnap : BOOLEAN;    (* KindProc: signature snapshotted, compare *)
+    vslot : INTEGER;    (* KindProc VIRTUAL: vtable slot (-1 = none) *)
+    hasBody : BOOLEAN;  (* KindProc: a body was resumed/emitted *)
     ext   : BOOLEAN;    (* KindProc: EXTERNAL (no body emitted) *)
     link  : Name;       (* KindProc: external link (C) name *)
     sym   : Name;       (* base symbol name (differs from name for
@@ -85,6 +88,16 @@ VAR
   tparent : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
   tscope : ARRAY [0 .. MaxTypes - 1] OF ScopePtr;
   tdone : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
+  (* per-class vtables: each class owns a slice of the shared pool *)
+  vtBase : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
+  nVirt  : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
+  vtName : ARRAY [0 .. MaxVt - 1] OF Name;      (* virtual method name *)
+  vtUid  : ARRAY [0 .. MaxVt - 1] OF CARDINAL;  (* its uid *)
+  vtTop  : CARDINAL;
+  vtBuilt : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
+  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;
   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;
@@ -569,6 +582,10 @@ PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
     tref[nTypes] := ref;
     tdone[nTypes] := FALSE;
     tvtag[nTypes] := FALSE;
+    vtBase[nTypes] := 0;
+    nVirt[nTypes] := 0;
+    vtBuilt[nTypes] := FALSE;
+    tvptr[nTypes] := -1;
     ttag[nTypes] := NIL;
     INC(nTypes);
     RETURN VAL(INTEGER, nTypes - 1)
@@ -1124,9 +1141,14 @@ PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
     | FRecord, FClass :
         n := 0;
         IF (tform[r] = FClass) AND (tparent[r] # InvalidType) THEN
-          (* single inheritance: parent fields come first *)
+          (* single inheritance: parent fields (and its vptr) come first *)
           n := TypeSizeD(tparent[r], depth + 1)
         END;
+        IF (tform[r] = FClass) AND (tvptr[r] >= 0)
+           AND (tvptr[r] = VAL(INTEGER, n)) THEN
+          (* this class introduces its vptr here *)
+          n := n + 8
+        END;
         IF tvtag[r] AND (ttag[r] # NIL) THEN
           (* variant record: plain fields (declared before the tag) pack
              normally; the tag and every variant field overlay in one
@@ -1209,6 +1231,83 @@ PROCEDURE ObjectSize (t: TypeIndex): CARDINAL;
     RETURN TypeSize(t)
   END ObjectSize;
 
+PROCEDURE BuildVTable (ct: TypeIndex);
+(* Assigns ct its virtual-method slots: the parent's are inherited
+   first (a same-named virtual method overrides in place), then ct's
+   own new virtual methods append.  Each method node records its slot
+   in vslot.  Idempotent. *)
+  VAR r, p: TypeIndex;
+    s: ScopePtr;
+    k: CARDINAL;
+
+  PROCEDURE AddMeth (node: SymPtr);
+  (* override an inherited slot or append a new one *)
+    VAR found: BOOLEAN; j: CARDINAL;
+    BEGIN
+      IF (node^.kind # KindProc) OR NOT node^.virt THEN RETURN END;
+      found := FALSE; j := 0;
+      WHILE (j < nVirt[r]) AND NOT found DO
+        IF Equal(vtName[vtBase[r] + j], node^.name) THEN
+          vtUid[vtBase[r] + j] := node^.uid;
+          node^.vslot := VAL(INTEGER, j);
+          found := TRUE
+        END;
+        INC(j)
+      END;
+      IF NOT found AND (vtTop < MaxVt) THEN
+        Assign(vtName[vtTop], node^.name);
+        vtUid[vtTop] := node^.uid;
+        node^.vslot := VAL(INTEGER, nVirt[r]);
+        INC(vtTop); INC(nVirt[r])
+      END
+    END AddMeth;
+
+  PROCEDURE Walk (node: SymPtr);
+    BEGIN
+      IF node = NIL THEN RETURN END;
+      Walk(node^.left);
+      AddMeth(node);
+      Walk(node^.right)
+    END Walk;
+
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (tform[r] # FClass) THEN RETURN END;
+    IF vtBuilt[r] THEN RETURN END;   (* already built *)
+    s := tscope[r];
+    IF s = NIL THEN RETURN END;
+    vtBase[r] := vtTop;
+    nVirt[r] := 0;
+    (* inherit the parent's slots *)
+    p := ParentOf(r);
+    IF p # InvalidType THEN
+      IF NOT vtBuilt[p] THEN BuildVTable(p) END;
+      k := 0;
+      WHILE (k < nVirt[p]) AND (vtTop < MaxVt) DO
+        Assign(vtName[vtTop], vtName[vtBase[p] + k]);
+        vtUid[vtTop] := vtUid[vtBase[p] + k];
+        INC(vtTop); INC(nVirt[r]);
+        INC(k)
+      END
+    END;
+    (* ct's own virtual methods: override or append *)
+    Walk(s^.root);
+    (* vptr field offset: inherited from a parent that already has one,
+       else introduced after the parent's fields (or at 0) *)
+    IF (p # InvalidType) AND (nVirt[p] > 0) THEN
+      tvptr[r] := tvptr[p]
+    ELSIF nVirt[r] > 0 THEN
+      IF p # InvalidType THEN tvptr[r] := VAL(INTEGER, TypeSizeD(p, 0))
+      ELSE tvptr[r] := 0
+      END
+    ELSE tvptr[r] := -1
+    END;
+    IF (nVirt[r] > 0) AND (nVtl < MaxTypes) THEN
+      vtl[nVtl] := r; INC(nVtl)
+    END;
+    vtBuilt[r] := TRUE
+  END BuildVTable;
+
 PROCEDURE ComputeOffsets (r: TypeIndex);
 (* Declaration-order offsets over the (prepend-built, hence reverse)
    field chain, plus declaration ranks. Array fields count 8
@@ -1227,10 +1326,17 @@ PROCEDURE ComputeOffsets (r: TypeIndex);
     IF (tform[r] = FClass) AND (tparent[r] # InvalidType) THEN
       p := Resolve(tparent[r]);
       IF p # InvalidType THEN
+        IF NOT vtBuilt[p] THEN BuildVTable(p) END;
         IF NOT tdone[p] THEN ComputeOffsets(p) END;
         baseOff := VAL(INTEGER, TypeSizeD(p, 0))
       END
     END;
+    (* a class that introduces (rather than inherits) a vptr reserves
+       8 bytes for it after the parent's fields *)
+    IF (tform[r] = FClass) AND (tvptr[r] >= 0)
+       AND (tvptr[r] = baseOff) THEN
+      baseOff := baseOff + 8
+    END;
     IF NOT tvtag[r] THEN
       (* plain record/class: declaration-ordered, tightly packed *)
       total := baseOff; cnt := 0;
@@ -1314,11 +1420,12 @@ PROCEDURE ComputeOffsets (r: TypeIndex);
   END ComputeOffsets;
 
 PROCEDURE LayoutClass (t: TypeIndex);
-(* Computes a class's field offsets (and thus its size). *)
+(* Computes a class's vtable and field offsets (and thus its size). *)
   VAR r: TypeIndex;
   BEGIN
     r := Resolve(t);
     IF (r # InvalidType) AND (tform[r] = FClass) THEN
+      IF NOT vtBuilt[r] THEN BuildVTable(r) END;
       IF NOT tdone[r] THEN ComputeOffsets(r) END
     END
   END LayoutClass;
@@ -1468,6 +1575,7 @@ PROCEDURE ResumeMethod (ct: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
     node := ClassMethodNode(ct, name);
     IF node = NIL THEN RETURN FALSE END;
     node^.plink := NIL;
+    node^.hasBody := TRUE;
     curProc := node;
     curPTail := NIL;
     PushProc(node);
@@ -1547,6 +1655,103 @@ PROCEDURE ClassMethodRes (t: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
   END ClassMethodRes;
 
 
+PROCEDURE VtClassCount (): CARDINAL;
+  BEGIN RETURN nVtl END VtClassCount;
+
+PROCEDURE VtClassAt (k: CARDINAL): TypeIndex;
+  BEGIN
+    IF k >= nVtl THEN RETURN InvalidType END;
+    RETURN vtl[k]
+  END VtClassAt;
+
+PROCEDURE IsSubclass (sub, sup: TypeIndex): BOOLEAN;
+(* TRUE when sub is sup or inherits (transitively) from sup. *)
+  VAR r: TypeIndex;
+    guard: CARDINAL;
+  BEGIN
+    r := Resolve(sub);
+    sup := Resolve(sup);
+    guard := 0;
+    WHILE (r # InvalidType) AND (guard < ResDepth) DO
+      IF r = sup THEN RETURN TRUE END;
+      r := ParentOf(r);
+      INC(guard)
+    END;
+    RETURN FALSE
+  END IsSubclass;
+
+PROCEDURE VptrOffset (ct: TypeIndex): INTEGER;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (tform[r] # FClass) THEN RETURN -1 END;
+    IF NOT vtBuilt[r] THEN BuildVTable(r) END;
+    RETURN tvptr[r]
+  END VptrOffset;
+
+PROCEDURE HasVTable (ct: TypeIndex): BOOLEAN;
+(* TRUE when ct has (or inherits) any virtual method. *)
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (tform[r] # FClass) THEN RETURN FALSE END;
+    IF NOT vtBuilt[r] THEN BuildVTable(r) END;
+    RETURN nVirt[r] > 0
+  END HasVTable;
+
+PROCEDURE VirtSlot (ct: TypeIndex; name: ARRAY OF CHAR): INTEGER;
+(* Vtable slot of ct's method name, or -1 when it is not virtual. *)
+  VAR r: TypeIndex;
+    node: SymPtr;
+  BEGIN
+    node := ClassMethodNode(ct, name);
+    IF (node = NIL) OR NOT node^.virt THEN RETURN -1 END;
+    r := Resolve(ct);
+    IF NOT vtBuilt[r] THEN BuildVTable(r) END;
+    RETURN node^.vslot
+  END VirtSlot;
+
+PROCEDURE VtCount (ct: TypeIndex): CARDINAL;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (tform[r] # FClass) THEN RETURN 0 END;
+    IF NOT vtBuilt[r] THEN BuildVTable(r) END;
+    RETURN nVirt[r]
+  END VtCount;
+
+PROCEDURE VtName (ct: TypeIndex; k: CARDINAL; VAR name: Name): BOOLEAN;
+  VAR r: TypeIndex;
+  BEGIN
+    name[0] := CHR(0);
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (k >= nVirt[r]) THEN RETURN FALSE END;
+    Assign(name, vtName[vtBase[r] + k]);
+    RETURN TRUE
+  END VtName;
+
+PROCEDURE VtHasBody (ct: TypeIndex; k: CARDINAL): BOOLEAN;
+(* TRUE when slot k's method has an emitted body (else the vtable
+   entry is a null pointer). *)
+  VAR r: TypeIndex;
+    node: SymPtr;
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (k >= nVirt[r]) THEN RETURN FALSE END;
+    node := ClassMethodNode(r, vtName[vtBase[r] + k]);
+    IF node = NIL THEN RETURN FALSE END;
+    RETURN node^.hasBody
+  END VtHasBody;
+
+PROCEDURE VtUid (ct: TypeIndex; k: CARDINAL): CARDINAL;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(ct);
+    IF (r = InvalidType) OR (k >= nVirt[r]) THEN RETURN 0 END;
+    RETURN vtUid[vtBase[r] + k]
+  END VtUid;
+
+
 PROCEDURE PushClassMembers (t: TypeIndex): BOOLEAN;
 (* Pushes a scope with t's fields and its ancestors' fields
    (inheritance) as KindField, for method bodies in CLASS
@@ -1597,6 +1802,8 @@ PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
     node^.link[0] := CHR(0);
     node^.uid := nextUid; INC(nextUid);
     node^.fdep := nProc;
+    node^.vslot := -1;
+    node^.hasBody := FALSE;
     curProc := node;
     curPTail := NIL;
     PushProc(node);
@@ -2318,6 +2525,10 @@ PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
     IF ClassOf(src) = ClNil THEN
       RETURN ClassOf(dst) = ClPtr
     END;
+    (* POINTER TO Derived assigns to POINTER TO Base (subtyping) *)
+    IF (ClassOf(src) = ClPtr) AND (ClassOf(dst) = ClPtr) THEN
+      RETURN IsSubclass(PtrBase(src), PtrBase(dst))
+    END;
     (* ADDRESS assigns to/from any pointer *)
     IF (Resolve(src) = dAddr) AND (ClassOf(dst) = ClPtr) THEN
       RETURN TRUE
@@ -2542,6 +2753,7 @@ PROCEDURE Init;
     fields := NIL; nFields := 0;
     nPend := 0; nPendF := 0;
     nTypes := 0; nProc := 0; nBounds := 0; nextUid := 0;
+    vtTop := 0; nVtl := 0;
     curProc := NIL; curPTail := NIL;
     nMods := 0; curMod := -1; curUnit := -1; haveProg := FALSE;
     curScope := NewScope(NIL, 0);

compiler/tests/t_virtual.mod

@@ -0,0 +1,34 @@
+MODULE TVirtual;
+(* Virtual dispatch (vtables): a base-class pointer holding a derived
+   object calls the derived method. Exit 3. *)
+VAR ExitCode : INTEGER;
+TYPE
+  CLASS Shape;
+    VIRTUAL PROCEDURE Draw() : INTEGER;
+  END Shape;
+  CLASS Circle (Shape);
+    VIRTUAL PROCEDURE Draw() : INTEGER;
+  END Circle;
+  CLASS Square (Shape);
+    VIRTUAL PROCEDURE Draw() : INTEGER;
+  END Square;
+CLASS IMPLEMENTATION Shape;
+  PROCEDURE Draw() : INTEGER; BEGIN RETURN 1 END Draw;
+END Shape;
+CLASS IMPLEMENTATION Circle;
+  PROCEDURE Draw() : INTEGER; BEGIN RETURN 2 END Draw;
+END Circle;
+CLASS IMPLEMENTATION Square;
+  PROCEDURE Draw() : INTEGER; BEGIN RETURN 3 END Draw;
+END Square;
+
+VAR b : POINTER TO Shape;
+VAR c : POINTER TO Circle;
+VAR q : POINTER TO Square;
+BEGIN
+  ExitCode := 0;
+  NEW(c); b := c;                 (* subtype pointer assignment *)
+  IF b^.Draw() = 2 THEN ExitCode := ExitCode + 1 END;
+  NEW(q); b := q;
+  IF b^.Draw() = 3 THEN ExitCode := ExitCode + 2 END
+END TVirtual.

docs/OOP.txt

@@ -41,9 +41,12 @@ NOTES (V3 implementation, m2compiler-V3):
   _Find-style names are lexically out of reach for now.
 - Class lowering lands (see docs/summary_class-lowering.md): fields,
   methods (value/VAR formals, results), single inheritance and a
-  hidden THIS receiver all generate code. VIRTUAL is accepted but
-  dispatches statically (no vtable yet); a bare sibling-method call
-  inside a method body and a class BEGIN init body are still 230.
+  hidden THIS receiver all generate code.
+- 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.
 	
 
 

docs/features.md

@@ -1,4 +1,4 @@
-# m2compiler-V3 — feature status (at `v3-class-lowering`, 141/141 green)
+# m2compiler-V3 — feature status (at `v3-virtual-dispatch`, 143/143 green)
 
 Pipeline: Coco/R `M2.atg` (1748 lines, 73 productions) → `gm2`-built
 `M2` → QBE `.ssa` → `qbe` → `cc` → run. `SymTab.mod` 1623 lines,
@@ -102,10 +102,11 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
 
 ## Not started
 - 🔄 Clarion `CLASS`: fields, methods (value/VAR formals, results),
-  single inheritance (inherited fields + methods), `WITH`, and a
-  hidden `THIS` receiver all **lower** now; `VIRTUAL` dispatches
-  statically, bare sibling-method calls and a class `BEGIN` init body
-  are still 230 (see `docs/summary_class-lowering.md`).
+  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`).
   ⏸ `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_virtual-dispatch.md

@@ -0,0 +1,74 @@
+# Step: virtual dispatch (vtables)
+
+Tag `v3-virtual-dispatch`. Suite **143/143**; fixpoint **OK**
+(image **2,310,300 bytes**).
+
+## What
+
+`VIRTUAL` methods now dispatch **dynamically**: a base-class pointer
+holding a derived object calls the derived method.
+
+```modula-2
+TYPE
+  CLASS Shape;  VIRTUAL PROCEDURE Draw() : INTEGER; END Shape;
+  CLASS Circle (Shape); VIRTUAL PROCEDURE Draw() : INTEGER; END Circle;
+...
+VAR b : POINTER TO Shape; c : POINTER TO Circle;
+BEGIN
+  NEW(c); b := c;             (* subtype pointer assignment *)
+  ExitCode := b^.Draw()       (* -> Circle.Draw, decided at run time *)
+END
+```
+
+## How it works
+
+- **vtable** — each class with virtual methods owns a slice of a
+  shared pool (`SymTab.BuildVTable`): the parent's slots are inherited
+  first, and a same-named virtual method **overrides in place**; new
+  virtual methods append.  Each method node records its slot
+  (`vslot`).
+- **vptr** — a class that introduces virtuals gets an 8-byte vtable
+  pointer field (`VptrOffset`): at offset 0 when the class has no
+  parent (or the parent already has one), otherwise right after the
+  parent's fields.  Subclasses share the inherited slot, so a derived
+  object's vptr identifies its dynamic class.
+- **Emission** — `QbeGen.EmitVTables` writes one
+  `data $vt_<typeindex> = { l $Method_<uid>, … }` per class; a method
+  declared but never implemented is `l 0`.
+- **Initialisation** — a class-typed static variable (`DeclRec`) and
+  `NEW` (`InitHeap`) both store `$vt_<typeindex>` in the vptr field.
+- **Dispatch** — a virtual call loads the vptr from the receiver,
+  fetches the slot's code pointer, and calls indirectly
+  (`QbeGen.VirtCallBegin`, reusing the existing indirect-call path).
+  The receiver is passed as the hidden first argument, as for any
+  method.
+- **Subtyping** — `POINTER TO Derived` assigns to
+  `POINTER TO Base` when Derived inherits Base (`SymTab.IsSubclass`),
+  which is what makes a base pointer able to hold a derived object.
+
+## Verified
+
+- `t_virtual.mod` (3): a `Shape` pointer holding a `Circle` then a
+  `Square` dispatches to each override.
+- `vt_<Shape> = { Draw_0 }`, `vt_<Circle> = { Draw_1 }` (same slot,
+  overridden).
+- Non-virtual classes, `VIRTUAL`-with-static-only usage, and the
+  whole existing suite (143) still pass; fixpoint byte-identical.
+
+## Still open
+
+- Bare sibling-method calls inside a method body (`Add(a)` rather
+  than `obj.Add(a)`); a class `BEGIN … END` init body; multiple
+  parents.  `VIRTUAL` coupled with `VAR`/value formals is covered by
+  the ordinary method path.
+
+## Files
+
+`compiler/src/SymTab.def`/`.mod` (`vtBase`/`nVirt`/`vtName`/`vtUid`/
+`tvptr`, `BuildVTable`, `HasVTable`, `VirtSlot`, `VptrOffset`,
+`VtCount`/`VtName`/`VtUid`/`VtHasBody`, `VtClassCount`/`VtClassAt`,
+`IsSubclass`), `compiler/src/QbeGen.def`/`.mod` (`VtRef`,
+`EmitVTables`, `VirtCallBegin`, vptr init in `DeclRec`/`InitHeap`),
+`compiler/src/M2.atg` (`ArgList` virtual dispatch),
+`compiler/tests/t_virtual.mod`, `compiler/run_tests.sh`,
+`docs/features.md`, `docs/OOP.txt`.