Quellcode durchsuchen

lang: strict 235 impl-vs-def signature checks (result, formals, VAR-ness)

- ResumeProc snapshots the DEFINITION signature (result, formal types,
  VAR-ness, count) into the procedure symbol; FixPending compares each
  formal as its type is fixed, SetProcRes compares the result and
  backstops parameterless headings.
- FormalOk (value: same type / int-family / string-compatible) and
  VarParamOk (VAR) drive the comparison; VAR-ness is checked directly.
  InvalidType is 'no evidence' so a root error is not multiplied.
- New error 235 'implementation does not match definition'
  (compiler.frm); 231 was already 'opaque type outside definition'.
- Signatures bounded to MaxSnap=16. VarParamOk no longer needs the
  private Resolve (ClassOf suffices for ADDRESS).
- tests: sig.def/sig.mod/sig_prog.mod (two mismatches) -> 129/129.
- Fixpoint OK (2,102,326 bytes).
Eric Streit vor 2 Wochen
Ursprung
Commit
0d8202b101

+ 1 - 0
compiler/run_tests.sh

@@ -303,6 +303,7 @@ expect_fail_files() {
 }
 
 expect_fail_files d_badimp_prog "undeclared identifier" d_basic.def d_basic.mod d_badimp_prog.mod
+expect_fail_files sig "implementation does not match definition" sig.def sig.mod sig_prog.mod
 
 # --- step 7 gate: compiler sources free of gm2-only imports.
 #     FileIO is the last module to port (see docs/summary_step7.md);

+ 9 - 3
compiler/src/M2.atg

@@ -617,7 +617,11 @@ PRODUCTIONS
                                              QbeGen.DeclVar(nm, t);
                                              INC(i)
                                            END;
-                                           SymTab.FixPending(t); .) .
+                                           (* a plain VAR list, not a
+                                              heading: the signature
+                                              result is discarded *)
+                                           IF NOT SymTab.FixPending(t) THEN
+                                           END; .) .
   VarIdents                             (. VAR n: SymTab.Name; .)
     = GetIdent<n>                       (. IF NOT SymTab.EnterPending(n,
                                              SymTab.KindVar) THEN
@@ -648,7 +652,8 @@ PRODUCTIONS
                                              SymTab.ProcUid(pn), mg);
                                            QbeGen.BeginFunc(mg); .)
       [ FormalParams ]
-      [ ":" TypeIdent<t>                (. SymTab.SetProcRes(t);
+      [ ":" TypeIdent<t>                (. IF NOT SymTab.SetProcRes(t) THEN
+                                             SemError(235) END;
                                            QbeGen.SetFuncRes(t);
                                            IF (t #
                                               SymTab.InvalidType)
@@ -684,7 +689,8 @@ PRODUCTIONS
                                                SemError(233) END;
                                              INC(i)
                                            END;
-                                           SymTab.FixPending(t); .) .
+                                           IF NOT SymTab.FixPending(t) THEN
+                                             SemError(235) END; .) .
   (* Nested procedures lower like top-level ones (4.2): the
      static link gives them their parent's frame. Methods keep
      parse-now/230-later. *)

+ 1776 - 1770
compiler/src/M2.lst

@@ -634,1784 +634,1790 @@ Listing:
   617                                               QbeGen.DeclVar(nm, t);
   618                                               INC(i)
   619                                             END;
-  620                                             SymTab.FixPending(t); .) .
-  621    VarIdents                             (. VAR n: SymTab.Name; .)
-  622      = GetIdent<n>                       (. IF NOT SymTab.EnterPending(n,
-  623                                               SymTab.KindVar) THEN
-  624                                               SemError(200) END; .)
-  625        { ","
-  626          GetIdent<n>                     (. IF NOT SymTab.EnterPending(n,
+  620                                             (* a plain VAR list, not a
+  621                                                heading: the signature
+  622                                                result is discarded *)
+  623                                             IF NOT SymTab.FixPending(t) THEN
+  624                                             END; .) .
+  625    VarIdents                             (. VAR n: SymTab.Name; .)
+  626      = GetIdent<n>                       (. IF NOT SymTab.EnterPending(n,
   627                                               SymTab.KindVar) THEN
-  628                                               SemError(200) END; .) } .
-  629    ParIdents<isV: BOOLEAN>               (. VAR n: SymTab.Name; .)
-  630      = GetIdent<n>                       (. IF NOT SymTab.EnterParam(n, isV) THEN
-  631                                               SemError(200) END; .)
-  632        { "," GetIdent<n>                 (. IF NOT SymTab.EnterParam(n, isV) THEN
-  633                                               SemError(200) END; .) } .
-  634    (* Procedure headings enter scopes/params/result and buffer the
-  635       QBE header; bodies lower to functions (4.1, module level only).
-  636       FORWARD marks; the body heading re-enters (signature compare
-  637       deferred). Nested procedures parse + check, lowering = 4.2. *)
-  638    ProcHeading<VAR pn: SymTab.Name>      (. VAR t: SymTab.TypeIndex;
-  639                                               mg: QbeGen.QVal; .)
-  640      = "PROCEDURE"
-  641        GetIdent<pn>                      (. IF NOT SymTab.EnterProc(pn) THEN
-  642                                             IF NOT SymTab.ReenterProc(pn) THEN
-  643                                               IF NOT SymTab.ResumeProc(pn) THEN
-  644                                                 SemError(200) END
-  645                                               END
-  646                                             END;
-  647                                             QbeGen.Mangled(pn,
-  648                                               SymTab.ProcUid(pn), mg);
-  649                                             QbeGen.BeginFunc(mg); .)
-  650        [ FormalParams ]
-  651        [ ":" TypeIdent<t>                (. SymTab.SetProcRes(t);
-  652                                             QbeGen.SetFuncRes(t);
-  653                                             IF (t #
-  654                                                SymTab.InvalidType)
-  655   AND ((SymTab.ClassOf(t)
-  656                                                   = SymTab.ClArray)
-  657                                                OR (SymTab.ClassOf(t)
-  658                                                   = SymTab.ClRecord)
-  659                                                OR (SymTab.ClassOf(t)
-  660                                                   = SymTab.ClSet)
-  661                                                OR (SymTab.ClassOf(t)
-  662                                                   = SymTab.ClClass)) THEN
-  663                                               SemError(230) END; .) ] .
-  664    FormalParams
-  665      = "(" [ ParamSection { ";" ParamSection } ] ")" .
-  666    ParamSection                          (. VAR t: SymTab.TypeIndex;
-  667                                               nm: SymTab.Name;
-  668                                               i: CARDINAL;
-  669                                               isV: BOOLEAN; .)
-  670      =                                   (. isV := FALSE; .)
-  671        [ "VAR"                           (. isV := TRUE; .) ]
-  672        ParIdents<isV> ":" Type<t, TRUE>  (. i := 0;
-  673                                             WHILE i < SymTab.PendCount() DO
-  674                                               SymTab.PendName(i, nm);
-  675                                               (* value open arrays are
-  676                                                  passed as descriptor
-  677                                                  addresses (no copy):
-  678                                                  same representation as
-  679                                                  VAR formals *)
-  680                                               IF NOT QbeGen.FuncParam(nm,
-  681                                                    isV
-  682                                                    OR SymTab.IsOpenArray(t),
-  683                                                    t) THEN
-  684                                                 SemError(233) END;
-  685                                               INC(i)
-  686                                             END;
-  687                                             SymTab.FixPending(t); .) .
-  688    (* Nested procedures lower like top-level ones (4.2): the
-  689       static link gives them their parent's frame. Methods keep
-  690       parse-now/230-later. *)
-  691    ProcDecl                              (. VAR pn: SymTab.Name; .)
-  692      = ProcHeading<pn> ";"
-  693        ( "FORWARD"                       (. SymTab.MarkFwd;
-  694                                             SymTab.CloseProc;
-  695                                             QbeGen.AbortFunc; .)
-  696        | "EXTERNAL"                      (. SymTab.MarkExternal("");
-  697                                             SymTab.CloseProc;
-  698                                             QbeGen.AbortFunc; .)
-  699        |                                 (. QbeGen.EndFuncHeader; .)
-  700          Block<pn>                       (. SymTab.CloseProc;
-  701                                             QbeGen.EndFunc(
-  702                                               SymTab.ProcRes(pn)); .) ) .
-  703    Block<pn: SymTab.Name>                (. VAR m2: SymTab.Name; .)
-  704      = DeclSeq
-  705        [ "BEGIN"
-  706          [ StatSeq ] ]
-  707        "END"
-  708        GetIdent<m2>                      (. IF NOT SymTab.Equal(pn, m2) THEN
-  709                                               SemError(202) END; .) .
-  710    StatSeq
-  711      = Statement { ";" [ Statement ] } .
-  712    (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
-  713       are accepted: the statement after ';' is optional. *)
-  714    Statement                             (. VAR lx: QbeGen.QVal; .)
-  715      = AssOrCall
-  716      | IfStat
-  717      | WhileStat
-  718      | RepeatStat
-  719      | LoopStat
-  720      | ForStat
-  721      | CaseStat
-  722      | WithStat
-  723      | ReturnStat
-  724      | HaltStat
-  725      | NewStat
-  726      | DisposeStat
-  727      | IncDecStat
-  728      | "EXIT"                            (. IF QbeGen.TopLoop(lx) THEN
-  729                                               QbeGen.Jmp(lx)
-  730                                             ELSE SemError(230) END; .) .
-  731    (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
-  732       integer designator. *)
-  733    IncDecStat                            (. VAR dt, et2: SymTab.TypeIndex;
-  734                                               dk: INTEGER;
-  735                                               qd, qv, qn2, qstep:
-  736                                                 QbeGen.QVal;
-  737                                               qn: SymTab.Name;
-  738                                               sfx, isInc: BOOLEAN; .)
-  739      =                                   (. isInc := TRUE; .)
-  740        ( "INC"                           (. isInc := TRUE; .)
-  741        | "DEC"                           (. isInc := FALSE; .) )
-  742        "("                               (. QbeGen.CopyOp("1", qstep); .)
-  743        Design<dt, dk, qd, qn, sfx>
-  744        [ "," Expr<et2, qstep> ]
-  745        ")"                               (. IF dt = SymTab.InvalidType THEN
-  746                                             ELSIF (dk # SymTab.KindVar)
-  747   AND (dk # SymTab.KindParam)
-  748   AND (dk # SymTab.KindField) THEN
-  749                                               SemError(210)
-  750                                             ELSIF NOT SymTab.IsIntFamily(dt) THEN
-  751                                               SemError(211)
-  752                                             ELSE
-  753                                               IF sfx
-  754                                                  OR (dk = SymTab.KindField) THEN
-  755                                                 QbeGen.ElemLoad(qd, dt, qv)
-  756                                               ELSE QbeGen.LoadVar(qn,
-  757                                                 FALSE, qv)
-  758                                               END;
-  759                                               QbeGen.NewTemp(qn2);
-  760                                               IF isInc THEN
-  761                                                 QbeGen.Op3("add", qn2, qv,
-  762                                                   qstep, FALSE)
-  763                                               ELSE QbeGen.Op3("sub", qn2, qv,
-  764                                                   qstep, FALSE)
-  765                                               END;
-  766                                               IF sfx
-  767                                                  OR (dk = SymTab.KindField) THEN
-  768                                                 QbeGen.ElemStore(qd, qn2,
-  769                                                   dt)
-  770                                               ELSE QbeGen.StoreVar(qn,
-  771                                                 qn2, FALSE)
-  772                                               END
-  773                                             END; .) .
-  774    (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
-  775       Targets are pointer designators; DISPOSE nils afterwards (safer
-  776       than Wirth-undefined; documented). DISPOSE is shallow. *)
-  777    NewStat                               (. VAR dt: SymTab.TypeIndex;
-  778                                               dk: INTEGER;
-  779                                               qd, qm: QbeGen.QVal;
-  780                                               qn: SymTab.Name;
-  781                                               sfx: BOOLEAN;
-  782                                               bt: SymTab.TypeIndex; .)
-  783      = "NEW" "(" Design<dt, dk, qd, qn, sfx> ")"
-  784                                          (. IF dt = SymTab.InvalidType THEN
-  785                                             ELSIF (dk # SymTab.KindVar)
-  786   AND (dk # SymTab.KindParam)
-  787   AND (dk # SymTab.KindField) THEN
-  788                                               SemError(210)
-  789                                             ELSIF SymTab.ClassOf(dt) #
-  790                                                   SymTab.ClPtr THEN
-  791                                               SemError(219)
-  792                                             ELSE bt := SymTab.PtrBase(dt);
-  793                                               IF bt #
-  794                                                  SymTab.InvalidType THEN
-  795                                                 QbeGen.NewHeap(bt, qm);
-  796                                                 QbeGen.InitHeap(qm, bt);
-  797                                                 IF sfx
-  798                                                    OR (dk =
-  799                                                       SymTab.KindField) THEN
-  800                                                   QbeGen.ElemStore(qd, qm,
-  801                                                     dt)
-  802                                                 ELSE QbeGen.StorePtr(qn,
-  803                                                   qm)
-  804                                                 END
-  805                                               END
-  806                                             END; .) .
-  807    DisposeStat                           (. VAR dt: SymTab.TypeIndex;
-  808                                               dk: INTEGER;
-  809                                               qd, qv: QbeGen.QVal;
-  810                                               qn: SymTab.Name;
-  811                                               sfx: BOOLEAN; .)
-  812      = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> ")"
-  813                                          (. IF dt = SymTab.InvalidType THEN
-  814                                             ELSIF (dk # SymTab.KindVar)
-  815   AND (dk # SymTab.KindParam)
-  816   AND (dk # SymTab.KindField) THEN
-  817                                               SemError(210)
-  818                                             ELSIF SymTab.ClassOf(dt) #
-  819                                                   SymTab.ClPtr THEN
-  820                                               SemError(219)
-  821                                             ELSE
-  822                                               IF sfx
-  823                                                  OR (dk =
-  824                                                     SymTab.KindField) THEN
-  825                                                 QbeGen.ElemLoad(qd, dt,
-  826                                                   qv)
-  827                                               ELSE QbeGen.LoadPtr(qn, qv)
-  828                                               END;
-  829                                               QbeGen.FreeHeap(qv);
-  830                                               IF sfx
-  831                                                  OR (dk =
-  832                                                     SymTab.KindField) THEN
-  833                                                 QbeGen.ElemStore(qd, "0",
-  834                                                   dt)
-  835                                               ELSE QbeGen.StorePtr(qn,
-  836                                                 "0")
-  837                                               END
-  838                                             END; .) .
-  839    (* WITH pushes each record's fields (inner wins) plus its base
-  840       address; field designators resolve through both stacks. *)
-  841    WithStat                              (. VAR nW: CARDINAL; .)
-  842      = "WITH"                            (. nW := 0; .)
-  843        WithItem<nW> { "," WithItem<nW> }
-  844        "DO" [ StatSeq ] "END"
-  845                                          (. WHILE nW > 0 DO
-  846                                               SymTab.PopScope;
-  847                                               QbeGen.PopWith;
-  848                                               DEC(nW)
-  849                                             END; .) .
-  850    WithItem<VAR nW: CARDINAL>            (. VAR dt: SymTab.TypeIndex;
-  851                                               dk: INTEGER;
-  852                                               qd, qe: QbeGen.QVal;
-  853                                               qn: SymTab.Name;
-  854                                               sfx: BOOLEAN; .)
-  855      = Design<dt, dk, qd, qn, sfx>
-  856                                          (. IF dt = SymTab.InvalidType THEN
-  857                                             ELSIF (SymTab.ClassOf(dt) #
-  858                                                    SymTab.ClRecord)
-  859   AND (SymTab.ClassOf(dt) #
-  860                                                   SymTab.ClClass) THEN
-  861                                               SemError(215)
-  862                                             ELSIF SymTab.PushRecord(dt) THEN
-  863                                               QbeGen.PushWith(qd);
-  864                                               INC(nW)
-  865                                             END; .) .
-  866    (* Assignment or procedure-statement call (4.1, module level).
-  867       Bare `P;` is a syntax error; function-as-statement is 233. *)
-  868    AssOrCall                             (. VAR dt, et: SymTab.TypeIndex;
-  869                                               dk: INTEGER;
-  870                                               qd, qe, qt, ql: QbeGen.QVal;
-  871                                               qn: SymTab.Name;
-  872                                               ct2, res0: SymTab.TypeIndex;
-  873                                               q2, mg0: QbeGen.QVal;
-  874                                               isR, conv, wconv: BOOLEAN;
-  875                                               called, sfx: BOOLEAN; .)
-  876      = Design<dt, dk, qd, qn, sfx>
-  877        ( ":="
-  878          Expr<et, qe>                    (. IF (dt # SymTab.InvalidType)
-  879   AND (dk # SymTab.KindVar)
-  880   AND (dk # SymTab.KindParam)
-  881   AND (dk # SymTab.KindField) THEN
-  882                                             SemError(210)
-  883                                           ELSIF NOT SymTab.Assignable(et,
-  884                                                    dt) THEN
-  885                                             SemError(210)
-  886                                           ELSIF (dt # SymTab.InvalidType)
-  887   AND (SymTab.ClassOf(dt) =
-  888                                                 SymTab.ClClass) THEN
-  889                                             SemError(230) END;
-  890                                           isR := (dt #
-  891                                                   SymTab.InvalidType)
-  892   AND (SymTab.ClassOf(dt)
-  893                                                     = SymTab.ClReal);
-  894                                           conv := isR
-  895   AND SymTab.IsIntFamily(et);
-  896                                           wconv := (dt #
-  897                                                     SymTab.InvalidType)
-  898   AND SymTab.IsLongFamily(dt)
-  899   AND SymTab.IsIntFamily(et);
-  900                                           IF ((dk = SymTab.KindVar)
-  901                                               OR (dk = SymTab.KindParam)
-  902                                               OR (dk = SymTab.KindField))
-  903   AND (dt # SymTab.InvalidType)
-  904   AND (et # SymTab.InvalidType)
-  905   AND (SymTab.ClassOf(dt) #
-  906                                                 SymTab.ClClass) THEN
-  907                                             IF sfx
-  908                                                OR (dk = SymTab.KindField) THEN
-  909                                               IF SymTab.ClassOf(dt) =
-  910                                                  SymTab.ClArray THEN
-  911                                                 IF SymTab.StrCompat(dt,
-  912                                                      et) THEN
-  913                                                   QbeGen.StrAssign(qd,
-  914                                                     qe)
-  915                                                 ELSE
-  916                                                   QbeGen.CopyArray(qd,
-  917                                                     qe, dt)
-  918                                                 END
-  919                                               ELSIF SymTab.ClassOf(dt) =
-  920                                                   SymTab.ClSet THEN
-  921                                                 QbeGen.CopySet(qd, qe,
-  922                                                   SymTab.SetWords(dt),
-  923                                                   SymTab.SetWords(et))
-  924                                               ELSIF SymTab.ClassOf(dt) =
-  925                                                   SymTab.ClRecord THEN
-  926                                                 QbeGen.CopyRecord(qd, qe,
-  927                                                   dt)
-  928                                               ELSIF SymTab.IsLongFamily(dt) THEN
-  929                                                 IF wconv THEN
-  930                                                   QbeGen.WidenLong(qe, ql);
-  931                                                   QbeGen.ElemStore(qd, ql,
-  932                                                     dt)
-  933                                                 ELSE QbeGen.ElemStore(qd, qe,
-  934                                                   dt)
-  935                                                 END
-  936                                               ELSIF conv THEN
-  937                                                 QbeGen.ConvIR(qe, qt);
-  938                                                 QbeGen.ElemStore(qd, qt,
-  939                                                   dt)
-  940                                               ELSE QbeGen.ElemStore(qd, qe,
-  941                                                 dt)
-  942                                               END
-  943                                             ELSIF SymTab.ClassOf(dt) =
-  944                                                   SymTab.ClArray THEN
-  945                                               IF SymTab.StrCompat(dt,
-  946                                                    et) THEN
-  947                                                 QbeGen.StrAssign(qd, qe)
-  948                                               ELSE
-  949                                                 QbeGen.CopyArray(qd, qe,
-  950                                                   dt)
-  951                                               END
-  952                                             ELSIF SymTab.ClassOf(dt) =
-  953                                                   SymTab.ClSet THEN
-  954                                               QbeGen.CopySet(qd, qe,
-  955                                                 SymTab.SetWords(dt),
-  956                                                 SymTab.SetWords(et))
-  957                                             ELSIF SymTab.ClassOf(dt) =
-  958                                                   SymTab.ClRecord THEN
-  959                                               QbeGen.CopyRecord(qd, qe, dt)
-  960                                             ELSIF (SymTab.ClassOf(dt) =
-  961                                                   SymTab.ClPtr)
-  962                                                OR (SymTab.ClassOf(dt) =
-  963                                                   SymTab.ClProc) THEN
-  964                                               QbeGen.StorePtr(qn, qe)
-  965                                             ELSIF SymTab.IsLongFamily(dt) THEN
-  966                                               IF wconv THEN
-  967                                                 QbeGen.WidenLong(qe, ql);
-  968                                                 QbeGen.StoreLong(qn, ql)
-  969                                               ELSE QbeGen.StoreLong(qn, qe)
-  970                                               END
-  971                                             ELSIF conv THEN
-  972                                               QbeGen.ConvIR(qe, qt);
-  973                                               QbeGen.StoreVar(qn, qt, TRUE)
-  974                                             ELSE
-  975                                               QbeGen.StoreVar(qn, qe, isR)
-  976                                             END
-  977                                           END; .)
-  978        | ArgList<qn, dt, qd, FALSE, ct2, q2, called>
-  979        |                                 (* bare `P;`: proper parameterless
-  980                                              procedure call; anything else
-  981                                              here is 233 (was a bare syntax
-  982                                              error before 4.2) *)
-  983                                          (. IF (dk = SymTab.KindProc)
-  984   AND NOT sfx THEN
-  985                                               res0 := SymTab.ProcRes(qn);
-  986                                               IF res0 #
-  987                                                  SymTab.InvalidType THEN
-  988                                                 SemError(233)
-  989                                               ELSIF SymTab.ProcNPar(qn) #
-  990                                                       0 THEN
-  991                                                 SemError(233)
-  992                                               ELSE QbeGen.Mangled(qn,
-  993                                                 SymTab.ProcUid(qn), mg0);
-  994                                                 QbeGen.CallBegin(mg0,
-  995                                                   res0,
-  996                                                   SymTab.ProcDepthOf(qn),
-  997                                                   SymTab.IsExternal(qn));
-  998                                                 QbeGen.CallEnd(FALSE, q2)
-  999                                               END
- 1000                                             ELSE SemError(233)
- 1001                                             END; .) ) .
- 1002    (* Actual-parameter list shared by statement and expression calls.
- 1003       want selects CallEnd's result handling; t/q carry the call
- 1004       value (statement calls discard). Arity/type failures are 233;
- 1005       evaluation code still emits so the .ssa stays assembleable. *)
- 1006    ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
- 1007            want: BOOLEAN;
- 1008            VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
- 1009            VAR called: BOOLEAN>          (. VAR i: CARDINAL;
- 1010                                               res: SymTab.TypeIndex;
- 1011                                               mg: QbeGen.QVal;
- 1012                                               ok, ind: BOOLEAN; .)
- 1013      = "("                               (. called := TRUE;
- 1014                                             ok := TRUE;
- 1015                                             ind := FALSE;
- 1016                                             IF SymTab.SymKind(pn) =
- 1017                                                SymTab.KindProc THEN
- 1018                                               res := SymTab.ProcRes(pn);
- 1019                                               QbeGen.Mangled(pn,
- 1020                                                 SymTab.ProcUid(pn), mg);
- 1021                                               QbeGen.CallBegin(mg, res,
- 1022                                                 SymTab.ProcDepthOf(pn),
- 1023                                                 SymTab.IsExternal(pn))
- 1024                                             ELSIF (pt # SymTab.InvalidType)
- 1025    AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
- 1026                                               ind := TRUE;
- 1027                                               res :=
- 1028                                                 SymTab.ProcTypeRes(pt);
- 1029                                               QbeGen.CallBeginInd(callee,
- 1030                                                 res, FALSE)
- 1031                                             ELSE SemError(233);
- 1032                                               ok := FALSE;
- 1033                                               res := SymTab.InvalidType
- 1034                                             END;
- 1035                                             i := 0; .)
- 1036        [ ActParam<pn, pt, ind, i>        (. INC(i); .)
- 1037          { "," ActParam<pn, pt, ind, i>  (. INC(i); .) } ]
- 1038        ")"                               (. IF ok THEN
- 1039                                               IF ind THEN
- 1040                                                 IF i #
- 1041                                                    SymTab.ProcTypeNPar(pt) THEN
- 1042                                                   SemError(233); ok := FALSE
- 1043                                                 END
- 1044                                               ELSIF i #
- 1045                                                  SymTab.ProcNPar(pn) THEN
- 1046                                                 SemError(233); ok := FALSE
- 1047                                               END
- 1048                                             END;
- 1049                                             IF NOT ok THEN
- 1050                                               t := SymTab.InvalidType;
- 1051                                               QbeGen.CopyOp("0", q)
- 1052                                             ELSIF want THEN
- 1053                                               IF res =
- 1054                                                  SymTab.InvalidType THEN
- 1055                                                 SemError(233);
- 1056                                                 t := SymTab.InvalidType;
- 1057                                                 QbeGen.CopyOp("0", q)
- 1058                                               ELSE t := res;
- 1059                                                 QbeGen.CallEnd(TRUE, q)
- 1060                                               END
- 1061                                             ELSE
- 1062                                               IF res #
- 1063                                                  SymTab.InvalidType THEN
- 1064                                                 SemError(233)
- 1065                                               END;
- 1066                                               t := SymTab.InvalidType;
- 1067                                               QbeGen.CopyOp("0", q);
- 1068                                               QbeGen.CallEnd(FALSE, q)
- 1069                                             END; .) .
- 1070    (* One actual: VAR formals take recorded designator addresses
- 1071       (233 otherwise); value formals take converted expressions. *)
- 1072    ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
- 1073             i: CARDINAL>                 (. VAR at, ft: SymTab.TypeIndex;
- 1074                                               qe, qa, qt: QbeGen.QVal;
- 1075                                               isV, conv: BOOLEAN; .)
- 1076      = Expr<at, qe>                      (. IF ind THEN
- 1077                                               ft :=
- 1078                                                 SymTab.ProcTypeParamType(pt,
- 1079                                                   i);
- 1080                                               isV :=
- 1081                                                 SymTab.ProcTypeParamIsVar(pt,
- 1082                                                   i)
- 1083                                             ELSE
- 1084                                               ft := SymTab.ParamType(pn, i);
- 1085                                               isV := SymTab.ParamIsVar(pn, i)
- 1086                                             END;
- 1087                                             IF (at = SymTab.InvalidType)
- 1088                                                OR (ft =
- 1089                                                   SymTab.InvalidType) THEN
- 1090                                             ELSIF isV THEN
- 1091                                               IF (SymTab.ClassOf(at)
- 1092                                                  = SymTab.ClChar)
- 1093    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1094    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1095         = SymTab.ClChar)
- 1096    AND QbeGen.IsImm(qe) THEN
- 1097                                                 (* 1-char string
- 1098                                                    literal passed to
- 1099                                                    a VAR ARRAY OF CHAR *)
- 1100                                                 QbeGen.DeclCharStr(qe,
- 1101                                                      qa);
- 1102                                                 IF NOT QbeGen.CallArg(qa,
- 1103                                                    "l") THEN
- 1104                                                   SemError(233)
- 1105                                                 END
- 1106                                               ELSIF NOT QbeGen.AddrOfVal(qe,
- 1107                                                    qa) THEN
- 1108                                                 SemError(233)
- 1109                                               ELSIF NOT SymTab.VarParamOk(at,
- 1110                                                        ft) THEN
- 1111                                                 SemError(233)
- 1112                                               ELSIF NOT QbeGen.CallArg(qa,
- 1113                                                        "l") THEN
+  628                                               SemError(200) END; .)
+  629        { ","
+  630          GetIdent<n>                     (. IF NOT SymTab.EnterPending(n,
+  631                                               SymTab.KindVar) THEN
+  632                                               SemError(200) END; .) } .
+  633    ParIdents<isV: BOOLEAN>               (. VAR n: SymTab.Name; .)
+  634      = GetIdent<n>                       (. IF NOT SymTab.EnterParam(n, isV) THEN
+  635                                               SemError(200) END; .)
+  636        { "," GetIdent<n>                 (. IF NOT SymTab.EnterParam(n, isV) THEN
+  637                                               SemError(200) END; .) } .
+  638    (* Procedure headings enter scopes/params/result and buffer the
+  639       QBE header; bodies lower to functions (4.1, module level only).
+  640       FORWARD marks; the body heading re-enters (signature compare
+  641       deferred). Nested procedures parse + check, lowering = 4.2. *)
+  642    ProcHeading<VAR pn: SymTab.Name>      (. VAR t: SymTab.TypeIndex;
+  643                                               mg: QbeGen.QVal; .)
+  644      = "PROCEDURE"
+  645        GetIdent<pn>                      (. IF NOT SymTab.EnterProc(pn) THEN
+  646                                             IF NOT SymTab.ReenterProc(pn) THEN
+  647                                               IF NOT SymTab.ResumeProc(pn) THEN
+  648                                                 SemError(200) END
+  649                                               END
+  650                                             END;
+  651                                             QbeGen.Mangled(pn,
+  652                                               SymTab.ProcUid(pn), mg);
+  653                                             QbeGen.BeginFunc(mg); .)
+  654        [ FormalParams ]
+  655        [ ":" TypeIdent<t>                (. IF NOT SymTab.SetProcRes(t) THEN
+  656                                               SemError(235) END;
+  657                                             QbeGen.SetFuncRes(t);
+  658                                             IF (t #
+  659                                                SymTab.InvalidType)
+  660   AND ((SymTab.ClassOf(t)
+  661                                                   = SymTab.ClArray)
+  662                                                OR (SymTab.ClassOf(t)
+  663                                                   = SymTab.ClRecord)
+  664                                                OR (SymTab.ClassOf(t)
+  665                                                   = SymTab.ClSet)
+  666                                                OR (SymTab.ClassOf(t)
+  667                                                   = SymTab.ClClass)) THEN
+  668                                               SemError(230) END; .) ] .
+  669    FormalParams
+  670      = "(" [ ParamSection { ";" ParamSection } ] ")" .
+  671    ParamSection                          (. VAR t: SymTab.TypeIndex;
+  672                                               nm: SymTab.Name;
+  673                                               i: CARDINAL;
+  674                                               isV: BOOLEAN; .)
+  675      =                                   (. isV := FALSE; .)
+  676        [ "VAR"                           (. isV := TRUE; .) ]
+  677        ParIdents<isV> ":" Type<t, TRUE>  (. i := 0;
+  678                                             WHILE i < SymTab.PendCount() DO
+  679                                               SymTab.PendName(i, nm);
+  680                                               (* value open arrays are
+  681                                                  passed as descriptor
+  682                                                  addresses (no copy):
+  683                                                  same representation as
+  684                                                  VAR formals *)
+  685                                               IF NOT QbeGen.FuncParam(nm,
+  686                                                    isV
+  687                                                    OR SymTab.IsOpenArray(t),
+  688                                                    t) THEN
+  689                                                 SemError(233) END;
+  690                                               INC(i)
+  691                                             END;
+  692                                             IF NOT SymTab.FixPending(t) THEN
+  693                                               SemError(235) END; .) .
+  694    (* Nested procedures lower like top-level ones (4.2): the
+  695       static link gives them their parent's frame. Methods keep
+  696       parse-now/230-later. *)
+  697    ProcDecl                              (. VAR pn: SymTab.Name; .)
+  698      = ProcHeading<pn> ";"
+  699        ( "FORWARD"                       (. SymTab.MarkFwd;
+  700                                             SymTab.CloseProc;
+  701                                             QbeGen.AbortFunc; .)
+  702        | "EXTERNAL"                      (. SymTab.MarkExternal("");
+  703                                             SymTab.CloseProc;
+  704                                             QbeGen.AbortFunc; .)
+  705        |                                 (. QbeGen.EndFuncHeader; .)
+  706          Block<pn>                       (. SymTab.CloseProc;
+  707                                             QbeGen.EndFunc(
+  708                                               SymTab.ProcRes(pn)); .) ) .
+  709    Block<pn: SymTab.Name>                (. VAR m2: SymTab.Name; .)
+  710      = DeclSeq
+  711        [ "BEGIN"
+  712          [ StatSeq ] ]
+  713        "END"
+  714        GetIdent<m2>                      (. IF NOT SymTab.Equal(pn, m2) THEN
+  715                                               SemError(202) END; .) .
+  716    StatSeq
+  717      = Statement { ";" [ Statement ] } .
+  718    (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
+  719       are accepted: the statement after ';' is optional. *)
+  720    Statement                             (. VAR lx: QbeGen.QVal; .)
+  721      = AssOrCall
+  722      | IfStat
+  723      | WhileStat
+  724      | RepeatStat
+  725      | LoopStat
+  726      | ForStat
+  727      | CaseStat
+  728      | WithStat
+  729      | ReturnStat
+  730      | HaltStat
+  731      | NewStat
+  732      | DisposeStat
+  733      | IncDecStat
+  734      | "EXIT"                            (. IF QbeGen.TopLoop(lx) THEN
+  735                                               QbeGen.Jmp(lx)
+  736                                             ELSE SemError(230) END; .) .
+  737    (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
+  738       integer designator. *)
+  739    IncDecStat                            (. VAR dt, et2: SymTab.TypeIndex;
+  740                                               dk: INTEGER;
+  741                                               qd, qv, qn2, qstep:
+  742                                                 QbeGen.QVal;
+  743                                               qn: SymTab.Name;
+  744                                               sfx, isInc: BOOLEAN; .)
+  745      =                                   (. isInc := TRUE; .)
+  746        ( "INC"                           (. isInc := TRUE; .)
+  747        | "DEC"                           (. isInc := FALSE; .) )
+  748        "("                               (. QbeGen.CopyOp("1", qstep); .)
+  749        Design<dt, dk, qd, qn, sfx>
+  750        [ "," Expr<et2, qstep> ]
+  751        ")"                               (. IF dt = SymTab.InvalidType THEN
+  752                                             ELSIF (dk # SymTab.KindVar)
+  753   AND (dk # SymTab.KindParam)
+  754   AND (dk # SymTab.KindField) THEN
+  755                                               SemError(210)
+  756                                             ELSIF NOT SymTab.IsIntFamily(dt) THEN
+  757                                               SemError(211)
+  758                                             ELSE
+  759                                               IF sfx
+  760                                                  OR (dk = SymTab.KindField) THEN
+  761                                                 QbeGen.ElemLoad(qd, dt, qv)
+  762                                               ELSE QbeGen.LoadVar(qn,
+  763                                                 FALSE, qv)
+  764                                               END;
+  765                                               QbeGen.NewTemp(qn2);
+  766                                               IF isInc THEN
+  767                                                 QbeGen.Op3("add", qn2, qv,
+  768                                                   qstep, FALSE)
+  769                                               ELSE QbeGen.Op3("sub", qn2, qv,
+  770                                                   qstep, FALSE)
+  771                                               END;
+  772                                               IF sfx
+  773                                                  OR (dk = SymTab.KindField) THEN
+  774                                                 QbeGen.ElemStore(qd, qn2,
+  775                                                   dt)
+  776                                               ELSE QbeGen.StoreVar(qn,
+  777                                                 qn2, FALSE)
+  778                                               END
+  779                                             END; .) .
+  780    (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
+  781       Targets are pointer designators; DISPOSE nils afterwards (safer
+  782       than Wirth-undefined; documented). DISPOSE is shallow. *)
+  783    NewStat                               (. VAR dt: SymTab.TypeIndex;
+  784                                               dk: INTEGER;
+  785                                               qd, qm: QbeGen.QVal;
+  786                                               qn: SymTab.Name;
+  787                                               sfx: BOOLEAN;
+  788                                               bt: SymTab.TypeIndex; .)
+  789      = "NEW" "(" Design<dt, dk, qd, qn, sfx> ")"
+  790                                          (. IF dt = SymTab.InvalidType THEN
+  791                                             ELSIF (dk # SymTab.KindVar)
+  792   AND (dk # SymTab.KindParam)
+  793   AND (dk # SymTab.KindField) THEN
+  794                                               SemError(210)
+  795                                             ELSIF SymTab.ClassOf(dt) #
+  796                                                   SymTab.ClPtr THEN
+  797                                               SemError(219)
+  798                                             ELSE bt := SymTab.PtrBase(dt);
+  799                                               IF bt #
+  800                                                  SymTab.InvalidType THEN
+  801                                                 QbeGen.NewHeap(bt, qm);
+  802                                                 QbeGen.InitHeap(qm, bt);
+  803                                                 IF sfx
+  804                                                    OR (dk =
+  805                                                       SymTab.KindField) THEN
+  806                                                   QbeGen.ElemStore(qd, qm,
+  807                                                     dt)
+  808                                                 ELSE QbeGen.StorePtr(qn,
+  809                                                   qm)
+  810                                                 END
+  811                                               END
+  812                                             END; .) .
+  813    DisposeStat                           (. VAR dt: SymTab.TypeIndex;
+  814                                               dk: INTEGER;
+  815                                               qd, qv: QbeGen.QVal;
+  816                                               qn: SymTab.Name;
+  817                                               sfx: BOOLEAN; .)
+  818      = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> ")"
+  819                                          (. IF dt = SymTab.InvalidType THEN
+  820                                             ELSIF (dk # SymTab.KindVar)
+  821   AND (dk # SymTab.KindParam)
+  822   AND (dk # SymTab.KindField) THEN
+  823                                               SemError(210)
+  824                                             ELSIF SymTab.ClassOf(dt) #
+  825                                                   SymTab.ClPtr THEN
+  826                                               SemError(219)
+  827                                             ELSE
+  828                                               IF sfx
+  829                                                  OR (dk =
+  830                                                     SymTab.KindField) THEN
+  831                                                 QbeGen.ElemLoad(qd, dt,
+  832                                                   qv)
+  833                                               ELSE QbeGen.LoadPtr(qn, qv)
+  834                                               END;
+  835                                               QbeGen.FreeHeap(qv);
+  836                                               IF sfx
+  837                                                  OR (dk =
+  838                                                     SymTab.KindField) THEN
+  839                                                 QbeGen.ElemStore(qd, "0",
+  840                                                   dt)
+  841                                               ELSE QbeGen.StorePtr(qn,
+  842                                                 "0")
+  843                                               END
+  844                                             END; .) .
+  845    (* WITH pushes each record's fields (inner wins) plus its base
+  846       address; field designators resolve through both stacks. *)
+  847    WithStat                              (. VAR nW: CARDINAL; .)
+  848      = "WITH"                            (. nW := 0; .)
+  849        WithItem<nW> { "," WithItem<nW> }
+  850        "DO" [ StatSeq ] "END"
+  851                                          (. WHILE nW > 0 DO
+  852                                               SymTab.PopScope;
+  853                                               QbeGen.PopWith;
+  854                                               DEC(nW)
+  855                                             END; .) .
+  856    WithItem<VAR nW: CARDINAL>            (. VAR dt: SymTab.TypeIndex;
+  857                                               dk: INTEGER;
+  858                                               qd, qe: QbeGen.QVal;
+  859                                               qn: SymTab.Name;
+  860                                               sfx: BOOLEAN; .)
+  861      = Design<dt, dk, qd, qn, sfx>
+  862                                          (. IF dt = SymTab.InvalidType THEN
+  863                                             ELSIF (SymTab.ClassOf(dt) #
+  864                                                    SymTab.ClRecord)
+  865   AND (SymTab.ClassOf(dt) #
+  866                                                   SymTab.ClClass) THEN
+  867                                               SemError(215)
+  868                                             ELSIF SymTab.PushRecord(dt) THEN
+  869                                               QbeGen.PushWith(qd);
+  870                                               INC(nW)
+  871                                             END; .) .
+  872    (* Assignment or procedure-statement call (4.1, module level).
+  873       Bare `P;` is a syntax error; function-as-statement is 233. *)
+  874    AssOrCall                             (. VAR dt, et: SymTab.TypeIndex;
+  875                                               dk: INTEGER;
+  876                                               qd, qe, qt, ql: QbeGen.QVal;
+  877                                               qn: SymTab.Name;
+  878                                               ct2, res0: SymTab.TypeIndex;
+  879                                               q2, mg0: QbeGen.QVal;
+  880                                               isR, conv, wconv: BOOLEAN;
+  881                                               called, sfx: BOOLEAN; .)
+  882      = Design<dt, dk, qd, qn, sfx>
+  883        ( ":="
+  884          Expr<et, qe>                    (. IF (dt # SymTab.InvalidType)
+  885   AND (dk # SymTab.KindVar)
+  886   AND (dk # SymTab.KindParam)
+  887   AND (dk # SymTab.KindField) THEN
+  888                                             SemError(210)
+  889                                           ELSIF NOT SymTab.Assignable(et,
+  890                                                    dt) THEN
+  891                                             SemError(210)
+  892                                           ELSIF (dt # SymTab.InvalidType)
+  893   AND (SymTab.ClassOf(dt) =
+  894                                                 SymTab.ClClass) THEN
+  895                                             SemError(230) END;
+  896                                           isR := (dt #
+  897                                                   SymTab.InvalidType)
+  898   AND (SymTab.ClassOf(dt)
+  899                                                     = SymTab.ClReal);
+  900                                           conv := isR
+  901   AND SymTab.IsIntFamily(et);
+  902                                           wconv := (dt #
+  903                                                     SymTab.InvalidType)
+  904   AND SymTab.IsLongFamily(dt)
+  905   AND SymTab.IsIntFamily(et);
+  906                                           IF ((dk = SymTab.KindVar)
+  907                                               OR (dk = SymTab.KindParam)
+  908                                               OR (dk = SymTab.KindField))
+  909   AND (dt # SymTab.InvalidType)
+  910   AND (et # SymTab.InvalidType)
+  911   AND (SymTab.ClassOf(dt) #
+  912                                                 SymTab.ClClass) THEN
+  913                                             IF sfx
+  914                                                OR (dk = SymTab.KindField) THEN
+  915                                               IF SymTab.ClassOf(dt) =
+  916                                                  SymTab.ClArray THEN
+  917                                                 IF SymTab.StrCompat(dt,
+  918                                                      et) THEN
+  919                                                   QbeGen.StrAssign(qd,
+  920                                                     qe)
+  921                                                 ELSE
+  922                                                   QbeGen.CopyArray(qd,
+  923                                                     qe, dt)
+  924                                                 END
+  925                                               ELSIF SymTab.ClassOf(dt) =
+  926                                                   SymTab.ClSet THEN
+  927                                                 QbeGen.CopySet(qd, qe,
+  928                                                   SymTab.SetWords(dt),
+  929                                                   SymTab.SetWords(et))
+  930                                               ELSIF SymTab.ClassOf(dt) =
+  931                                                   SymTab.ClRecord THEN
+  932                                                 QbeGen.CopyRecord(qd, qe,
+  933                                                   dt)
+  934                                               ELSIF SymTab.IsLongFamily(dt) THEN
+  935                                                 IF wconv THEN
+  936                                                   QbeGen.WidenLong(qe, ql);
+  937                                                   QbeGen.ElemStore(qd, ql,
+  938                                                     dt)
+  939                                                 ELSE QbeGen.ElemStore(qd, qe,
+  940                                                   dt)
+  941                                                 END
+  942                                               ELSIF conv THEN
+  943                                                 QbeGen.ConvIR(qe, qt);
+  944                                                 QbeGen.ElemStore(qd, qt,
+  945                                                   dt)
+  946                                               ELSE QbeGen.ElemStore(qd, qe,
+  947                                                 dt)
+  948                                               END
+  949                                             ELSIF SymTab.ClassOf(dt) =
+  950                                                   SymTab.ClArray THEN
+  951                                               IF SymTab.StrCompat(dt,
+  952                                                    et) THEN
+  953                                                 QbeGen.StrAssign(qd, qe)
+  954                                               ELSE
+  955                                                 QbeGen.CopyArray(qd, qe,
+  956                                                   dt)
+  957                                               END
+  958                                             ELSIF SymTab.ClassOf(dt) =
+  959                                                   SymTab.ClSet THEN
+  960                                               QbeGen.CopySet(qd, qe,
+  961                                                 SymTab.SetWords(dt),
+  962                                                 SymTab.SetWords(et))
+  963                                             ELSIF SymTab.ClassOf(dt) =
+  964                                                   SymTab.ClRecord THEN
+  965                                               QbeGen.CopyRecord(qd, qe, dt)
+  966                                             ELSIF (SymTab.ClassOf(dt) =
+  967                                                   SymTab.ClPtr)
+  968                                                OR (SymTab.ClassOf(dt) =
+  969                                                   SymTab.ClProc) THEN
+  970                                               QbeGen.StorePtr(qn, qe)
+  971                                             ELSIF SymTab.IsLongFamily(dt) THEN
+  972                                               IF wconv THEN
+  973                                                 QbeGen.WidenLong(qe, ql);
+  974                                                 QbeGen.StoreLong(qn, ql)
+  975                                               ELSE QbeGen.StoreLong(qn, qe)
+  976                                               END
+  977                                             ELSIF conv THEN
+  978                                               QbeGen.ConvIR(qe, qt);
+  979                                               QbeGen.StoreVar(qn, qt, TRUE)
+  980                                             ELSE
+  981                                               QbeGen.StoreVar(qn, qe, isR)
+  982                                             END
+  983                                           END; .)
+  984        | ArgList<qn, dt, qd, FALSE, ct2, q2, called>
+  985        |                                 (* bare `P;`: proper parameterless
+  986                                              procedure call; anything else
+  987                                              here is 233 (was a bare syntax
+  988                                              error before 4.2) *)
+  989                                          (. IF (dk = SymTab.KindProc)
+  990   AND NOT sfx THEN
+  991                                               res0 := SymTab.ProcRes(qn);
+  992                                               IF res0 #
+  993                                                  SymTab.InvalidType THEN
+  994                                                 SemError(233)
+  995                                               ELSIF SymTab.ProcNPar(qn) #
+  996                                                       0 THEN
+  997                                                 SemError(233)
+  998                                               ELSE QbeGen.Mangled(qn,
+  999                                                 SymTab.ProcUid(qn), mg0);
+ 1000                                                 QbeGen.CallBegin(mg0,
+ 1001                                                   res0,
+ 1002                                                   SymTab.ProcDepthOf(qn),
+ 1003                                                   SymTab.IsExternal(qn));
+ 1004                                                 QbeGen.CallEnd(FALSE, q2)
+ 1005                                               END
+ 1006                                             ELSE SemError(233)
+ 1007                                             END; .) ) .
+ 1008    (* Actual-parameter list shared by statement and expression calls.
+ 1009       want selects CallEnd's result handling; t/q carry the call
+ 1010       value (statement calls discard). Arity/type failures are 233;
+ 1011       evaluation code still emits so the .ssa stays assembleable. *)
+ 1012    ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
+ 1013            want: BOOLEAN;
+ 1014            VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
+ 1015            VAR called: BOOLEAN>          (. VAR i: CARDINAL;
+ 1016                                               res: SymTab.TypeIndex;
+ 1017                                               mg: QbeGen.QVal;
+ 1018                                               ok, ind: BOOLEAN; .)
+ 1019      = "("                               (. called := TRUE;
+ 1020                                             ok := TRUE;
+ 1021                                             ind := FALSE;
+ 1022                                             IF SymTab.SymKind(pn) =
+ 1023                                                SymTab.KindProc THEN
+ 1024                                               res := SymTab.ProcRes(pn);
+ 1025                                               QbeGen.Mangled(pn,
+ 1026                                                 SymTab.ProcUid(pn), mg);
+ 1027                                               QbeGen.CallBegin(mg, res,
+ 1028                                                 SymTab.ProcDepthOf(pn),
+ 1029                                                 SymTab.IsExternal(pn))
+ 1030                                             ELSIF (pt # SymTab.InvalidType)
+ 1031    AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
+ 1032                                               ind := TRUE;
+ 1033                                               res :=
+ 1034                                                 SymTab.ProcTypeRes(pt);
+ 1035                                               QbeGen.CallBeginInd(callee,
+ 1036                                                 res, FALSE)
+ 1037                                             ELSE SemError(233);
+ 1038                                               ok := FALSE;
+ 1039                                               res := SymTab.InvalidType
+ 1040                                             END;
+ 1041                                             i := 0; .)
+ 1042        [ ActParam<pn, pt, ind, i>        (. INC(i); .)
+ 1043          { "," ActParam<pn, pt, ind, i>  (. INC(i); .) } ]
+ 1044        ")"                               (. IF ok THEN
+ 1045                                               IF ind THEN
+ 1046                                                 IF i #
+ 1047                                                    SymTab.ProcTypeNPar(pt) THEN
+ 1048                                                   SemError(233); ok := FALSE
+ 1049                                                 END
+ 1050                                               ELSIF i #
+ 1051                                                  SymTab.ProcNPar(pn) THEN
+ 1052                                                 SemError(233); ok := FALSE
+ 1053                                               END
+ 1054                                             END;
+ 1055                                             IF NOT ok THEN
+ 1056                                               t := SymTab.InvalidType;
+ 1057                                               QbeGen.CopyOp("0", q)
+ 1058                                             ELSIF want THEN
+ 1059                                               IF res =
+ 1060                                                  SymTab.InvalidType THEN
+ 1061                                                 SemError(233);
+ 1062                                                 t := SymTab.InvalidType;
+ 1063                                                 QbeGen.CopyOp("0", q)
+ 1064                                               ELSE t := res;
+ 1065                                                 QbeGen.CallEnd(TRUE, q)
+ 1066                                               END
+ 1067                                             ELSE
+ 1068                                               IF res #
+ 1069                                                  SymTab.InvalidType THEN
+ 1070                                                 SemError(233)
+ 1071                                               END;
+ 1072                                               t := SymTab.InvalidType;
+ 1073                                               QbeGen.CopyOp("0", q);
+ 1074                                               QbeGen.CallEnd(FALSE, q)
+ 1075                                             END; .) .
+ 1076    (* One actual: VAR formals take recorded designator addresses
+ 1077       (233 otherwise); value formals take converted expressions. *)
+ 1078    ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
+ 1079             i: CARDINAL>                 (. VAR at, ft: SymTab.TypeIndex;
+ 1080                                               qe, qa, qt: QbeGen.QVal;
+ 1081                                               isV, conv: BOOLEAN; .)
+ 1082      = Expr<at, qe>                      (. IF ind THEN
+ 1083                                               ft :=
+ 1084                                                 SymTab.ProcTypeParamType(pt,
+ 1085                                                   i);
+ 1086                                               isV :=
+ 1087                                                 SymTab.ProcTypeParamIsVar(pt,
+ 1088                                                   i)
+ 1089                                             ELSE
+ 1090                                               ft := SymTab.ParamType(pn, i);
+ 1091                                               isV := SymTab.ParamIsVar(pn, i)
+ 1092                                             END;
+ 1093                                             IF (at = SymTab.InvalidType)
+ 1094                                                OR (ft =
+ 1095                                                   SymTab.InvalidType) THEN
+ 1096                                             ELSIF isV THEN
+ 1097                                               IF (SymTab.ClassOf(at)
+ 1098                                                  = SymTab.ClChar)
+ 1099    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+ 1100    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
+ 1101         = SymTab.ClChar)
+ 1102    AND QbeGen.IsImm(qe) THEN
+ 1103                                                 (* 1-char string
+ 1104                                                    literal passed to
+ 1105                                                    a VAR ARRAY OF CHAR *)
+ 1106                                                 QbeGen.DeclCharStr(qe,
+ 1107                                                      qa);
+ 1108                                                 IF NOT QbeGen.CallArg(qa,
+ 1109                                                    "l") THEN
+ 1110                                                   SemError(233)
+ 1111                                                 END
+ 1112                                               ELSIF NOT QbeGen.AddrOfVal(qe,
+ 1113                                                    qa) THEN
  1114                                                 SemError(233)
- 1115                                               END
- 1116                                             ELSE
- 1117                                               IF (SymTab.ClassOf(at)
- 1118                                                  = SymTab.ClChar)
- 1119    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1120    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1121         = SymTab.ClChar)
- 1122    AND QbeGen.IsImm(qe) THEN
- 1123                                                 (* 1-char string
- 1124                                                    literal passed to
- 1125                                                    ARRAY OF CHAR *)
- 1126                                                 QbeGen.DeclCharStr(qe,
- 1127                                                      qa);
- 1128                                                 IF NOT QbeGen.CallArg(qa,
- 1129                                                    "l") THEN
- 1130                                                   SemError(233)
- 1131                                                 END
- 1132                                               ELSIF NOT SymTab.Assignable(at,
- 1133                                                    ft) THEN
- 1134                                                 SemError(233)
- 1135                                               ELSE
- 1136                                                 conv := (SymTab.ClassOf(
- 1137                                                   ft) = SymTab.ClReal)
- 1138   AND SymTab.IsIntFamily(at);
- 1139                                                 IF conv THEN
- 1140                                                   QbeGen.ConvIR(qe, qt);
- 1141                                                   IF NOT QbeGen.CallArg(qt,
- 1142                                                      "d") THEN
- 1143                                                     SemError(233)
- 1144                                                   END
- 1145                                                 ELSIF NOT QbeGen.CallArg(qe,
- 1146                                                   QbeGen.ArgClass(ft)) THEN
- 1147                                                   SemError(233)
- 1148                                                 END
- 1149                                               END
- 1150                                             END; .) .
- 1151    IfStat                                (. VAR t: SymTab.TypeIndex;
- 1152                                               q, lThen, lElse, lEnd:
- 1153                                                 QbeGen.QVal;
- 1154                                               hasElse: BOOLEAN; .)
- 1155      = "IF"                              (. hasElse := FALSE; .)
- 1156        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
- 1157                                               SemError(214) END;
- 1158                                             QbeGen.NewLabel(lThen);
- 1159                                             QbeGen.NewLabel(lElse);
- 1160                                             QbeGen.NewLabel(lEnd);
- 1161                                             QbeGen.Jnz(q, lThen, lElse);
- 1162                                             QbeGen.EmitLabel(lThen); .)
- 1163        "THEN" [ StatSeq ]                (. QbeGen.Jmp(lEnd); .)
- 1164        { "ELSIF"                         (. QbeGen.EmitLabel(lElse);
- 1165                                             QbeGen.NewLabel(lElse); .)
- 1166          Expr<t, q>                      (. IF NOT SymTab.BoolCheck(t) THEN
- 1167                                               SemError(214) END;
- 1168                                             QbeGen.NewLabel(lThen);
- 1169                                             QbeGen.Jnz(q, lThen, lElse);
- 1170                                             QbeGen.EmitLabel(lThen); .)
- 1171          "THEN" [ StatSeq ]              (. QbeGen.Jmp(lEnd); .) }
- 1172        [ "ELSE"                          (. QbeGen.EmitLabel(lElse);
- 1173                                             hasElse := TRUE; .)
- 1174          [ StatSeq ] ]
- 1175        "END"                             (. IF hasElse THEN
- 1176                                               QbeGen.EmitLabel(lEnd)
- 1177                                             ELSE QbeGen.EmitLabel(lElse);
- 1178                                               QbeGen.EmitLabel(lEnd)
- 1179                                             END; .) .
- 1180    WhileStat                             (. VAR t: SymTab.TypeIndex;
- 1181                                               q, lTop, lBody, lEnd:
- 1182                                                 QbeGen.QVal; .)
- 1183      = "WHILE"                           (. QbeGen.NewLabel(lTop);
- 1184                                             QbeGen.NewLabel(lBody);
- 1185                                             QbeGen.NewLabel(lEnd);
- 1186                                             QbeGen.EmitLabel(lTop); .)
- 1187        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
- 1188                                               SemError(214) END;
- 1189                                             QbeGen.Jnz(q, lBody, lEnd);
- 1190                                             QbeGen.EmitLabel(lBody); .)
- 1191        "DO" [ StatSeq ]                      (. QbeGen.Jmp(lTop); .)
- 1192        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
- 1193    RepeatStat                            (. VAR t: SymTab.TypeIndex;
- 1194                                               q, lTop, lEnd: QbeGen.QVal; .)
- 1195      = "REPEAT"                          (. QbeGen.NewLabel(lTop);
- 1196                                             QbeGen.NewLabel(lEnd);
- 1197                                             QbeGen.EmitLabel(lTop); .)
- 1198        [ StatSeq ]
- 1199        "UNTIL" Expr<t, q>                (. IF NOT SymTab.BoolCheck(t) THEN
- 1200                                               SemError(214) END;
- 1201                                             QbeGen.Jnz(q, lEnd, lTop);
- 1202                                             QbeGen.EmitLabel(lEnd); .) .
- 1203    LoopStat                              (. VAR lTop, lEnd: QbeGen.QVal; .)
- 1204      = "LOOP"                            (. QbeGen.NewLabel(lTop);
- 1205                                             QbeGen.NewLabel(lEnd);
- 1206                                             QbeGen.PushLoop(lEnd);
- 1207                                             QbeGen.EmitLabel(lTop); .)
- 1208        [ StatSeq ]
- 1209        "END"                             (. QbeGen.Jmp(lTop);
- 1210                                             QbeGen.PopLoop;
- 1211                                             QbeGen.EmitLabel(lEnd); .) .
- 1212    (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
- 1213       Runtime direction would need a compare-select; the literal
- 1214       sign picks cslew/csegew at "DO" time. *)
- 1215    ForStat                               (. VAR lv: SymTab.Name;
- 1216                                               tlo, thi, tby:
- 1217                                                 SymTab.TypeIndex;
- 1218                                               qlo, qhi, qby, qt, qk, qb:
- 1219                                                 QbeGen.QVal;
- 1220                                               lTop, lBody, lEnd:
- 1221                                                 QbeGen.QVal;
- 1222                                               by: INTEGER;
- 1223                                               ok: BOOLEAN; .)
- 1224      = "FOR"                             (. by := 1; .)
- 1225        GetIdent<lv>                      (. ok := SymTab.Lookup(lv);
- 1226                                             IF NOT ok THEN
- 1227                                               SemError(201)
- 1228                                             ELSIF (SymTab.SymKind(lv) #
- 1229                                                    SymTab.KindVar)
- 1230   AND (SymTab.SymKind(lv) #
- 1231                                                   SymTab.KindParam) THEN
- 1232                                               SemError(220); ok := FALSE
- 1233                                             ELSIF NOT SymTab.IsIntFamily(
- 1234                                                     SymTab.SymType(lv)) THEN
- 1235                                               SemError(220); ok := FALSE
- 1236                                             END; .)
- 1237        ":=" Expr<tlo, qlo>               (. IF NOT SymTab.IsIntFamily(tlo) THEN
+ 1115                                               ELSIF NOT SymTab.VarParamOk(at,
+ 1116                                                        ft) THEN
+ 1117                                                 SemError(233)
+ 1118                                               ELSIF NOT QbeGen.CallArg(qa,
+ 1119                                                        "l") THEN
+ 1120                                                 SemError(233)
+ 1121                                               END
+ 1122                                             ELSE
+ 1123                                               IF (SymTab.ClassOf(at)
+ 1124                                                  = SymTab.ClChar)
+ 1125    AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+ 1126    AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
+ 1127         = SymTab.ClChar)
+ 1128    AND QbeGen.IsImm(qe) THEN
+ 1129                                                 (* 1-char string
+ 1130                                                    literal passed to
+ 1131                                                    ARRAY OF CHAR *)
+ 1132                                                 QbeGen.DeclCharStr(qe,
+ 1133                                                      qa);
+ 1134                                                 IF NOT QbeGen.CallArg(qa,
+ 1135                                                    "l") THEN
+ 1136                                                   SemError(233)
+ 1137                                                 END
+ 1138                                               ELSIF NOT SymTab.Assignable(at,
+ 1139                                                    ft) THEN
+ 1140                                                 SemError(233)
+ 1141                                               ELSE
+ 1142                                                 conv := (SymTab.ClassOf(
+ 1143                                                   ft) = SymTab.ClReal)
+ 1144   AND SymTab.IsIntFamily(at);
+ 1145                                                 IF conv THEN
+ 1146                                                   QbeGen.ConvIR(qe, qt);
+ 1147                                                   IF NOT QbeGen.CallArg(qt,
+ 1148                                                      "d") THEN
+ 1149                                                     SemError(233)
+ 1150                                                   END
+ 1151                                                 ELSIF NOT QbeGen.CallArg(qe,
+ 1152                                                   QbeGen.ArgClass(ft)) THEN
+ 1153                                                   SemError(233)
+ 1154                                                 END
+ 1155                                               END
+ 1156                                             END; .) .
+ 1157    IfStat                                (. VAR t: SymTab.TypeIndex;
+ 1158                                               q, lThen, lElse, lEnd:
+ 1159                                                 QbeGen.QVal;
+ 1160                                               hasElse: BOOLEAN; .)
+ 1161      = "IF"                              (. hasElse := FALSE; .)
+ 1162        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
+ 1163                                               SemError(214) END;
+ 1164                                             QbeGen.NewLabel(lThen);
+ 1165                                             QbeGen.NewLabel(lElse);
+ 1166                                             QbeGen.NewLabel(lEnd);
+ 1167                                             QbeGen.Jnz(q, lThen, lElse);
+ 1168                                             QbeGen.EmitLabel(lThen); .)
+ 1169        "THEN" [ StatSeq ]                (. QbeGen.Jmp(lEnd); .)
+ 1170        { "ELSIF"                         (. QbeGen.EmitLabel(lElse);
+ 1171                                             QbeGen.NewLabel(lElse); .)
+ 1172          Expr<t, q>                      (. IF NOT SymTab.BoolCheck(t) THEN
+ 1173                                               SemError(214) END;
+ 1174                                             QbeGen.NewLabel(lThen);
+ 1175                                             QbeGen.Jnz(q, lThen, lElse);
+ 1176                                             QbeGen.EmitLabel(lThen); .)
+ 1177          "THEN" [ StatSeq ]              (. QbeGen.Jmp(lEnd); .) }
+ 1178        [ "ELSE"                          (. QbeGen.EmitLabel(lElse);
+ 1179                                             hasElse := TRUE; .)
+ 1180          [ StatSeq ] ]
+ 1181        "END"                             (. IF hasElse THEN
+ 1182                                               QbeGen.EmitLabel(lEnd)
+ 1183                                             ELSE QbeGen.EmitLabel(lElse);
+ 1184                                               QbeGen.EmitLabel(lEnd)
+ 1185                                             END; .) .
+ 1186    WhileStat                             (. VAR t: SymTab.TypeIndex;
+ 1187                                               q, lTop, lBody, lEnd:
+ 1188                                                 QbeGen.QVal; .)
+ 1189      = "WHILE"                           (. QbeGen.NewLabel(lTop);
+ 1190                                             QbeGen.NewLabel(lBody);
+ 1191                                             QbeGen.NewLabel(lEnd);
+ 1192                                             QbeGen.EmitLabel(lTop); .)
+ 1193        Expr<t, q>                        (. IF NOT SymTab.BoolCheck(t) THEN
+ 1194                                               SemError(214) END;
+ 1195                                             QbeGen.Jnz(q, lBody, lEnd);
+ 1196                                             QbeGen.EmitLabel(lBody); .)
+ 1197        "DO" [ StatSeq ]                      (. QbeGen.Jmp(lTop); .)
+ 1198        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
+ 1199    RepeatStat                            (. VAR t: SymTab.TypeIndex;
+ 1200                                               q, lTop, lEnd: QbeGen.QVal; .)
+ 1201      = "REPEAT"                          (. QbeGen.NewLabel(lTop);
+ 1202                                             QbeGen.NewLabel(lEnd);
+ 1203                                             QbeGen.EmitLabel(lTop); .)
+ 1204        [ StatSeq ]
+ 1205        "UNTIL" Expr<t, q>                (. IF NOT SymTab.BoolCheck(t) THEN
+ 1206                                               SemError(214) END;
+ 1207                                             QbeGen.Jnz(q, lEnd, lTop);
+ 1208                                             QbeGen.EmitLabel(lEnd); .) .
+ 1209    LoopStat                              (. VAR lTop, lEnd: QbeGen.QVal; .)
+ 1210      = "LOOP"                            (. QbeGen.NewLabel(lTop);
+ 1211                                             QbeGen.NewLabel(lEnd);
+ 1212                                             QbeGen.PushLoop(lEnd);
+ 1213                                             QbeGen.EmitLabel(lTop); .)
+ 1214        [ StatSeq ]
+ 1215        "END"                             (. QbeGen.Jmp(lTop);
+ 1216                                             QbeGen.PopLoop;
+ 1217                                             QbeGen.EmitLabel(lEnd); .) .
+ 1218    (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
+ 1219       Runtime direction would need a compare-select; the literal
+ 1220       sign picks cslew/csegew at "DO" time. *)
+ 1221    ForStat                               (. VAR lv: SymTab.Name;
+ 1222                                               tlo, thi, tby:
+ 1223                                                 SymTab.TypeIndex;
+ 1224                                               qlo, qhi, qby, qt, qk, qb:
+ 1225                                                 QbeGen.QVal;
+ 1226                                               lTop, lBody, lEnd:
+ 1227                                                 QbeGen.QVal;
+ 1228                                               by: INTEGER;
+ 1229                                               ok: BOOLEAN; .)
+ 1230      = "FOR"                             (. by := 1; .)
+ 1231        GetIdent<lv>                      (. ok := SymTab.Lookup(lv);
+ 1232                                             IF NOT ok THEN
+ 1233                                               SemError(201)
+ 1234                                             ELSIF (SymTab.SymKind(lv) #
+ 1235                                                    SymTab.KindVar)
+ 1236   AND (SymTab.SymKind(lv) #
+ 1237                                                   SymTab.KindParam) THEN
  1238                                               SemError(220); ok := FALSE
- 1239                                             END; .)
- 1240        "TO" Expr<thi, qhi>               (. IF NOT SymTab.IsIntFamily(thi) THEN
+ 1239                                             ELSIF NOT SymTab.IsIntFamily(
+ 1240                                                     SymTab.SymType(lv)) THEN
  1241                                               SemError(220); ok := FALSE
  1242                                             END; .)
- 1243        [ "BY" Expr<tby, qby>             (. IF (tby #
- 1244                                               SymTab.InvalidType)
- 1245   AND NOT SymTab.IsIntFamily(tby) THEN
- 1246                                               SemError(220); ok := FALSE
- 1247                                             END;
- 1248                                             IF NOT SymTab.ConstInt(qby, by) THEN
- 1249                                               SemError(230); by := 1
- 1250                                             ELSIF by = 0 THEN
- 1251                                               SemError(220); by := 1
- 1252                                             END; .) ]
- 1253        "DO"                              (. IF ok THEN
- 1254                                               QbeGen.StoreVar(lv, qlo,
- 1255                                                 FALSE) END;
- 1256                                             QbeGen.NewLabel(lTop);
- 1257                                             QbeGen.NewLabel(lBody);
- 1258                                             QbeGen.NewLabel(lEnd);
- 1259                                             QbeGen.EmitLabel(lTop);
- 1260                                             QbeGen.LoadVar(lv, FALSE, qt);
- 1261                                             QbeGen.NewTemp(qk);
- 1262                                             IF by > 0 THEN
- 1263                                               QbeGen.Op3("cslew", qk,
- 1264                                                 qt, qhi, FALSE)
- 1265                                             ELSE QbeGen.Op3("csgew", qk,
- 1266                                               qt, qhi, FALSE)
- 1267                                             END;
- 1268                                             QbeGen.Jnz(qk, lBody, lEnd);
- 1269                                             QbeGen.EmitLabel(lBody); .)
- 1270        [ StatSeq ]
- 1271        "END"                             (. IF ok THEN
- 1272                                               QbeGen.LoadVar(lv, FALSE,
- 1273                                                 qt);
- 1274                                               QbeGen.IntStr(by, qb);
- 1275                                               QbeGen.NewTemp(qk);
- 1276                                               QbeGen.Op3("add", qk,
- 1277                                                 qt, qb, FALSE);
- 1278                                               QbeGen.StoreVar(lv, qk,
- 1279                                                 FALSE) END;
- 1280                                             QbeGen.Jmp(lTop);
- 1281                                             QbeGen.EmitLabel(lEnd); .) .
- 1282    CaseStat                              (. VAR tsel: SymTab.TypeIndex;
- 1283                                               qsel, lEnd: QbeGen.QVal; .)
- 1284      = "CASE" Expr<tsel, qsel>           (. QbeGen.NewLabel(lEnd); .)
- 1285        "OF" CaseAlt<tsel, qsel, lEnd>
- 1286        { "|" CaseAlt<tsel, qsel, lEnd> }
- 1287        [ "ELSE" [ StatSeq ] ]
- 1288        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
- 1289    (* Compare-chain lowering: each alternative ends its match-tests
- 1290       with "jmp lAfter", so the no-match fallthrough skips the body:
- 1291       "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
- 1292       lAfter:". Falls into the next alternative, ELSE, or END. *)
- 1293    CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1294            lEnd: QbeGen.QVal>            (. VAR lBody, lAfter: QbeGen.QVal; .)
- 1295      =                                   (. QbeGen.NewLabel(lBody);
- 1296                                             QbeGen.NewLabel(lAfter); .)
- 1297        CaseLabel<tsel, qsel, lBody>
- 1298        { "," CaseLabel<tsel, qsel, lBody> }
- 1299        ":"                               (. QbeGen.Jmp(lAfter);
- 1300                                             QbeGen.EmitLabel(lBody); .)
- 1301        [ StatSeq ]                       (. QbeGen.Jmp(lEnd);
- 1302                                             QbeGen.EmitLabel(lAfter); .) .
- 1303    CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1304              lBody: QbeGen.QVal>         (. VAR t2, t3: SymTab.TypeIndex;
- 1305                                               q2, q3, qc, qd, qe:
- 1306                                                 QbeGen.QVal;
- 1307                                               lNext: QbeGen.QVal; .)
- 1308      = Expr<t2, q2>                      (. IF (t2 #
- 1309                                               SymTab.InvalidType)
- 1310   AND (tsel #
- 1311                                                 SymTab.InvalidType)
- 1312   AND ((SymTab.ClassOf(t2) =
- 1313                                                  SymTab.ClSet)
- 1314                                                 OR (SymTab.ClassOf(tsel) =
- 1315                                                     SymTab.ClSet)) THEN
- 1316                                               SemError(230)
- 1317                                             ELSIF (t2 #
- 1318                                               SymTab.InvalidType)
- 1319   AND (tsel #
- 1320                                                 SymTab.InvalidType)
- 1321   AND NOT SymTab.EqCheck(t2,
- 1322                                                   tsel) THEN
- 1323                                               SemError(213) END;
- 1324                                             IF NOT QbeGen.IsImm(q2) THEN
- 1325                                               SemError(230);
- 1326                                               QbeGen.CopyOp("0", q2)
- 1327                                             END;
- 1328                                             QbeGen.NewLabel(lNext);
- 1329                                             QbeGen.Cmp(SymTab.OpEq,
- 1330                                               qsel, q2, qc, FALSE);
- 1331                                             QbeGen.Jnz(qc, lBody, lNext);
- 1332                                             QbeGen.EmitLabel(lNext); .)
- 1333        [ ".." Expr<t3, q3>               (. IF (t3 #
- 1334                                               SymTab.InvalidType)
- 1335   AND (tsel #
- 1336                                                 SymTab.InvalidType)
- 1337   AND NOT SymTab.EqCheck(t3,
- 1338                                                   tsel) THEN
- 1339                                               SemError(213) END;
- 1340                                             IF NOT QbeGen.IsImm(q3) THEN
- 1341                                               SemError(230);
- 1342                                               QbeGen.CopyOp("0", q3)
- 1343                                             END;
- 1344                                             QbeGen.Cmp(SymTab.OpGe,
- 1345                                               qsel, q2, qc, FALSE);
- 1346                                             QbeGen.Cmp(SymTab.OpLe,
- 1347                                               qsel, q3, qd, FALSE);
- 1348                                             QbeGen.NewTemp(qe);
- 1349                                             QbeGen.Op3("and", qe, qc, qd,
- 1350                                               FALSE);
- 1351                                             QbeGen.NewLabel(lNext);
- 1352                                             QbeGen.Jnz(qe, lBody, lNext);
- 1353                                             QbeGen.EmitLabel(lNext); .) ] .
- 1354    ReturnStat                            (. VAR t: SymTab.TypeIndex;
- 1355                                               q, qt: QbeGen.QVal;
- 1356                                               res: SymTab.TypeIndex;
- 1357                                               hadE, conv: BOOLEAN; .)
- 1358      = "RETURN"                          (. hadE := FALSE; .)
- 1359        [ Expr<t, q>                      (. hadE := TRUE; .) ]
- 1360                                          (. conv := FALSE;
- 1361                                             IF NOT SymTab.InProc() THEN
- 1362                                               SemError(232)
- 1363                                             ELSE res := SymTab.CurRes();
- 1364                                               IF NOT hadE THEN
- 1365                                                 IF res #
- 1366                                                    SymTab.InvalidType THEN
- 1367                                                   SemError(232)
- 1368                                                 ELSE QbeGen.EmitRet(q,
- 1369                                                   FALSE)
- 1370                                                 END
- 1371                                               ELSIF (res =
- 1372                                                      SymTab.InvalidType)
- 1373                                                  OR (t #
- 1374                                                      SymTab.InvalidType)
- 1375   AND NOT SymTab.Assignable(t,
- 1376                                                       res) THEN
- 1377                                                 SemError(232)
- 1378                                               ELSE
- 1379                                                 conv := (SymTab.ClassOf(
- 1380                                                   res) = SymTab.ClReal)
- 1381   AND SymTab.IsIntFamily(t);
- 1382                                                 IF conv THEN
- 1383                                                   QbeGen.ConvIR(q, qt);
- 1384                                                   QbeGen.EmitRet(qt, TRUE)
- 1385                                                 ELSE QbeGen.EmitRet(q, TRUE)
- 1386                                                 END
- 1387                                               END
- 1388                                             END; .) .
- 1389    HaltStat                              (. VAR t: SymTab.TypeIndex;
- 1390                                               q: QbeGen.QVal; .)
- 1391      = "HALT" [ "(" Expr<t, q> ")" ]     (. QbeGen.HaltQ; .) .
- 1392    (* Designator: scalar loads, array addresses, and index suffixes.
- 1393       Each index descends one level (bounds-checked, trap on breach);
- 1394       nested levels reload the inner descriptor address. q ends as the
- 1395       value (scalars), the descriptor address (plain arrays), or the
- 1396       element address (indexed); sfx marks the indexed form. *)
- 1397    Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
- 1398           VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
- 1399                                          (. VAR n, fn, mal: SymTab.Name;
- 1400                                               cls: INTEGER;
- 1401                                               curT, it, eT, bt:
- 1402                                                 SymTab.TypeIndex;
- 1403                                               iq, ql, qlo, qhi, qe:
- 1404                                                 QbeGen.QVal;
- 1405                                               lo, hi: INTEGER;
- 1406                                               fo: INTEGER;
- 1407                                               isOpen: BOOLEAN;
- 1408                                               qb, cv: QbeGen.QVal; .)
- 1409      = GetIdent<n>                       (. QbeGen.CopyOp(n, qn);
- 1410                                             sfx := FALSE;
- 1411                                             IF NOT SymTab.Lookup(n) THEN
- 1412                                               SemError(201);
- 1413                                               t := SymTab.InvalidType;
- 1414                                               k := -1;
- 1415                                               QbeGen.CopyOp("0", q)
- 1416                                             ELSE
- 1417                                               t := SymTab.SymType(n);
- 1418                                               k := SymTab.SymKind(n);
- 1419                                               IF k = SymTab.KindConst THEN
- 1420                                                 IF SymTab.Equal(n,
- 1421                                                    "TRUE") THEN
- 1422                                                   t := SymTab.BoolType();
- 1423                                                   QbeGen.CopyOp("1", q)
- 1424                                                 ELSIF SymTab.Equal(n,
- 1425                                                    "FALSE") THEN
- 1426                                                   t := SymTab.BoolType();
- 1427                                                   QbeGen.CopyOp("0", q)
- 1428                                                 ELSIF SymTab.Equal(n,
- 1429                                                    "NIL") THEN
- 1430                                                   QbeGen.CopyOp("0", q)
- 1431                                                 ELSE
- 1432                                                   cls :=
- 1433                                                     SymTab.ClassOf(t);
- 1434                                                   IF (t #
- 1435                                                       SymTab.InvalidType)
- 1436   AND ((cls = SymTab.ClInt)
- 1437                                                      OR (cls
- 1438                                                          = SymTab.ClChar)
- 1439                                                      OR (cls
- 1440                                                          = SymTab.ClEnum)
- 1441                                                      OR (cls
- 1442                                                          = SymTab.ClReal)
+ 1243        ":=" Expr<tlo, qlo>               (. IF NOT SymTab.IsIntFamily(tlo) THEN
+ 1244                                               SemError(220); ok := FALSE
+ 1245                                             END; .)
+ 1246        "TO" Expr<thi, qhi>               (. IF NOT SymTab.IsIntFamily(thi) THEN
+ 1247                                               SemError(220); ok := FALSE
+ 1248                                             END; .)
+ 1249        [ "BY" Expr<tby, qby>             (. IF (tby #
+ 1250                                               SymTab.InvalidType)
+ 1251   AND NOT SymTab.IsIntFamily(tby) THEN
+ 1252                                               SemError(220); ok := FALSE
+ 1253                                             END;
+ 1254                                             IF NOT SymTab.ConstInt(qby, by) THEN
+ 1255                                               SemError(230); by := 1
+ 1256                                             ELSIF by = 0 THEN
+ 1257                                               SemError(220); by := 1
+ 1258                                             END; .) ]
+ 1259        "DO"                              (. IF ok THEN
+ 1260                                               QbeGen.StoreVar(lv, qlo,
+ 1261                                                 FALSE) END;
+ 1262                                             QbeGen.NewLabel(lTop);
+ 1263                                             QbeGen.NewLabel(lBody);
+ 1264                                             QbeGen.NewLabel(lEnd);
+ 1265                                             QbeGen.EmitLabel(lTop);
+ 1266                                             QbeGen.LoadVar(lv, FALSE, qt);
+ 1267                                             QbeGen.NewTemp(qk);
+ 1268                                             IF by > 0 THEN
+ 1269                                               QbeGen.Op3("cslew", qk,
+ 1270                                                 qt, qhi, FALSE)
+ 1271                                             ELSE QbeGen.Op3("csgew", qk,
+ 1272                                               qt, qhi, FALSE)
+ 1273                                             END;
+ 1274                                             QbeGen.Jnz(qk, lBody, lEnd);
+ 1275                                             QbeGen.EmitLabel(lBody); .)
+ 1276        [ StatSeq ]
+ 1277        "END"                             (. IF ok THEN
+ 1278                                               QbeGen.LoadVar(lv, FALSE,
+ 1279                                                 qt);
+ 1280                                               QbeGen.IntStr(by, qb);
+ 1281                                               QbeGen.NewTemp(qk);
+ 1282                                               QbeGen.Op3("add", qk,
+ 1283                                                 qt, qb, FALSE);
+ 1284                                               QbeGen.StoreVar(lv, qk,
+ 1285                                                 FALSE) END;
+ 1286                                             QbeGen.Jmp(lTop);
+ 1287                                             QbeGen.EmitLabel(lEnd); .) .
+ 1288    CaseStat                              (. VAR tsel: SymTab.TypeIndex;
+ 1289                                               qsel, lEnd: QbeGen.QVal; .)
+ 1290      = "CASE" Expr<tsel, qsel>           (. QbeGen.NewLabel(lEnd); .)
+ 1291        "OF" CaseAlt<tsel, qsel, lEnd>
+ 1292        { "|" CaseAlt<tsel, qsel, lEnd> }
+ 1293        [ "ELSE" [ StatSeq ] ]
+ 1294        "END"                             (. QbeGen.EmitLabel(lEnd); .) .
+ 1295    (* Compare-chain lowering: each alternative ends its match-tests
+ 1296       with "jmp lAfter", so the no-match fallthrough skips the body:
+ 1297       "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
+ 1298       lAfter:". Falls into the next alternative, ELSE, or END. *)
+ 1299    CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
+ 1300            lEnd: QbeGen.QVal>            (. VAR lBody, lAfter: QbeGen.QVal; .)
+ 1301      =                                   (. QbeGen.NewLabel(lBody);
+ 1302                                             QbeGen.NewLabel(lAfter); .)
+ 1303        CaseLabel<tsel, qsel, lBody>
+ 1304        { "," CaseLabel<tsel, qsel, lBody> }
+ 1305        ":"                               (. QbeGen.Jmp(lAfter);
+ 1306                                             QbeGen.EmitLabel(lBody); .)
+ 1307        [ StatSeq ]                       (. QbeGen.Jmp(lEnd);
+ 1308                                             QbeGen.EmitLabel(lAfter); .) .
+ 1309    CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
+ 1310              lBody: QbeGen.QVal>         (. VAR t2, t3: SymTab.TypeIndex;
+ 1311                                               q2, q3, qc, qd, qe:
+ 1312                                                 QbeGen.QVal;
+ 1313                                               lNext: QbeGen.QVal; .)
+ 1314      = Expr<t2, q2>                      (. IF (t2 #
+ 1315                                               SymTab.InvalidType)
+ 1316   AND (tsel #
+ 1317                                                 SymTab.InvalidType)
+ 1318   AND ((SymTab.ClassOf(t2) =
+ 1319                                                  SymTab.ClSet)
+ 1320                                                 OR (SymTab.ClassOf(tsel) =
+ 1321                                                     SymTab.ClSet)) THEN
+ 1322                                               SemError(230)
+ 1323                                             ELSIF (t2 #
+ 1324                                               SymTab.InvalidType)
+ 1325   AND (tsel #
+ 1326                                                 SymTab.InvalidType)
+ 1327   AND NOT SymTab.EqCheck(t2,
+ 1328                                                   tsel) THEN
+ 1329                                               SemError(213) END;
+ 1330                                             IF NOT QbeGen.IsImm(q2) THEN
+ 1331                                               SemError(230);
+ 1332                                               QbeGen.CopyOp("0", q2)
+ 1333                                             END;
+ 1334                                             QbeGen.NewLabel(lNext);
+ 1335                                             QbeGen.Cmp(SymTab.OpEq,
+ 1336                                               qsel, q2, qc, FALSE);
+ 1337                                             QbeGen.Jnz(qc, lBody, lNext);
+ 1338                                             QbeGen.EmitLabel(lNext); .)
+ 1339        [ ".." Expr<t3, q3>               (. IF (t3 #
+ 1340                                               SymTab.InvalidType)
+ 1341   AND (tsel #
+ 1342                                                 SymTab.InvalidType)
+ 1343   AND NOT SymTab.EqCheck(t3,
+ 1344                                                   tsel) THEN
+ 1345                                               SemError(213) END;
+ 1346                                             IF NOT QbeGen.IsImm(q3) THEN
+ 1347                                               SemError(230);
+ 1348                                               QbeGen.CopyOp("0", q3)
+ 1349                                             END;
+ 1350                                             QbeGen.Cmp(SymTab.OpGe,
+ 1351                                               qsel, q2, qc, FALSE);
+ 1352                                             QbeGen.Cmp(SymTab.OpLe,
+ 1353                                               qsel, q3, qd, FALSE);
+ 1354                                             QbeGen.NewTemp(qe);
+ 1355                                             QbeGen.Op3("and", qe, qc, qd,
+ 1356                                               FALSE);
+ 1357                                             QbeGen.NewLabel(lNext);
+ 1358                                             QbeGen.Jnz(qe, lBody, lNext);
+ 1359                                             QbeGen.EmitLabel(lNext); .) ] .
+ 1360    ReturnStat                            (. VAR t: SymTab.TypeIndex;
+ 1361                                               q, qt: QbeGen.QVal;
+ 1362                                               res: SymTab.TypeIndex;
+ 1363                                               hadE, conv: BOOLEAN; .)
+ 1364      = "RETURN"                          (. hadE := FALSE; .)
+ 1365        [ Expr<t, q>                      (. hadE := TRUE; .) ]
+ 1366                                          (. conv := FALSE;
+ 1367                                             IF NOT SymTab.InProc() THEN
+ 1368                                               SemError(232)
+ 1369                                             ELSE res := SymTab.CurRes();
+ 1370                                               IF NOT hadE THEN
+ 1371                                                 IF res #
+ 1372                                                    SymTab.InvalidType THEN
+ 1373                                                   SemError(232)
+ 1374                                                 ELSE QbeGen.EmitRet(q,
+ 1375                                                   FALSE)
+ 1376                                                 END
+ 1377                                               ELSIF (res =
+ 1378                                                      SymTab.InvalidType)
+ 1379                                                  OR (t #
+ 1380                                                      SymTab.InvalidType)
+ 1381   AND NOT SymTab.Assignable(t,
+ 1382                                                       res) THEN
+ 1383                                                 SemError(232)
+ 1384                                               ELSE
+ 1385                                                 conv := (SymTab.ClassOf(
+ 1386                                                   res) = SymTab.ClReal)
+ 1387   AND SymTab.IsIntFamily(t);
+ 1388                                                 IF conv THEN
+ 1389                                                   QbeGen.ConvIR(q, qt);
+ 1390                                                   QbeGen.EmitRet(qt, TRUE)
+ 1391                                                 ELSE QbeGen.EmitRet(q, TRUE)
+ 1392                                                 END
+ 1393                                               END
+ 1394                                             END; .) .
+ 1395    HaltStat                              (. VAR t: SymTab.TypeIndex;
+ 1396                                               q: QbeGen.QVal; .)
+ 1397      = "HALT" [ "(" Expr<t, q> ")" ]     (. QbeGen.HaltQ; .) .
+ 1398    (* Designator: scalar loads, array addresses, and index suffixes.
+ 1399       Each index descends one level (bounds-checked, trap on breach);
+ 1400       nested levels reload the inner descriptor address. q ends as the
+ 1401       value (scalars), the descriptor address (plain arrays), or the
+ 1402       element address (indexed); sfx marks the indexed form. *)
+ 1403    Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+ 1404           VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
+ 1405                                          (. VAR n, fn, mal: SymTab.Name;
+ 1406                                               cls: INTEGER;
+ 1407                                               curT, it, eT, bt:
+ 1408                                                 SymTab.TypeIndex;
+ 1409                                               iq, ql, qlo, qhi, qe:
+ 1410                                                 QbeGen.QVal;
+ 1411                                               lo, hi: INTEGER;
+ 1412                                               fo: INTEGER;
+ 1413                                               isOpen: BOOLEAN;
+ 1414                                               qb, cv: QbeGen.QVal; .)
+ 1415      = GetIdent<n>                       (. QbeGen.CopyOp(n, qn);
+ 1416                                             sfx := FALSE;
+ 1417                                             IF NOT SymTab.Lookup(n) THEN
+ 1418                                               SemError(201);
+ 1419                                               t := SymTab.InvalidType;
+ 1420                                               k := -1;
+ 1421                                               QbeGen.CopyOp("0", q)
+ 1422                                             ELSE
+ 1423                                               t := SymTab.SymType(n);
+ 1424                                               k := SymTab.SymKind(n);
+ 1425                                               IF k = SymTab.KindConst THEN
+ 1426                                                 IF SymTab.Equal(n,
+ 1427                                                    "TRUE") THEN
+ 1428                                                   t := SymTab.BoolType();
+ 1429                                                   QbeGen.CopyOp("1", q)
+ 1430                                                 ELSIF SymTab.Equal(n,
+ 1431                                                    "FALSE") THEN
+ 1432                                                   t := SymTab.BoolType();
+ 1433                                                   QbeGen.CopyOp("0", q)
+ 1434                                                 ELSIF SymTab.Equal(n,
+ 1435                                                    "NIL") THEN
+ 1436                                                   QbeGen.CopyOp("0", q)
+ 1437                                                 ELSE
+ 1438                                                   cls :=
+ 1439                                                     SymTab.ClassOf(t);
+ 1440                                                   IF (t #
+ 1441                                                       SymTab.InvalidType)
+ 1442   AND ((cls = SymTab.ClInt)
  1443                                                      OR (cls
- 1444                                                          = SymTab.ClNil)) THEN
- 1445                                                     IF cls = SymTab.ClNil THEN
- 1446                                                       QbeGen.CopyOp("0", q)
- 1447                                                     ELSIF ((cls
- 1448                                                         = SymTab.ClInt)
- 1449                                                       OR (cls
- 1450                                                         = SymTab.ClChar)
- 1451                                                       OR (cls
- 1452                                                         = SymTab.ClEnum))
- 1453    AND SymTab.GetSymVal(n, cv)
- 1454    AND QbeGen.IsImm(cv) THEN
- 1455                                                       QbeGen.CopyOp(cv, q)
- 1456                                                     ELSE
- 1457                                                       QbeGen.LoadVar(n,
- 1458                                                         cls = SymTab.ClReal,
- 1459                                                         q)
- 1460                                                     END
- 1461                                                   ELSE
- 1462                                                     IF t #
- 1463                                                        SymTab.InvalidType THEN
- 1464                                                       SemError(230)
- 1465                                                     END;
- 1466                                                     QbeGen.CopyOp("0", q)
- 1467                                                   END
- 1468                                                 END
- 1469                                               ELSIF (k = SymTab.KindVar)
- 1470                                                  OR (k = SymTab.KindParam) THEN
- 1471                                                 cls :=
- 1472                                                   SymTab.ClassOf(t);
- 1473                                                 IF (cls = SymTab.ClInt)
- 1474                                                    OR (cls = SymTab.ClBool)
- 1475                                                    OR (cls = SymTab.ClChar)
- 1476                                                    OR (cls = SymTab.ClUChar)
- 1477                                                    OR (cls = SymTab.ClEnum)
- 1478                                                    OR (cls
- 1479                                                        = SymTab.ClReal) THEN
- 1480                                                   QbeGen.LoadVar(n,
- 1481                                                     cls = SymTab.ClReal, q)
- 1482                                                 ELSIF (cls = SymTab.ClPtr)
- 1483                                                    OR (cls = SymTab.ClProc) THEN
- 1484                                                   QbeGen.LoadPtr(n, q)
- 1485                                                 ELSIF cls = SymTab.ClLong THEN
- 1486                                                   QbeGen.LoadLong(n, q)
- 1487                                                 ELSIF (cls
- 1488                                                         = SymTab.ClArray)
- 1489                                                    OR (cls
- 1490                                                        = SymTab.ClSet)
- 1491                                                    OR (cls
- 1492                                                        = SymTab.ClRecord)
- 1493                                                    OR (cls
- 1494                                                        = SymTab.ClUStr)
+ 1444                                                          = SymTab.ClChar)
+ 1445                                                      OR (cls
+ 1446                                                          = SymTab.ClEnum)
+ 1447                                                      OR (cls
+ 1448                                                          = SymTab.ClReal)
+ 1449                                                      OR (cls
+ 1450                                                          = SymTab.ClNil)) THEN
+ 1451                                                     IF cls = SymTab.ClNil THEN
+ 1452                                                       QbeGen.CopyOp("0", q)
+ 1453                                                     ELSIF ((cls
+ 1454                                                         = SymTab.ClInt)
+ 1455                                                       OR (cls
+ 1456                                                         = SymTab.ClChar)
+ 1457                                                       OR (cls
+ 1458                                                         = SymTab.ClEnum))
+ 1459    AND SymTab.GetSymVal(n, cv)
+ 1460    AND QbeGen.IsImm(cv) THEN
+ 1461                                                       QbeGen.CopyOp(cv, q)
+ 1462                                                     ELSE
+ 1463                                                       QbeGen.LoadVar(n,
+ 1464                                                         cls = SymTab.ClReal,
+ 1465                                                         q)
+ 1466                                                     END
+ 1467                                                   ELSE
+ 1468                                                     IF t #
+ 1469                                                        SymTab.InvalidType THEN
+ 1470                                                       SemError(230)
+ 1471                                                     END;
+ 1472                                                     QbeGen.CopyOp("0", q)
+ 1473                                                   END
+ 1474                                                 END
+ 1475                                               ELSIF (k = SymTab.KindVar)
+ 1476                                                  OR (k = SymTab.KindParam) THEN
+ 1477                                                 cls :=
+ 1478                                                   SymTab.ClassOf(t);
+ 1479                                                 IF (cls = SymTab.ClInt)
+ 1480                                                    OR (cls = SymTab.ClBool)
+ 1481                                                    OR (cls = SymTab.ClChar)
+ 1482                                                    OR (cls = SymTab.ClUChar)
+ 1483                                                    OR (cls = SymTab.ClEnum)
+ 1484                                                    OR (cls
+ 1485                                                        = SymTab.ClReal) THEN
+ 1486                                                   QbeGen.LoadVar(n,
+ 1487                                                     cls = SymTab.ClReal, q)
+ 1488                                                 ELSIF (cls = SymTab.ClPtr)
+ 1489                                                    OR (cls = SymTab.ClProc) THEN
+ 1490                                                   QbeGen.LoadPtr(n, q)
+ 1491                                                 ELSIF cls = SymTab.ClLong THEN
+ 1492                                                   QbeGen.LoadLong(n, q)
+ 1493                                                 ELSIF (cls
+ 1494                                                         = SymTab.ClArray)
  1495                                                    OR (cls
- 1496                                                        = SymTab.ClClass) THEN
- 1497                                                   QbeGen.AddrOf(n, q)
- 1498                                                 ELSE SemError(230);
- 1499                                                   QbeGen.CopyOp("0", q)
- 1500                                                 END
- 1501                                               ELSE QbeGen.CopyOp("0", q);
- 1502                                                 IF k = SymTab.KindImport THEN
- 1503                                                   SemError(230)
- 1504                                                 ELSIF k =
- 1505                                                    SymTab.KindProc THEN
- 1506                                                   (* bare procedure name:
- 1507                                                      a following ArgList
- 1508                                                      makes it a call;
- 1509                                                      otherwise Fact
- 1510                                                      reports 230 *)
- 1511                                                 ELSE
- 1512                                                   IF k = SymTab.KindField THEN
- 1513                                                     IF QbeGen.TopWith(qb) THEN
- 1514                                                       fo :=
- 1515                                                         SymTab.FieldOffset(
- 1516                                                         SymTab.FieldOwner(n),
- 1517                                                         n);
- 1518                                                       QbeGen.FieldAddr(qb,
- 1519                                                         fo, q);
- 1520                                                       sfx := TRUE
- 1521                                                     ELSE SemError(230);
- 1522                                                       QbeGen.CopyOp("0", q)
- 1523                                                     END
- 1524                                                   END
- 1525                                                 END
- 1526                                               END
- 1527                                             END; .)
- 1528        { "[" Expr<it, iq>
- 1529                                          (. IF t = SymTab.InvalidType THEN
- 1530                                             ELSIF SymTab.ClassOf(t) #
- 1531                                                   SymTab.ClArray THEN
- 1532                                               SemError(217);
- 1533                                               t := SymTab.InvalidType
- 1534                                             ELSIF NOT SymTab.IsIntFamily(it)
- 1535   AND (SymTab.ClassOf(it) #
- 1536                                                   SymTab.ClChar) THEN
- 1537                                               SemError(218);
- 1538                                               t := SymTab.InvalidType
- 1539                                             ELSE
- 1540                                               QbeGen.WidenIndex(iq, ql);
- 1541                                               isOpen :=
- 1542                                                 SymTab.IsOpenArray(t);
- 1543                                               IF isOpen THEN
- 1544                                                 QbeGen.CopyOp("0", qlo);
- 1545                                                 IF SymTab.IsCharArray(t) THEN
- 1546                                                   QbeGen.OpenHiChar(q, qhi)
- 1547                                                 ELSE QbeGen.OpenHi(q, qhi)
- 1548                                                 END
- 1549                                               ELSE
- 1550                                                 lo := SymTab.ArrayLo(t);
- 1551                                                 hi := SymTab.ArrayHi(t);
- 1552                                                 IF SymTab.IsCharArray(t) THEN
- 1553                                                   hi := hi + 1
- 1554                                                 END;
- 1555                                                 QbeGen.IntStr(lo, qlo);
- 1556                                                 QbeGen.IntStr(hi, qhi)
- 1557                                               END;
- 1558                                               QbeGen.CheckRange(ql, qlo,
- 1559                                                 qhi);
- 1560                                               eT := SymTab.ArrayElem(t);
- 1561                                               QbeGen.ElemAddr(q, ql, qlo,
- 1562                                                 t, qe);
- 1563                                               IF SymTab.ClassOf(eT) =
- 1564                                                  SymTab.ClArray THEN
- 1565                                                 QbeGen.ElemLoad(qe, eT, q)
- 1566                                               ELSE QbeGen.CopyOp(qe, q)
- 1567                                               END;
- 1568                                               t := eT; sfx := TRUE
- 1569                                             END; .)
- 1570          { "," Expr<it, iq>
- 1571                                          (. IF t = SymTab.InvalidType THEN
- 1572                                             ELSIF SymTab.ClassOf(t) #
- 1573                                                   SymTab.ClArray THEN
- 1574                                               SemError(217);
- 1575                                               t := SymTab.InvalidType
- 1576                                             ELSIF NOT SymTab.IsIntFamily(it)
- 1577   AND (SymTab.ClassOf(it) #
- 1578                                                   SymTab.ClChar) THEN
- 1579                                               SemError(218);
- 1580                                               t := SymTab.InvalidType
- 1581                                             ELSE
- 1582                                               QbeGen.WidenIndex(iq, ql);
- 1583                                               isOpen :=
- 1584                                                 SymTab.IsOpenArray(t);
- 1585                                               IF isOpen THEN
- 1586                                                 QbeGen.CopyOp("0", qlo);
- 1587                                                 IF SymTab.IsCharArray(t) THEN
- 1588                                                   QbeGen.OpenHiChar(q, qhi)
- 1589                                                 ELSE QbeGen.OpenHi(q, qhi)
- 1590                                                 END
- 1591                                               ELSE
- 1592                                                 lo := SymTab.ArrayLo(t);
- 1593                                                 hi := SymTab.ArrayHi(t);
- 1594                                                 IF SymTab.IsCharArray(t) THEN
- 1595                                                   hi := hi + 1
- 1596                                                 END;
- 1597                                                 QbeGen.IntStr(lo, qlo);
- 1598                                                 QbeGen.IntStr(hi, qhi)
- 1599                                               END;
- 1600                                               QbeGen.CheckRange(ql, qlo,
- 1601                                                 qhi);
- 1602                                               eT := SymTab.ArrayElem(t);
- 1603                                               QbeGen.ElemAddr(q, ql, qlo,
- 1604                                                 t, qe);
- 1605                                               IF SymTab.ClassOf(eT) =
- 1606                                                  SymTab.ClArray THEN
- 1607                                                 QbeGen.ElemLoad(qe, eT, q)
- 1608                                               ELSE QbeGen.CopyOp(qe, q)
- 1609                                               END;
- 1610                                               t := eT; sfx := TRUE
- 1611                                             END; .) }
- 1612          "]"
- 1613        | "." GetIdent<fn>
- 1614                                          (. IF k = SymTab.KindModule THEN
- 1615                                               (* qualified L.x: materialize
- 1616                                                  the export, then load it *)
- 1617                                               IF NOT SymTab.MaterializeAlias(n,
- 1618                                                    fn, mal) THEN
- 1619                                                 SemError(201);
- 1620                                                 t := SymTab.InvalidType;
- 1621                                                 QbeGen.CopyOp("0", q)
- 1622                                               ELSE
- 1623                                                 QbeGen.CopyOp(mal, qn);
- 1624                                                 t := SymTab.SymType(mal);
- 1625                                                 k := SymTab.SymKind(mal);
- 1626                                                 sfx := FALSE;
- 1627                                                 IF k = SymTab.KindProc THEN
- 1628                                                   (* call: ArgList supplies
- 1629                                                      the value *)
- 1630                                                   QbeGen.CopyOp("0", q)
- 1631                                                 ELSIF NOT QbeGen.LoadDesignator(
- 1632                                                      mal, t, k, q) THEN
- 1633                                                   SemError(230);
- 1634                                                   QbeGen.CopyOp("0", q)
- 1635                                                 END
- 1636                                               END
- 1637                                             ELSIF t = SymTab.InvalidType THEN
- 1638                                             ELSIF (SymTab.ClassOf(t) #
- 1639                                                    SymTab.ClRecord)
- 1640   AND (SymTab.ClassOf(t) #
- 1641                                                   SymTab.ClClass) THEN
- 1642                                               SemError(215);
- 1643                                               t := SymTab.InvalidType
- 1644                                             ELSIF NOT SymTab.FieldExists(t,
- 1645                                                      fn) THEN
- 1646                                               SemError(216);
- 1647                                               t := SymTab.InvalidType
- 1648                                             ELSE
- 1649                                               fo := SymTab.FieldOffset(t,
- 1650                                                 fn);
- 1651                                               t := SymTab.FieldType(t, fn);
- 1652                                               QbeGen.FieldAddr(q, fo, qe);
- 1653                                               (* array fields are inline:
- 1654                                                  the field address is the
- 1655                                                  descriptor, like records *)
- 1656                                               QbeGen.CopyOp(qe, q);
- 1657                                               sfx := TRUE
- 1658                                             END; .)
- 1659        | "^"
- 1660                                          (. IF t = SymTab.InvalidType THEN
- 1661                                             ELSIF SymTab.ClassOf(t) #
- 1662                                                   SymTab.ClPtr THEN
- 1663                                               SemError(219);
- 1664                                               t := SymTab.InvalidType
- 1665                                             ELSE
- 1666                                               bt := SymTab.PtrBase(t);
- 1667                                               IF bt = SymTab.InvalidType THEN
- 1668                                               ELSE
- 1669                                                 IF sfx THEN
- 1670                                                   QbeGen.ElemLoad(q, t,
- 1671                                                     qb);
- 1672                                                   QbeGen.CopyOp(qb, q)
- 1673                                                 END;
- 1674                                                 t := bt;
- 1675                                                 (* q holds the pointee
- 1676                                                    address: Fact loads
- 1677                                                    scalars/pointers and uses
- 1678                                                    the address for
- 1679                                                    aggregates; the VAR-actual
- 1680                                                    note is q itself. *)
- 1681                                                 sfx := TRUE
- 1682                                               END
- 1683                                             END; .) } .
- 1684    Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1685                                          (. VAR t2: SymTab.TypeIndex;
- 1686                                               op: INTEGER;
- 1687                                               q2, qt, wl: QbeGen.QVal;
- 1688                                               isR: BOOLEAN; .)
- 1689      = SimExpr<t, q>
- 1690        [ Rel<op> SimExpr<t2, q2>
- 1691          (. IF op = SymTab.OpIn THEN
- 1692               IF SymTab.InCheck(t, t2) THEN
- 1693                 IF (t = SymTab.InvalidType)
- 1694                    OR (t2 = SymTab.InvalidType) THEN
- 1695                   t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1696                 ELSE
- 1697                   QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
- 1698                     SymTab.SetCount(t2), qt);
- 1699                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1700                 END
- 1701               ELSE SemError(222); t := SymTab.InvalidType;
- 1702                 QbeGen.CopyOp("0", q)
- 1703               END
- 1704             ELSIF SymTab.RelCheck(t, t2, op) THEN
- 1705               IF (t = SymTab.InvalidType)
- 1706                  OR (t2 = SymTab.InvalidType) THEN
- 1707                 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1708               ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
- 1709                  OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
- 1710                 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
- 1711   AND (op # SymTab.OpNeq2) THEN
- 1712                   SemError(213); t := SymTab.InvalidType;
- 1713                   QbeGen.CopyOp("0", q)
- 1714                 ELSE
- 1715                   QbeGen.CmpL(op, q, q2, qt);
- 1716                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1717                 END
- 1718               ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
- 1719                  OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1720                 QbeGen.CmpSet(op, q, q2,
- 1721                   SymTab.SetWords(t), SymTab.SetWords(t2), qt);
- 1722                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1723               ELSIF SymTab.StrCompat(t, t2) THEN
- 1724                 QbeGen.StrEq(op, q, q2, qt);
- 1725                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1726               ELSIF SymTab.IsLongFamily(t)
- 1727                  OR SymTab.IsLongFamily(t2) THEN
- 1728                 IF SymTab.IsIntFamily(t) THEN
- 1729                   QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
- 1730                 END;
- 1731                 IF SymTab.IsIntFamily(t2) THEN
- 1732                   QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
- 1733                 END;
- 1734                 QbeGen.CmpLong(op, q, q2, qt);
- 1735                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1736               ELSE
- 1737                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1738                 t := SymTab.BoolType();
- 1739                 QbeGen.Cmp(op, q, q2, qt, isR);
- 1740                 QbeGen.CopyOp(qt, q)
- 1741               END
- 1742             ELSE SemError(213); t := SymTab.InvalidType;
- 1743               QbeGen.CopyOp("0", q)
- 1744             END; .) ] .
- 1745    Rel<VAR op: INTEGER>
- 1746      = "="                               (. op := SymTab.OpEq; .)
- 1747      | "#"                               (. op := SymTab.OpNeq1; .)
- 1748      | "<"                               (. op := SymTab.OpLt; .)
- 1749      | "<="                              (. op := SymTab.OpLe; .)
- 1750      | ">"                               (. op := SymTab.OpGt; .)
- 1751      | ">="                              (. op := SymTab.OpGe; .)
- 1752      | "IN"                              (. op := SymTab.OpIn; .) .
- 1753    SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1754                                          (. VAR t2, res2, lt, rt:
- 1755                                                 SymTab.TypeIndex;
- 1756                                               op: INTEGER;
- 1757                                               q2, qt, wq, qf:
- 1758                                                 QbeGen.QVal;
- 1759                                               neg, isR, isL, folded:
- 1760                                                 BOOLEAN;
- 1761                                               lw, rw, mw: CARDINAL;
- 1762                                               lTrue, lNext, lDone, qr, qs:
- 1763                                                 QbeGen.QVal; .)
- 1764      =                                   (. neg := FALSE; .)
- 1765        [ "+" | "-"                       (. neg := TRUE; .) ]
- 1766        Term<t, q>                        (. IF neg THEN
- 1767                                             IF QbeGen.IsImm(q) THEN
- 1768                                               QbeGen.NegFold(q, q)
- 1769                                             ELSE QbeGen.NewTemp(qt);
- 1770                                               QbeGen.NegQ(q, qt,
- 1771                                                 SymTab.ClassOf(t)
- 1772                                                 = SymTab.ClReal);
- 1773                                               QbeGen.CopyOp(qt, q)
- 1774                                             END
- 1775                                           END; .)
- 1776        { AddOp<op>                       (. IF op = SymTab.OpOr THEN
- 1777                                               QbeGen.DelayBegin END; .)
- 1778          Term<t2, q2>                     (. IF op = SymTab.OpOr THEN
- 1779                                               QbeGen.DelayEnd END; .)
- 1780          (. IF op = SymTab.OpOr THEN
- 1781               (* short-circuit: if q is true the RHS is skipped *)
- 1782               IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 1783                 t := SymTab.BoolType()
- 1784               ELSE SemError(212); t := SymTab.InvalidType END;
- 1785               IF t # SymTab.InvalidType THEN
- 1786                 QbeGen.Slot4(qs);
- 1787                 QbeGen.NewLabel(lTrue);
- 1788                 QbeGen.NewLabel(lNext);
- 1789                 QbeGen.NewLabel(lDone);
- 1790                 QbeGen.Jnz(q, lTrue, lNext);
- 1791                 QbeGen.EmitLabel(lTrue);
- 1792                 QbeGen.StoreW(qs, "1");
- 1793                 QbeGen.Jmp(lDone);
- 1794                 QbeGen.EmitLabel(lNext);
- 1795                 QbeGen.DelayFlush;
- 1796                 QbeGen.StoreW(qs, q2);
- 1797                 QbeGen.Jmp(lDone);
- 1798                 QbeGen.EmitLabel(lDone);
- 1799                 QbeGen.LoadW(qs, qr);
- 1800                 QbeGen.CopyOp(qr, q)
- 1801               ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
- 1802               END
- 1803             ELSIF (op = SymTab.OpAdd)
- 1804               AND (SymTab.StrCompat(t, t2)
- 1805                 OR (SymTab.IsStrType(t)
- 1806                   AND (SymTab.ClassOf(t2) = SymTab.ClChar))
- 1807                 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
- 1808                   AND SymTab.IsStrType(t2))) THEN
- 1809               (* string concatenation; a CHAR operand becomes a
- 1810                  1-character string literal *)
- 1811               IF SymTab.StrCompat(t, t2) THEN
- 1812                 QbeGen.StrCat(q, q2, qt)
- 1813               ELSIF SymTab.IsStrType(t) THEN
- 1814                 QbeGen.DeclCharStr(q2, qs);
- 1815                 QbeGen.StrCat(q, qs, qt)
- 1816               ELSE
- 1817                 QbeGen.DeclCharStr(q, qs);
- 1818                 QbeGen.StrCat(qs, q2, qt)
- 1819               END;
- 1820               t := SymTab.NewStr();
- 1821               QbeGen.CopyOp(qt, q)
- 1822             ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 1823   AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 1824   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1825               lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1826               mw := lw;
- 1827               IF rw > mw THEN mw := rw END;
- 1828               IF op = SymTab.OpAdd THEN
- 1829                 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
- 1830               ELSE
- 1831                 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
- 1832               END;
- 1833               t := SymTab.NewSet(
- 1834                      SymTab.NewSubR(0,
- 1835                        VAL(INTEGER, mw) * 32 - 1));
- 1836               QbeGen.CopyOp(qt, q)
- 1837             ELSE
- 1838               IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
- 1839                 lt := t; rt := t2; t := res2
- 1840               ELSE SemError(211); t := SymTab.InvalidType END;
- 1841               IF t # SymTab.InvalidType THEN
- 1842                 isL := SymTab.IsLongFamily(t);
- 1843                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1844                 folded := FALSE;
- 1845                 IF (NOT isL) AND (NOT isR)
- 1846    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 1847                   IF op = SymTab.OpAdd THEN
- 1848                     folded := QbeGen.Fold2(0, q, q2, qf)
- 1849                   ELSE
- 1850                     folded := QbeGen.Fold2(1, q, q2, qf)
- 1851                   END
- 1852                 END;
- 1853                 IF folded THEN QbeGen.CopyOp(qf, q)
- 1854                 ELSE
- 1855                 IF isL THEN
- 1856                   IF SymTab.IsIntFamily(lt) THEN
- 1857                     QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 1858                   END;
- 1859                   IF SymTab.IsIntFamily(rt) THEN
- 1860                     QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 1861                   END;
- 1862                   QbeGen.NewTemp(qt);
- 1863                   IF op = SymTab.OpAdd THEN
- 1864                     QbeGen.Op3L("add", qt, q, q2)
- 1865                   ELSE
- 1866                     QbeGen.Op3L("sub", qt, q, q2)
- 1867                   END
- 1868                 ELSE
- 1869                   QbeGen.NewTemp(qt);
- 1870                   IF op = SymTab.OpAdd THEN
- 1871                     QbeGen.Op3("add", qt, q, q2, isR)
- 1872                   ELSE
- 1873                     QbeGen.Op3("sub", qt, q, q2, isR)
- 1874                   END
- 1875                 END;
- 1876                 QbeGen.CopyOp(qt, q)
- 1877                 END
- 1878               ELSE QbeGen.CopyOp("0", q)
- 1879               END
- 1880             END; .) } .
- 1881    AddOp<VAR op: INTEGER>
- 1882      = "+"                               (. op := SymTab.OpAdd; .)
- 1883      | "-"                               (. op := SymTab.OpSub; .)
- 1884      | "OR"                              (. op := SymTab.OpOr; .) .
- 1885    Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1886                                          (. VAR t2, res2, lt, rt:
- 1887                                                 SymTab.TypeIndex;
- 1888                                               op: INTEGER;
- 1889                                               q2, qt, wq, qf:
- 1890                                                 QbeGen.QVal;
- 1891                                               isR, isL, folded: BOOLEAN;
- 1892                                               lw, rw, mw: CARDINAL;
- 1893                                               lNext, lFalse, lDone, qr, qs:
- 1894                                                 QbeGen.QVal; .)
- 1895      = Fact<t, q> { MulOp<op>            (. IF op = SymTab.OpAnd THEN
- 1896                                               QbeGen.DelayBegin END; .)
- 1897          Fact<t2, q2>                    (. IF op = SymTab.OpAnd THEN
- 1898                                               QbeGen.DelayEnd END; .)
- 1899        (. IF op = SymTab.OpAnd THEN
- 1900             (* short-circuit: if q is false the RHS is skipped *)
- 1901             IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 1902               t := SymTab.BoolType()
- 1903             ELSE SemError(212); t := SymTab.InvalidType END;
- 1904             IF t # SymTab.InvalidType THEN
- 1905               QbeGen.Slot4(qs);
- 1906               QbeGen.NewLabel(lNext);
- 1907               QbeGen.NewLabel(lFalse);
- 1908               QbeGen.NewLabel(lDone);
- 1909               QbeGen.Jnz(q, lNext, lFalse);
- 1910               QbeGen.EmitLabel(lNext);
- 1911               QbeGen.DelayFlush;
- 1912               QbeGen.StoreW(qs, q2);
- 1913               QbeGen.Jmp(lDone);
- 1914               QbeGen.EmitLabel(lFalse);
- 1915               QbeGen.StoreW(qs, "0");
- 1916               QbeGen.Jmp(lDone);
- 1917               QbeGen.EmitLabel(lDone);
- 1918               QbeGen.LoadW(qs, qr);
- 1919               QbeGen.CopyOp(qr, q)
- 1920             ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
- 1921             END
- 1922           ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 1923   AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 1924   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1925             lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1926             mw := lw;
- 1927             IF rw > mw THEN mw := rw END;
- 1928             IF op = SymTab.OpTimes THEN
- 1929               QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
- 1930             ELSE
- 1931               QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
- 1932             END;
- 1933             t := SymTab.NewSet(
- 1934                    SymTab.NewSubR(0,
- 1935                      VAL(INTEGER, mw) * 32 - 1));
- 1936             QbeGen.CopyOp(qt, q)
- 1937           ELSE
- 1938             IF SymTab.ArithCheck(t, t2,
- 1939                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
- 1940                  res2) THEN
- 1941               lt := t; rt := t2; t := res2
- 1942             ELSE SemError(211); t := SymTab.InvalidType END;
- 1943             IF t # SymTab.InvalidType THEN
- 1944               isL := SymTab.IsLongFamily(t);
- 1945               isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1946               folded := FALSE;
- 1947               IF (NOT isL) AND (NOT isR)
- 1948    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 1949                 IF op = SymTab.OpTimes THEN
- 1950                   folded := QbeGen.Fold2(2, q, q2, qf)
- 1951                 ELSIF op = SymTab.OpDiv THEN
- 1952                   folded := QbeGen.Fold2(3, q, q2, qf)
- 1953                 ELSIF op = SymTab.OpMod THEN
- 1954                   folded := QbeGen.Fold2(4, q, q2, qf)
- 1955                 END
- 1956               END;
- 1957               IF folded THEN QbeGen.CopyOp(qf, q)
- 1958               ELSE
- 1959               IF isL THEN
- 1960                 IF SymTab.IsIntFamily(lt) THEN
- 1961                   QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 1962                 END;
- 1963                 IF SymTab.IsIntFamily(rt) THEN
- 1964                   QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 1965                 END;
- 1966                 QbeGen.NewTemp(qt);
- 1967                 IF op = SymTab.OpTimes THEN
- 1968                   QbeGen.Op3L("mul", qt, q, q2)
- 1969                 ELSIF (op = SymTab.OpDiv)
- 1970                    OR (op = SymTab.OpSlash) THEN
- 1971                   QbeGen.Op3L("div", qt, q, q2)
- 1972                 ELSE
- 1973                   QbeGen.Op3L("rem", qt, q, q2)
- 1974                 END
- 1975               ELSE
- 1976                 QbeGen.NewTemp(qt);
- 1977                 IF op = SymTab.OpTimes THEN
- 1978                   QbeGen.Op3("mul", qt, q, q2, isR)
- 1979                 ELSIF (op = SymTab.OpDiv)
- 1980                    OR (op = SymTab.OpSlash) THEN
- 1981                   QbeGen.Op3("div", qt, q, q2, isR)
- 1982                 ELSE
- 1983                   QbeGen.Op3("rem", qt, q, q2, isR)
- 1984                 END
- 1985               END;
- 1986               QbeGen.CopyOp(qt, q)
- 1987               END
- 1988             ELSE QbeGen.CopyOp("0", q)
- 1989             END
- 1990           END; .) } .
- 1991    MulOp<VAR op: INTEGER>
- 1992      = "*"                               (. op := SymTab.OpTimes; .)
- 1993      | "/"                               (. op := SymTab.OpSlash; .)
- 1994      | "DIV"                             (. op := SymTab.OpDiv; .)
- 1995      | "MOD"                             (. op := SymTab.OpMod; .)
- 1996      | ( "AND" | "&" )                   (. op := SymTab.OpAnd; .) .
- 1997    Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1998                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
- 1999                                               et, dt, t2, st, ct2:
- 2000                                                 SymTab.TypeIndex;
- 2001                                               dk: INTEGER;
- 2002                                               qd, q2, sq, qa, qm0, qr:
- 2003                                                 QbeGen.QVal;
- 2004                                               qn, vn: SymTab.Name;
- 2005                                               vt: SymTab.TypeIndex;
- 2006                                               c1, c2: INTEGER;
- 2007                                               called, isHigh, sfx, isCh,
- 2008                                               isU, uok, isStr: BOOLEAN;
- 2009                                               ucp: INTEGER; .)
- 2010      = integer                           (. LexString(s);
- 2011                                             QbeGen.NormInt(s, q);
- 2012                                             t := SymTab.IntType(); .)
- 2013      | charConst                         (. LexString(s);
- 2014                                             QbeGen.NormLit(s, q, isCh);
- 2015                                             t := SymTab.CharType(); .)
- 2016      | real                              (. LexString(s);
- 2017                                             QbeGen.NormReal(s, q);
- 2018                                             t := SymTab.RealType(); .)
- 2019      | string                            (. LexString(s);
- 2020                                             IF SymTab.StrLen(s) = 3 THEN
- 2021                                               t := SymTab.CharType();
- 2022                                               QbeGen.IntStr(
- 2023                                                 QbeGen.CharVal(s), q)
- 2024                                             ELSE t := SymTab.NewStr();
- 2025                                               QbeGen.DeclStr(s, q);
- 2026                                               (* a literal's value IS its
- 2027                                                  static descriptor address *)
- 2028                                               QbeGen.NoteAddr(q, q)
- 2029                                             END; .)
- 2030      | ustring                           (. LexString(s);
- 2031                                             QbeGen.DeclUStr(s, q, isU, ucp,
- 2032                                               uok);
- 2033                                             IF NOT uok THEN
- 2034                                               SemError(234);
- 2035                                               t := SymTab.InvalidType
- 2036                                             ELSIF isU THEN
- 2037                                               t := SymTab.UCharType();
- 2038                                               QbeGen.IntStr(ucp, q)
- 2039                                             ELSE
- 2040                                               t := SymTab.NewUStr();
- 2041                                               QbeGen.NoteAddr(q, q)
- 2042                                             END; .)
- 2043      | Design<dt, dk, qd, qn, sfx>       (. called := FALSE;
- 2044                                             t := dt;
- 2045                                             IF sfx THEN
- 2046                                               IF dt =
- 2047                                                  SymTab.InvalidType THEN
- 2048                                                 QbeGen.CopyOp("0", q)
- 2049                                               ELSIF (SymTab.ClassOf(dt) =
- 2050                                                      SymTab.ClRecord)
- 2051                                                  OR (SymTab.ClassOf(dt) =
- 2052                                                      SymTab.ClSet)
- 2053                                                  OR (SymTab.ClassOf(dt) =
- 2054                                                      SymTab.ClArray)
- 2055                                                  OR (SymTab.ClassOf(dt) =
- 2056                                                      SymTab.ClClass) THEN
- 2057                                                 QbeGen.CopyOp(qd, q)
- 2058                                               ELSE QbeGen.ElemLoad(qd, dt,
- 2059                                                 q)
- 2060                                               END
- 2061                                             ELSE QbeGen.CopyOp(qd, q)
- 2062                                             END;
- 2063                                             IF (dk = SymTab.KindVar)
- 2064                                                OR (dk = SymTab.KindParam)
- 2065                                                OR (dk =
- 2066                                                   SymTab.KindField) THEN
- 2067                                               IF sfx THEN
- 2068                                                 QbeGen.NoteAddr(q, qd)
- 2069                                               ELSE
- 2070                                                 QbeGen.AddrOf(qn, qa);
- 2071                                                 QbeGen.NoteAddr(q, qa)
- 2072                                               END
- 2073                                             ELSIF sfx
- 2074   AND (dt #
- 2075                                                   SymTab.InvalidType)
- 2076   AND ((SymTab.ClassOf(dt) =
- 2077                                                    SymTab.ClArray)
- 2078                                                   OR (SymTab.ClassOf(dt) =
- 2079                                                       SymTab.ClSet)
- 2080                                                   OR (SymTab.ClassOf(dt) =
- 2081                                                       SymTab.ClRecord)) THEN
- 2082                                               QbeGen.NoteAddr(qd, qd)
- 2083                                             END; .)
- 2084        [ TypedSetLit<dt, q>              (. t := dt; .) ]
- 2085        [ ArgList<qn, dt, qd, TRUE, ct2, q2, called>
- 2086                                          (. t := ct2;
- 2087                                             QbeGen.CopyOp(q2, q); .) ]
- 2088                                          (. IF NOT called
- 2089   AND (dk = SymTab.KindProc) THEN
- 2090                                               (* bare zero-arg function
- 2091                                                  call (parentheses may be
- 2092                                                  omitted); a proper or
- 2093                                                  parameterised proc here
- 2094                                                  is 230 *)
- 2095                                               IF (SymTab.ProcNPar(qn) = 0)
- 2096   AND (SymTab.ProcRes(qn) #
- 2097                                                     SymTab.InvalidType) THEN
- 2098                                                 QbeGen.Mangled(qn,
- 2099                                                   SymTab.ProcUid(qn), qm0);
- 2100                                                 QbeGen.CallBegin(qm0,
- 2101                                                   SymTab.ProcRes(qn),
- 2102                                                   SymTab.ProcDepthOf(qn),
- 2103                                                   SymTab.IsExternal(qn));
- 2104                                                 QbeGen.CallEnd(TRUE, q);
- 2105                                                 t := SymTab.ProcRes(qn)
- 2106                                               ELSE
- 2107                                                 (* procedure used as a
- 2108                                                    value (assign to a
- 2109                                                    procedure variable):
- 2110                                                    its code address *)
- 2111                                                 t := SymTab.ProcTypeOf(qn);
- 2112                                                 QbeGen.Mangled(qn,
- 2113                                                   SymTab.ProcUid(qn), qm0);
- 2114                                                 QbeGen.ProcAddr(qm0, q)
- 2115                                               END
- 2116                                             END; .)
- 2117      | ( "HIGH"                          (. isHigh := TRUE; .)
- 2118        | ( "LEN" | "LENGTH" )            (. isHigh := FALSE; .) )
- 2119        "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE; .)
- 2120            | string                       (. LexString(s);
- 2121                                              isStr := TRUE;
- 2122                                              IF SymTab.StrLen(s) = 3 THEN
- 2123                                                dt := SymTab.CharType();
- 2124                                                QbeGen.IntStr(QbeGen.CharVal(s),
- 2125                                                  qd)
- 2126                                              ELSE
- 2127                                                dt := SymTab.NewStr();
- 2128                                                QbeGen.DeclStr(s, qd);
- 2129                                                QbeGen.NoteAddr(qd, qd)
- 2130                                              END;
- 2131                                              dk := -1;
- 2132                                              qn[0] := CHR(0); .) )
- 2133        ")"
- 2134                                          (. IF isStr THEN
- 2135                                               (* fold: content length at
- 2136                                                  compile time *)
- 2137                                               IF SymTab.StrLen(s) = 3 THEN
- 2138                                                 c1 := 1
- 2139                                               ELSE
- 2140                                                 c1 :=
- 2141                                                   SymTab.StrLen(s) - 2
- 2142                                               END;
- 2143                                               IF isHigh THEN
- 2144                                                 DEC(c1)
- 2145                                               END;
- 2146                                               QbeGen.IntStr(c1, qr);
- 2147                                               t := SymTab.IntType();
- 2148                                               QbeGen.CopyOp(qr, q)
- 2149                                             ELSIF dt = SymTab.InvalidType THEN
- 2150                                               t := SymTab.InvalidType;
- 2151                                               QbeGen.CopyOp("0", q)
- 2152                                             ELSIF SymTab.ClassOf(dt) #
- 2153                                                   SymTab.ClArray THEN
- 2154                                               SemError(217);
- 2155                                               t := SymTab.InvalidType;
- 2156                                               QbeGen.CopyOp("0", q)
- 2157                                             ELSE
- 2158                                               IF isHigh THEN
- 2159                                                 IF SymTab.IsOpenArray(dt) THEN
- 2160                                                   QbeGen.OpenHi(qd, qr)
- 2161                                                 ELSE
- 2162                                                   QbeGen.IntStr(
- 2163                                                     SymTab.ArrayHi(dt), qr)
- 2164                                                 END
- 2165                                               ELSE
- 2166                                                 IF SymTab.IsOpenArray(dt) THEN
- 2167                                                   QbeGen.LoadCount(qd, qr)
- 2168                                                 ELSE
- 2169                                                   QbeGen.IntStr(VAL(
- 2170                                                     INTEGER,
- 2171                                                     SymTab.ArrayLen(dt)),
- 2172                                                     qr)
- 2173                                                 END
- 2174                                               END;
- 2175                                                t := SymTab.IntType();
- 2176                                                QbeGen.CopyOp(qr, q)
- 2177                                              END; .)
- 2178      | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
- 2179                                          (. IF dt = SymTab.InvalidType THEN
- 2180                                               t := SymTab.InvalidType;
- 2181                                               QbeGen.CopyOp("0", q)
- 2182                                             ELSE
- 2183                                               QbeGen.IntStr(VAL(INTEGER,
- 2184                                                 SymTab.ObjectSize(dt)), q);
- 2185                                               t := SymTab.IntType()
- 2186                                             END; .)
- 2187      | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
- 2188                                          (. IF dt = SymTab.InvalidType THEN
- 2189                                               t := SymTab.InvalidType;
- 2190                                               QbeGen.CopyOp("0", q)
- 2191                                             ELSE
- 2192                                               IF sfx THEN
- 2193                                                 QbeGen.CopyOp(qd, q)
- 2194                                               ELSIF (dk = SymTab.KindVar)
- 2195                                                  OR (dk = SymTab.KindParam) THEN
- 2196                                                 QbeGen.AddrOf(qn, q)
- 2197                                               ELSE SemError(230);
- 2198                                                 QbeGen.CopyOp("0", q)
- 2199                                               END;
- 2200                                               t := SymTab.AddrType()
- 2201                                             END; .)
- 2202      | "CHR" "(" Expr<et, q> ")"
- 2203                                          (. IF (et # SymTab.InvalidType)
- 2204   AND NOT SymTab.IsIntFamily(et) THEN
- 2205                                               SemError(211) END;
- 2206                                             t := SymTab.CharType(); .)
- 2207      | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
- 2208                                          (. IF et # SymTab.InvalidType THEN
- 2209                                               IF (SymTab.ClassOf(et) #
- 2210                                                   SymTab.ClChar)
- 2211   AND (SymTab.ClassOf(et) #
- 2212                                                     SymTab.ClBool)
- 2213   AND (SymTab.ClassOf(et) #
- 2214                                                     SymTab.ClEnum)
- 2215   AND NOT SymTab.IsIntFamily(et) THEN
- 2216                                                 SemError(211) END
- 2217                                             END;
- 2218                                             t := SymTab.IntType(); .)
- 2219      | "CAP" "(" Expr<et, q> ")"
- 2220                                          (. QbeGen.CapQ(q, qa);
- 2221                                             QbeGen.CopyOp(qa, q);
- 2222                                             t := SymTab.CharType(); .)
- 2223      | "UCHR" "(" Expr<et, q> ")"
- 2224                                          (. (* UCHR: the UCHAR constructor.
- 2225                                                CHAR -> UCHAR (identity);
- 2226                                                INTEGER familly -> UCHAR
- 2227                                                (codepoint value). *)
- 2228                                             IF (et # SymTab.InvalidType)
- 2229    AND (SymTab.ClassOf(et) # SymTab.ClChar)
- 2230    AND NOT SymTab.IsIntFamily(et) THEN
- 2231                                               SemError(211) END;
- 2232                                             t := SymTab.UCharType(); .)
- 2233      | "CHR8" "(" Expr<et, q> ")"
- 2234                                          (. IF (et # SymTab.InvalidType)
- 2235    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
- 2236                                               SemError(211) END;
- 2237                                             QbeGen.WidenLong(q, qa);
- 2238                                             QbeGen.CheckRange(qa, "0", "255");
- 2239                                             t := SymTab.CharType(); .)
- 2240      | "UORD" "(" Expr<et, q> ")"
- 2241                                          (. (* UORD(u): the codepoint as a
- 2242                                                32-bit ordinal (INTEGER),
- 2243                                                cf. ORD for CHAR. *)
- 2244                                             IF (et # SymTab.InvalidType)
- 2245    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
- 2246                                               SemError(211) END;
- 2247                                             t := SymTab.IntType(); .)
- 2248      | "ABS" "(" Expr<et, q> ")"
- 2249                                          (. IF (et # SymTab.InvalidType)
- 2250   AND NOT SymTab.IsIntFamily(et)
- 2251   AND (SymTab.ClassOf(et) #
- 2252                                                  SymTab.ClReal) THEN
- 2253                                               SemError(211)
- 2254                                             ELSE QbeGen.AbsQ(q, qa,
- 2255                                                    SymTab.ClassOf(et) =
- 2256                                                      SymTab.ClReal);
- 2257                                               QbeGen.CopyOp(qa, q)
- 2258                                             END;
- 2259                                             t := et; .)
- 2260      | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
- 2261                                          (. IF NOT SymTab.Lookup(vn) THEN
- 2262                                               SemError(201);
- 2263                                               t := SymTab.InvalidType
- 2264                                             ELSE vt := SymTab.SymType(vn);
- 2265                                               IF vt = SymTab.InvalidType THEN
- 2266                                                 t := SymTab.InvalidType
- 2267                                               ELSIF et =
- 2268                                                  SymTab.InvalidType THEN
- 2269                                                 t := vt
- 2270                                               ELSE
- 2271                                                 c1 := SymTab.ClassOf(et);
- 2272                                                 c2 := SymTab.ClassOf(vt);
- 2273                                                 IF ((c1 = SymTab.ClInt)
- 2274                                                     OR (c1 =
- 2275                                                        SymTab.ClChar)
- 2276                                                     OR (c1 =
- 2277                                                        SymTab.ClBool)
- 2278                                                     OR (c1 =
- 2279                                                        SymTab.ClEnum))
- 2280   AND ((c2 = SymTab.ClInt)
- 2281                                                     OR (c2 =
- 2282                                                        SymTab.ClChar)
- 2283                                                     OR (c2 =
- 2284                                                        SymTab.ClBool)
- 2285                                                     OR (c2 =
- 2286                                                        SymTab.ClEnum)) THEN
- 2287                                                   t := vt
- 2288                                                 ELSIF (c1 = SymTab.ClPtr)
- 2289   AND (c2 = SymTab.ClPtr) THEN
- 2290                                                   t := vt
- 2291                                                 ELSIF (c1 = SymTab.ClReal)
- 2292   AND (c2 = SymTab.ClReal) THEN
+ 1496                                                        = SymTab.ClSet)
+ 1497                                                    OR (cls
+ 1498                                                        = SymTab.ClRecord)
+ 1499                                                    OR (cls
+ 1500                                                        = SymTab.ClUStr)
+ 1501                                                    OR (cls
+ 1502                                                        = SymTab.ClClass) THEN
+ 1503                                                   QbeGen.AddrOf(n, q)
+ 1504                                                 ELSE SemError(230);
+ 1505                                                   QbeGen.CopyOp("0", q)
+ 1506                                                 END
+ 1507                                               ELSE QbeGen.CopyOp("0", q);
+ 1508                                                 IF k = SymTab.KindImport THEN
+ 1509                                                   SemError(230)
+ 1510                                                 ELSIF k =
+ 1511                                                    SymTab.KindProc THEN
+ 1512                                                   (* bare procedure name:
+ 1513                                                      a following ArgList
+ 1514                                                      makes it a call;
+ 1515                                                      otherwise Fact
+ 1516                                                      reports 230 *)
+ 1517                                                 ELSE
+ 1518                                                   IF k = SymTab.KindField THEN
+ 1519                                                     IF QbeGen.TopWith(qb) THEN
+ 1520                                                       fo :=
+ 1521                                                         SymTab.FieldOffset(
+ 1522                                                         SymTab.FieldOwner(n),
+ 1523                                                         n);
+ 1524                                                       QbeGen.FieldAddr(qb,
+ 1525                                                         fo, q);
+ 1526                                                       sfx := TRUE
+ 1527                                                     ELSE SemError(230);
+ 1528                                                       QbeGen.CopyOp("0", q)
+ 1529                                                     END
+ 1530                                                   END
+ 1531                                                 END
+ 1532                                               END
+ 1533                                             END; .)
+ 1534        { "[" Expr<it, iq>
+ 1535                                          (. IF t = SymTab.InvalidType THEN
+ 1536                                             ELSIF SymTab.ClassOf(t) #
+ 1537                                                   SymTab.ClArray THEN
+ 1538                                               SemError(217);
+ 1539                                               t := SymTab.InvalidType
+ 1540                                             ELSIF NOT SymTab.IsIntFamily(it)
+ 1541   AND (SymTab.ClassOf(it) #
+ 1542                                                   SymTab.ClChar) THEN
+ 1543                                               SemError(218);
+ 1544                                               t := SymTab.InvalidType
+ 1545                                             ELSE
+ 1546                                               QbeGen.WidenIndex(iq, ql);
+ 1547                                               isOpen :=
+ 1548                                                 SymTab.IsOpenArray(t);
+ 1549                                               IF isOpen THEN
+ 1550                                                 QbeGen.CopyOp("0", qlo);
+ 1551                                                 IF SymTab.IsCharArray(t) THEN
+ 1552                                                   QbeGen.OpenHiChar(q, qhi)
+ 1553                                                 ELSE QbeGen.OpenHi(q, qhi)
+ 1554                                                 END
+ 1555                                               ELSE
+ 1556                                                 lo := SymTab.ArrayLo(t);
+ 1557                                                 hi := SymTab.ArrayHi(t);
+ 1558                                                 IF SymTab.IsCharArray(t) THEN
+ 1559                                                   hi := hi + 1
+ 1560                                                 END;
+ 1561                                                 QbeGen.IntStr(lo, qlo);
+ 1562                                                 QbeGen.IntStr(hi, qhi)
+ 1563                                               END;
+ 1564                                               QbeGen.CheckRange(ql, qlo,
+ 1565                                                 qhi);
+ 1566                                               eT := SymTab.ArrayElem(t);
+ 1567                                               QbeGen.ElemAddr(q, ql, qlo,
+ 1568                                                 t, qe);
+ 1569                                               IF SymTab.ClassOf(eT) =
+ 1570                                                  SymTab.ClArray THEN
+ 1571                                                 QbeGen.ElemLoad(qe, eT, q)
+ 1572                                               ELSE QbeGen.CopyOp(qe, q)
+ 1573                                               END;
+ 1574                                               t := eT; sfx := TRUE
+ 1575                                             END; .)
+ 1576          { "," Expr<it, iq>
+ 1577                                          (. IF t = SymTab.InvalidType THEN
+ 1578                                             ELSIF SymTab.ClassOf(t) #
+ 1579                                                   SymTab.ClArray THEN
+ 1580                                               SemError(217);
+ 1581                                               t := SymTab.InvalidType
+ 1582                                             ELSIF NOT SymTab.IsIntFamily(it)
+ 1583   AND (SymTab.ClassOf(it) #
+ 1584                                                   SymTab.ClChar) THEN
+ 1585                                               SemError(218);
+ 1586                                               t := SymTab.InvalidType
+ 1587                                             ELSE
+ 1588                                               QbeGen.WidenIndex(iq, ql);
+ 1589                                               isOpen :=
+ 1590                                                 SymTab.IsOpenArray(t);
+ 1591                                               IF isOpen THEN
+ 1592                                                 QbeGen.CopyOp("0", qlo);
+ 1593                                                 IF SymTab.IsCharArray(t) THEN
+ 1594                                                   QbeGen.OpenHiChar(q, qhi)
+ 1595                                                 ELSE QbeGen.OpenHi(q, qhi)
+ 1596                                                 END
+ 1597                                               ELSE
+ 1598                                                 lo := SymTab.ArrayLo(t);
+ 1599                                                 hi := SymTab.ArrayHi(t);
+ 1600                                                 IF SymTab.IsCharArray(t) THEN
+ 1601                                                   hi := hi + 1
+ 1602                                                 END;
+ 1603                                                 QbeGen.IntStr(lo, qlo);
+ 1604                                                 QbeGen.IntStr(hi, qhi)
+ 1605                                               END;
+ 1606                                               QbeGen.CheckRange(ql, qlo,
+ 1607                                                 qhi);
+ 1608                                               eT := SymTab.ArrayElem(t);
+ 1609                                               QbeGen.ElemAddr(q, ql, qlo,
+ 1610                                                 t, qe);
+ 1611                                               IF SymTab.ClassOf(eT) =
+ 1612                                                  SymTab.ClArray THEN
+ 1613                                                 QbeGen.ElemLoad(qe, eT, q)
+ 1614                                               ELSE QbeGen.CopyOp(qe, q)
+ 1615                                               END;
+ 1616                                               t := eT; sfx := TRUE
+ 1617                                             END; .) }
+ 1618          "]"
+ 1619        | "." GetIdent<fn>
+ 1620                                          (. IF k = SymTab.KindModule THEN
+ 1621                                               (* qualified L.x: materialize
+ 1622                                                  the export, then load it *)
+ 1623                                               IF NOT SymTab.MaterializeAlias(n,
+ 1624                                                    fn, mal) THEN
+ 1625                                                 SemError(201);
+ 1626                                                 t := SymTab.InvalidType;
+ 1627                                                 QbeGen.CopyOp("0", q)
+ 1628                                               ELSE
+ 1629                                                 QbeGen.CopyOp(mal, qn);
+ 1630                                                 t := SymTab.SymType(mal);
+ 1631                                                 k := SymTab.SymKind(mal);
+ 1632                                                 sfx := FALSE;
+ 1633                                                 IF k = SymTab.KindProc THEN
+ 1634                                                   (* call: ArgList supplies
+ 1635                                                      the value *)
+ 1636                                                   QbeGen.CopyOp("0", q)
+ 1637                                                 ELSIF NOT QbeGen.LoadDesignator(
+ 1638                                                      mal, t, k, q) THEN
+ 1639                                                   SemError(230);
+ 1640                                                   QbeGen.CopyOp("0", q)
+ 1641                                                 END
+ 1642                                               END
+ 1643                                             ELSIF t = SymTab.InvalidType THEN
+ 1644                                             ELSIF (SymTab.ClassOf(t) #
+ 1645                                                    SymTab.ClRecord)
+ 1646   AND (SymTab.ClassOf(t) #
+ 1647                                                   SymTab.ClClass) THEN
+ 1648                                               SemError(215);
+ 1649                                               t := SymTab.InvalidType
+ 1650                                             ELSIF NOT SymTab.FieldExists(t,
+ 1651                                                      fn) THEN
+ 1652                                               SemError(216);
+ 1653                                               t := SymTab.InvalidType
+ 1654                                             ELSE
+ 1655                                               fo := SymTab.FieldOffset(t,
+ 1656                                                 fn);
+ 1657                                               t := SymTab.FieldType(t, fn);
+ 1658                                               QbeGen.FieldAddr(q, fo, qe);
+ 1659                                               (* array fields are inline:
+ 1660                                                  the field address is the
+ 1661                                                  descriptor, like records *)
+ 1662                                               QbeGen.CopyOp(qe, q);
+ 1663                                               sfx := TRUE
+ 1664                                             END; .)
+ 1665        | "^"
+ 1666                                          (. IF t = SymTab.InvalidType THEN
+ 1667                                             ELSIF SymTab.ClassOf(t) #
+ 1668                                                   SymTab.ClPtr THEN
+ 1669                                               SemError(219);
+ 1670                                               t := SymTab.InvalidType
+ 1671                                             ELSE
+ 1672                                               bt := SymTab.PtrBase(t);
+ 1673                                               IF bt = SymTab.InvalidType THEN
+ 1674                                               ELSE
+ 1675                                                 IF sfx THEN
+ 1676                                                   QbeGen.ElemLoad(q, t,
+ 1677                                                     qb);
+ 1678                                                   QbeGen.CopyOp(qb, q)
+ 1679                                                 END;
+ 1680                                                 t := bt;
+ 1681                                                 (* q holds the pointee
+ 1682                                                    address: Fact loads
+ 1683                                                    scalars/pointers and uses
+ 1684                                                    the address for
+ 1685                                                    aggregates; the VAR-actual
+ 1686                                                    note is q itself. *)
+ 1687                                                 sfx := TRUE
+ 1688                                               END
+ 1689                                             END; .) } .
+ 1690    Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1691                                          (. VAR t2: SymTab.TypeIndex;
+ 1692                                               op: INTEGER;
+ 1693                                               q2, qt, wl: QbeGen.QVal;
+ 1694                                               isR: BOOLEAN; .)
+ 1695      = SimExpr<t, q>
+ 1696        [ Rel<op> SimExpr<t2, q2>
+ 1697          (. IF op = SymTab.OpIn THEN
+ 1698               IF SymTab.InCheck(t, t2) THEN
+ 1699                 IF (t = SymTab.InvalidType)
+ 1700                    OR (t2 = SymTab.InvalidType) THEN
+ 1701                   t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
+ 1702                 ELSE
+ 1703                   QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
+ 1704                     SymTab.SetCount(t2), qt);
+ 1705                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1706                 END
+ 1707               ELSE SemError(222); t := SymTab.InvalidType;
+ 1708                 QbeGen.CopyOp("0", q)
+ 1709               END
+ 1710             ELSIF SymTab.RelCheck(t, t2, op) THEN
+ 1711               IF (t = SymTab.InvalidType)
+ 1712                  OR (t2 = SymTab.InvalidType) THEN
+ 1713                 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
+ 1714               ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
+ 1715                  OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
+ 1716                 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
+ 1717   AND (op # SymTab.OpNeq2) THEN
+ 1718                   SemError(213); t := SymTab.InvalidType;
+ 1719                   QbeGen.CopyOp("0", q)
+ 1720                 ELSE
+ 1721                   QbeGen.CmpL(op, q, q2, qt);
+ 1722                   t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1723                 END
+ 1724               ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1725                  OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1726                 QbeGen.CmpSet(op, q, q2,
+ 1727                   SymTab.SetWords(t), SymTab.SetWords(t2), qt);
+ 1728                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1729               ELSIF SymTab.StrCompat(t, t2) THEN
+ 1730                 QbeGen.StrEq(op, q, q2, qt);
+ 1731                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1732               ELSIF SymTab.IsLongFamily(t)
+ 1733                  OR SymTab.IsLongFamily(t2) THEN
+ 1734                 IF SymTab.IsIntFamily(t) THEN
+ 1735                   QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
+ 1736                 END;
+ 1737                 IF SymTab.IsIntFamily(t2) THEN
+ 1738                   QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
+ 1739                 END;
+ 1740                 QbeGen.CmpLong(op, q, q2, qt);
+ 1741                 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
+ 1742               ELSE
+ 1743                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 1744                 t := SymTab.BoolType();
+ 1745                 QbeGen.Cmp(op, q, q2, qt, isR);
+ 1746                 QbeGen.CopyOp(qt, q)
+ 1747               END
+ 1748             ELSE SemError(213); t := SymTab.InvalidType;
+ 1749               QbeGen.CopyOp("0", q)
+ 1750             END; .) ] .
+ 1751    Rel<VAR op: INTEGER>
+ 1752      = "="                               (. op := SymTab.OpEq; .)
+ 1753      | "#"                               (. op := SymTab.OpNeq1; .)
+ 1754      | "<"                               (. op := SymTab.OpLt; .)
+ 1755      | "<="                              (. op := SymTab.OpLe; .)
+ 1756      | ">"                               (. op := SymTab.OpGt; .)
+ 1757      | ">="                              (. op := SymTab.OpGe; .)
+ 1758      | "IN"                              (. op := SymTab.OpIn; .) .
+ 1759    SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1760                                          (. VAR t2, res2, lt, rt:
+ 1761                                                 SymTab.TypeIndex;
+ 1762                                               op: INTEGER;
+ 1763                                               q2, qt, wq, qf:
+ 1764                                                 QbeGen.QVal;
+ 1765                                               neg, isR, isL, folded:
+ 1766                                                 BOOLEAN;
+ 1767                                               lw, rw, mw: CARDINAL;
+ 1768                                               lTrue, lNext, lDone, qr, qs:
+ 1769                                                 QbeGen.QVal; .)
+ 1770      =                                   (. neg := FALSE; .)
+ 1771        [ "+" | "-"                       (. neg := TRUE; .) ]
+ 1772        Term<t, q>                        (. IF neg THEN
+ 1773                                             IF QbeGen.IsImm(q) THEN
+ 1774                                               QbeGen.NegFold(q, q)
+ 1775                                             ELSE QbeGen.NewTemp(qt);
+ 1776                                               QbeGen.NegQ(q, qt,
+ 1777                                                 SymTab.ClassOf(t)
+ 1778                                                 = SymTab.ClReal);
+ 1779                                               QbeGen.CopyOp(qt, q)
+ 1780                                             END
+ 1781                                           END; .)
+ 1782        { AddOp<op>                       (. IF op = SymTab.OpOr THEN
+ 1783                                               QbeGen.DelayBegin END; .)
+ 1784          Term<t2, q2>                     (. IF op = SymTab.OpOr THEN
+ 1785                                               QbeGen.DelayEnd END; .)
+ 1786          (. IF op = SymTab.OpOr THEN
+ 1787               (* short-circuit: if q is true the RHS is skipped *)
+ 1788               IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
+ 1789                 t := SymTab.BoolType()
+ 1790               ELSE SemError(212); t := SymTab.InvalidType END;
+ 1791               IF t # SymTab.InvalidType THEN
+ 1792                 QbeGen.Slot4(qs);
+ 1793                 QbeGen.NewLabel(lTrue);
+ 1794                 QbeGen.NewLabel(lNext);
+ 1795                 QbeGen.NewLabel(lDone);
+ 1796                 QbeGen.Jnz(q, lTrue, lNext);
+ 1797                 QbeGen.EmitLabel(lTrue);
+ 1798                 QbeGen.StoreW(qs, "1");
+ 1799                 QbeGen.Jmp(lDone);
+ 1800                 QbeGen.EmitLabel(lNext);
+ 1801                 QbeGen.DelayFlush;
+ 1802                 QbeGen.StoreW(qs, q2);
+ 1803                 QbeGen.Jmp(lDone);
+ 1804                 QbeGen.EmitLabel(lDone);
+ 1805                 QbeGen.LoadW(qs, qr);
+ 1806                 QbeGen.CopyOp(qr, q)
+ 1807               ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
+ 1808               END
+ 1809             ELSIF (op = SymTab.OpAdd)
+ 1810               AND (SymTab.StrCompat(t, t2)
+ 1811                 OR (SymTab.IsStrType(t)
+ 1812                   AND (SymTab.ClassOf(t2) = SymTab.ClChar))
+ 1813                 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
+ 1814                   AND SymTab.IsStrType(t2))) THEN
+ 1815               (* string concatenation; a CHAR operand becomes a
+ 1816                  1-character string literal *)
+ 1817               IF SymTab.StrCompat(t, t2) THEN
+ 1818                 QbeGen.StrCat(q, q2, qt)
+ 1819               ELSIF SymTab.IsStrType(t) THEN
+ 1820                 QbeGen.DeclCharStr(q2, qs);
+ 1821                 QbeGen.StrCat(q, qs, qt)
+ 1822               ELSE
+ 1823                 QbeGen.DeclCharStr(q, qs);
+ 1824                 QbeGen.StrCat(qs, q2, qt)
+ 1825               END;
+ 1826               t := SymTab.NewStr();
+ 1827               QbeGen.CopyOp(qt, q)
+ 1828             ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
+ 1829   AND (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1830   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1831               lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
+ 1832               mw := lw;
+ 1833               IF rw > mw THEN mw := rw END;
+ 1834               IF op = SymTab.OpAdd THEN
+ 1835                 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
+ 1836               ELSE
+ 1837                 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
+ 1838               END;
+ 1839               t := SymTab.NewSet(
+ 1840                      SymTab.NewSubR(0,
+ 1841                        VAL(INTEGER, mw) * 32 - 1));
+ 1842               QbeGen.CopyOp(qt, q)
+ 1843             ELSE
+ 1844               IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
+ 1845                 lt := t; rt := t2; t := res2
+ 1846               ELSE SemError(211); t := SymTab.InvalidType END;
+ 1847               IF t # SymTab.InvalidType THEN
+ 1848                 isL := SymTab.IsLongFamily(t);
+ 1849                 isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 1850                 folded := FALSE;
+ 1851                 IF (NOT isL) AND (NOT isR)
+ 1852    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
+ 1853                   IF op = SymTab.OpAdd THEN
+ 1854                     folded := QbeGen.Fold2(0, q, q2, qf)
+ 1855                   ELSE
+ 1856                     folded := QbeGen.Fold2(1, q, q2, qf)
+ 1857                   END
+ 1858                 END;
+ 1859                 IF folded THEN QbeGen.CopyOp(qf, q)
+ 1860                 ELSE
+ 1861                 IF isL THEN
+ 1862                   IF SymTab.IsIntFamily(lt) THEN
+ 1863                     QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
+ 1864                   END;
+ 1865                   IF SymTab.IsIntFamily(rt) THEN
+ 1866                     QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
+ 1867                   END;
+ 1868                   QbeGen.NewTemp(qt);
+ 1869                   IF op = SymTab.OpAdd THEN
+ 1870                     QbeGen.Op3L("add", qt, q, q2)
+ 1871                   ELSE
+ 1872                     QbeGen.Op3L("sub", qt, q, q2)
+ 1873                   END
+ 1874                 ELSE
+ 1875                   QbeGen.NewTemp(qt);
+ 1876                   IF op = SymTab.OpAdd THEN
+ 1877                     QbeGen.Op3("add", qt, q, q2, isR)
+ 1878                   ELSE
+ 1879                     QbeGen.Op3("sub", qt, q, q2, isR)
+ 1880                   END
+ 1881                 END;
+ 1882                 QbeGen.CopyOp(qt, q)
+ 1883                 END
+ 1884               ELSE QbeGen.CopyOp("0", q)
+ 1885               END
+ 1886             END; .) } .
+ 1887    AddOp<VAR op: INTEGER>
+ 1888      = "+"                               (. op := SymTab.OpAdd; .)
+ 1889      | "-"                               (. op := SymTab.OpSub; .)
+ 1890      | "OR"                              (. op := SymTab.OpOr; .) .
+ 1891    Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 1892                                          (. VAR t2, res2, lt, rt:
+ 1893                                                 SymTab.TypeIndex;
+ 1894                                               op: INTEGER;
+ 1895                                               q2, qt, wq, qf:
+ 1896                                                 QbeGen.QVal;
+ 1897                                               isR, isL, folded: BOOLEAN;
+ 1898                                               lw, rw, mw: CARDINAL;
+ 1899                                               lNext, lFalse, lDone, qr, qs:
+ 1900                                                 QbeGen.QVal; .)
+ 1901      = Fact<t, q> { MulOp<op>            (. IF op = SymTab.OpAnd THEN
+ 1902                                               QbeGen.DelayBegin END; .)
+ 1903          Fact<t2, q2>                    (. IF op = SymTab.OpAnd THEN
+ 1904                                               QbeGen.DelayEnd END; .)
+ 1905        (. IF op = SymTab.OpAnd THEN
+ 1906             (* short-circuit: if q is false the RHS is skipped *)
+ 1907             IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
+ 1908               t := SymTab.BoolType()
+ 1909             ELSE SemError(212); t := SymTab.InvalidType END;
+ 1910             IF t # SymTab.InvalidType THEN
+ 1911               QbeGen.Slot4(qs);
+ 1912               QbeGen.NewLabel(lNext);
+ 1913               QbeGen.NewLabel(lFalse);
+ 1914               QbeGen.NewLabel(lDone);
+ 1915               QbeGen.Jnz(q, lNext, lFalse);
+ 1916               QbeGen.EmitLabel(lNext);
+ 1917               QbeGen.DelayFlush;
+ 1918               QbeGen.StoreW(qs, q2);
+ 1919               QbeGen.Jmp(lDone);
+ 1920               QbeGen.EmitLabel(lFalse);
+ 1921               QbeGen.StoreW(qs, "0");
+ 1922               QbeGen.Jmp(lDone);
+ 1923               QbeGen.EmitLabel(lDone);
+ 1924               QbeGen.LoadW(qs, qr);
+ 1925               QbeGen.CopyOp(qr, q)
+ 1926             ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
+ 1927             END
+ 1928           ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
+ 1929   AND (SymTab.ClassOf(t) = SymTab.ClSet)
+ 1930   AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
+ 1931             lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
+ 1932             mw := lw;
+ 1933             IF rw > mw THEN mw := rw END;
+ 1934             IF op = SymTab.OpTimes THEN
+ 1935               QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
+ 1936             ELSE
+ 1937               QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
+ 1938             END;
+ 1939             t := SymTab.NewSet(
+ 1940                    SymTab.NewSubR(0,
+ 1941                      VAL(INTEGER, mw) * 32 - 1));
+ 1942             QbeGen.CopyOp(qt, q)
+ 1943           ELSE
+ 1944             IF SymTab.ArithCheck(t, t2,
+ 1945                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+ 1946                  res2) THEN
+ 1947               lt := t; rt := t2; t := res2
+ 1948             ELSE SemError(211); t := SymTab.InvalidType END;
+ 1949             IF t # SymTab.InvalidType THEN
+ 1950               isL := SymTab.IsLongFamily(t);
+ 1951               isR := SymTab.ClassOf(t) = SymTab.ClReal;
+ 1952               folded := FALSE;
+ 1953               IF (NOT isL) AND (NOT isR)
+ 1954    AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
+ 1955                 IF op = SymTab.OpTimes THEN
+ 1956                   folded := QbeGen.Fold2(2, q, q2, qf)
+ 1957                 ELSIF op = SymTab.OpDiv THEN
+ 1958                   folded := QbeGen.Fold2(3, q, q2, qf)
+ 1959                 ELSIF op = SymTab.OpMod THEN
+ 1960                   folded := QbeGen.Fold2(4, q, q2, qf)
+ 1961                 END
+ 1962               END;
+ 1963               IF folded THEN QbeGen.CopyOp(qf, q)
+ 1964               ELSE
+ 1965               IF isL THEN
+ 1966                 IF SymTab.IsIntFamily(lt) THEN
+ 1967                   QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
+ 1968                 END;
+ 1969                 IF SymTab.IsIntFamily(rt) THEN
+ 1970                   QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
+ 1971                 END;
+ 1972                 QbeGen.NewTemp(qt);
+ 1973                 IF op = SymTab.OpTimes THEN
+ 1974                   QbeGen.Op3L("mul", qt, q, q2)
+ 1975                 ELSIF (op = SymTab.OpDiv)
+ 1976                    OR (op = SymTab.OpSlash) THEN
+ 1977                   QbeGen.Op3L("div", qt, q, q2)
+ 1978                 ELSE
+ 1979                   QbeGen.Op3L("rem", qt, q, q2)
+ 1980                 END
+ 1981               ELSE
+ 1982                 QbeGen.NewTemp(qt);
+ 1983                 IF op = SymTab.OpTimes THEN
+ 1984                   QbeGen.Op3("mul", qt, q, q2, isR)
+ 1985                 ELSIF (op = SymTab.OpDiv)
+ 1986                    OR (op = SymTab.OpSlash) THEN
+ 1987                   QbeGen.Op3("div", qt, q, q2, isR)
+ 1988                 ELSE
+ 1989                   QbeGen.Op3("rem", qt, q, q2, isR)
+ 1990                 END
+ 1991               END;
+ 1992               QbeGen.CopyOp(qt, q)
+ 1993               END
+ 1994             ELSE QbeGen.CopyOp("0", q)
+ 1995             END
+ 1996           END; .) } .
+ 1997    MulOp<VAR op: INTEGER>
+ 1998      = "*"                               (. op := SymTab.OpTimes; .)
+ 1999      | "/"                               (. op := SymTab.OpSlash; .)
+ 2000      | "DIV"                             (. op := SymTab.OpDiv; .)
+ 2001      | "MOD"                             (. op := SymTab.OpMod; .)
+ 2002      | ( "AND" | "&" )                   (. op := SymTab.OpAnd; .) .
+ 2003    Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2004                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
+ 2005                                               et, dt, t2, st, ct2:
+ 2006                                                 SymTab.TypeIndex;
+ 2007                                               dk: INTEGER;
+ 2008                                               qd, q2, sq, qa, qm0, qr:
+ 2009                                                 QbeGen.QVal;
+ 2010                                               qn, vn: SymTab.Name;
+ 2011                                               vt: SymTab.TypeIndex;
+ 2012                                               c1, c2: INTEGER;
+ 2013                                               called, isHigh, sfx, isCh,
+ 2014                                               isU, uok, isStr: BOOLEAN;
+ 2015                                               ucp: INTEGER; .)
+ 2016      = integer                           (. LexString(s);
+ 2017                                             QbeGen.NormInt(s, q);
+ 2018                                             t := SymTab.IntType(); .)
+ 2019      | charConst                         (. LexString(s);
+ 2020                                             QbeGen.NormLit(s, q, isCh);
+ 2021                                             t := SymTab.CharType(); .)
+ 2022      | real                              (. LexString(s);
+ 2023                                             QbeGen.NormReal(s, q);
+ 2024                                             t := SymTab.RealType(); .)
+ 2025      | string                            (. LexString(s);
+ 2026                                             IF SymTab.StrLen(s) = 3 THEN
+ 2027                                               t := SymTab.CharType();
+ 2028                                               QbeGen.IntStr(
+ 2029                                                 QbeGen.CharVal(s), q)
+ 2030                                             ELSE t := SymTab.NewStr();
+ 2031                                               QbeGen.DeclStr(s, q);
+ 2032                                               (* a literal's value IS its
+ 2033                                                  static descriptor address *)
+ 2034                                               QbeGen.NoteAddr(q, q)
+ 2035                                             END; .)
+ 2036      | ustring                           (. LexString(s);
+ 2037                                             QbeGen.DeclUStr(s, q, isU, ucp,
+ 2038                                               uok);
+ 2039                                             IF NOT uok THEN
+ 2040                                               SemError(234);
+ 2041                                               t := SymTab.InvalidType
+ 2042                                             ELSIF isU THEN
+ 2043                                               t := SymTab.UCharType();
+ 2044                                               QbeGen.IntStr(ucp, q)
+ 2045                                             ELSE
+ 2046                                               t := SymTab.NewUStr();
+ 2047                                               QbeGen.NoteAddr(q, q)
+ 2048                                             END; .)
+ 2049      | Design<dt, dk, qd, qn, sfx>       (. called := FALSE;
+ 2050                                             t := dt;
+ 2051                                             IF sfx THEN
+ 2052                                               IF dt =
+ 2053                                                  SymTab.InvalidType THEN
+ 2054                                                 QbeGen.CopyOp("0", q)
+ 2055                                               ELSIF (SymTab.ClassOf(dt) =
+ 2056                                                      SymTab.ClRecord)
+ 2057                                                  OR (SymTab.ClassOf(dt) =
+ 2058                                                      SymTab.ClSet)
+ 2059                                                  OR (SymTab.ClassOf(dt) =
+ 2060                                                      SymTab.ClArray)
+ 2061                                                  OR (SymTab.ClassOf(dt) =
+ 2062                                                      SymTab.ClClass) THEN
+ 2063                                                 QbeGen.CopyOp(qd, q)
+ 2064                                               ELSE QbeGen.ElemLoad(qd, dt,
+ 2065                                                 q)
+ 2066                                               END
+ 2067                                             ELSE QbeGen.CopyOp(qd, q)
+ 2068                                             END;
+ 2069                                             IF (dk = SymTab.KindVar)
+ 2070                                                OR (dk = SymTab.KindParam)
+ 2071                                                OR (dk =
+ 2072                                                   SymTab.KindField) THEN
+ 2073                                               IF sfx THEN
+ 2074                                                 QbeGen.NoteAddr(q, qd)
+ 2075                                               ELSE
+ 2076                                                 QbeGen.AddrOf(qn, qa);
+ 2077                                                 QbeGen.NoteAddr(q, qa)
+ 2078                                               END
+ 2079                                             ELSIF sfx
+ 2080   AND (dt #
+ 2081                                                   SymTab.InvalidType)
+ 2082   AND ((SymTab.ClassOf(dt) =
+ 2083                                                    SymTab.ClArray)
+ 2084                                                   OR (SymTab.ClassOf(dt) =
+ 2085                                                       SymTab.ClSet)
+ 2086                                                   OR (SymTab.ClassOf(dt) =
+ 2087                                                       SymTab.ClRecord)) THEN
+ 2088                                               QbeGen.NoteAddr(qd, qd)
+ 2089                                             END; .)
+ 2090        [ TypedSetLit<dt, q>              (. t := dt; .) ]
+ 2091        [ ArgList<qn, dt, qd, TRUE, ct2, q2, called>
+ 2092                                          (. t := ct2;
+ 2093                                             QbeGen.CopyOp(q2, q); .) ]
+ 2094                                          (. IF NOT called
+ 2095   AND (dk = SymTab.KindProc) THEN
+ 2096                                               (* bare zero-arg function
+ 2097                                                  call (parentheses may be
+ 2098                                                  omitted); a proper or
+ 2099                                                  parameterised proc here
+ 2100                                                  is 230 *)
+ 2101                                               IF (SymTab.ProcNPar(qn) = 0)
+ 2102   AND (SymTab.ProcRes(qn) #
+ 2103                                                     SymTab.InvalidType) THEN
+ 2104                                                 QbeGen.Mangled(qn,
+ 2105                                                   SymTab.ProcUid(qn), qm0);
+ 2106                                                 QbeGen.CallBegin(qm0,
+ 2107                                                   SymTab.ProcRes(qn),
+ 2108                                                   SymTab.ProcDepthOf(qn),
+ 2109                                                   SymTab.IsExternal(qn));
+ 2110                                                 QbeGen.CallEnd(TRUE, q);
+ 2111                                                 t := SymTab.ProcRes(qn)
+ 2112                                               ELSE
+ 2113                                                 (* procedure used as a
+ 2114                                                    value (assign to a
+ 2115                                                    procedure variable):
+ 2116                                                    its code address *)
+ 2117                                                 t := SymTab.ProcTypeOf(qn);
+ 2118                                                 QbeGen.Mangled(qn,
+ 2119                                                   SymTab.ProcUid(qn), qm0);
+ 2120                                                 QbeGen.ProcAddr(qm0, q)
+ 2121                                               END
+ 2122                                             END; .)
+ 2123      | ( "HIGH"                          (. isHigh := TRUE; .)
+ 2124        | ( "LEN" | "LENGTH" )            (. isHigh := FALSE; .) )
+ 2125        "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE; .)
+ 2126            | string                       (. LexString(s);
+ 2127                                              isStr := TRUE;
+ 2128                                              IF SymTab.StrLen(s) = 3 THEN
+ 2129                                                dt := SymTab.CharType();
+ 2130                                                QbeGen.IntStr(QbeGen.CharVal(s),
+ 2131                                                  qd)
+ 2132                                              ELSE
+ 2133                                                dt := SymTab.NewStr();
+ 2134                                                QbeGen.DeclStr(s, qd);
+ 2135                                                QbeGen.NoteAddr(qd, qd)
+ 2136                                              END;
+ 2137                                              dk := -1;
+ 2138                                              qn[0] := CHR(0); .) )
+ 2139        ")"
+ 2140                                          (. IF isStr THEN
+ 2141                                               (* fold: content length at
+ 2142                                                  compile time *)
+ 2143                                               IF SymTab.StrLen(s) = 3 THEN
+ 2144                                                 c1 := 1
+ 2145                                               ELSE
+ 2146                                                 c1 :=
+ 2147                                                   SymTab.StrLen(s) - 2
+ 2148                                               END;
+ 2149                                               IF isHigh THEN
+ 2150                                                 DEC(c1)
+ 2151                                               END;
+ 2152                                               QbeGen.IntStr(c1, qr);
+ 2153                                               t := SymTab.IntType();
+ 2154                                               QbeGen.CopyOp(qr, q)
+ 2155                                             ELSIF dt = SymTab.InvalidType THEN
+ 2156                                               t := SymTab.InvalidType;
+ 2157                                               QbeGen.CopyOp("0", q)
+ 2158                                             ELSIF SymTab.ClassOf(dt) #
+ 2159                                                   SymTab.ClArray THEN
+ 2160                                               SemError(217);
+ 2161                                               t := SymTab.InvalidType;
+ 2162                                               QbeGen.CopyOp("0", q)
+ 2163                                             ELSE
+ 2164                                               IF isHigh THEN
+ 2165                                                 IF SymTab.IsOpenArray(dt) THEN
+ 2166                                                   QbeGen.OpenHi(qd, qr)
+ 2167                                                 ELSE
+ 2168                                                   QbeGen.IntStr(
+ 2169                                                     SymTab.ArrayHi(dt), qr)
+ 2170                                                 END
+ 2171                                               ELSE
+ 2172                                                 IF SymTab.IsOpenArray(dt) THEN
+ 2173                                                   QbeGen.LoadCount(qd, qr)
+ 2174                                                 ELSE
+ 2175                                                   QbeGen.IntStr(VAL(
+ 2176                                                     INTEGER,
+ 2177                                                     SymTab.ArrayLen(dt)),
+ 2178                                                     qr)
+ 2179                                                 END
+ 2180                                               END;
+ 2181                                                t := SymTab.IntType();
+ 2182                                                QbeGen.CopyOp(qr, q)
+ 2183                                              END; .)
+ 2184      | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
+ 2185                                          (. IF dt = SymTab.InvalidType THEN
+ 2186                                               t := SymTab.InvalidType;
+ 2187                                               QbeGen.CopyOp("0", q)
+ 2188                                             ELSE
+ 2189                                               QbeGen.IntStr(VAL(INTEGER,
+ 2190                                                 SymTab.ObjectSize(dt)), q);
+ 2191                                               t := SymTab.IntType()
+ 2192                                             END; .)
+ 2193      | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
+ 2194                                          (. IF dt = SymTab.InvalidType THEN
+ 2195                                               t := SymTab.InvalidType;
+ 2196                                               QbeGen.CopyOp("0", q)
+ 2197                                             ELSE
+ 2198                                               IF sfx THEN
+ 2199                                                 QbeGen.CopyOp(qd, q)
+ 2200                                               ELSIF (dk = SymTab.KindVar)
+ 2201                                                  OR (dk = SymTab.KindParam) THEN
+ 2202                                                 QbeGen.AddrOf(qn, q)
+ 2203                                               ELSE SemError(230);
+ 2204                                                 QbeGen.CopyOp("0", q)
+ 2205                                               END;
+ 2206                                               t := SymTab.AddrType()
+ 2207                                             END; .)
+ 2208      | "CHR" "(" Expr<et, q> ")"
+ 2209                                          (. IF (et # SymTab.InvalidType)
+ 2210   AND NOT SymTab.IsIntFamily(et) THEN
+ 2211                                               SemError(211) END;
+ 2212                                             t := SymTab.CharType(); .)
+ 2213      | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
+ 2214                                          (. IF et # SymTab.InvalidType THEN
+ 2215                                               IF (SymTab.ClassOf(et) #
+ 2216                                                   SymTab.ClChar)
+ 2217   AND (SymTab.ClassOf(et) #
+ 2218                                                     SymTab.ClBool)
+ 2219   AND (SymTab.ClassOf(et) #
+ 2220                                                     SymTab.ClEnum)
+ 2221   AND NOT SymTab.IsIntFamily(et) THEN
+ 2222                                                 SemError(211) END
+ 2223                                             END;
+ 2224                                             t := SymTab.IntType(); .)
+ 2225      | "CAP" "(" Expr<et, q> ")"
+ 2226                                          (. QbeGen.CapQ(q, qa);
+ 2227                                             QbeGen.CopyOp(qa, q);
+ 2228                                             t := SymTab.CharType(); .)
+ 2229      | "UCHR" "(" Expr<et, q> ")"
+ 2230                                          (. (* UCHR: the UCHAR constructor.
+ 2231                                                CHAR -> UCHAR (identity);
+ 2232                                                INTEGER familly -> UCHAR
+ 2233                                                (codepoint value). *)
+ 2234                                             IF (et # SymTab.InvalidType)
+ 2235    AND (SymTab.ClassOf(et) # SymTab.ClChar)
+ 2236    AND NOT SymTab.IsIntFamily(et) THEN
+ 2237                                               SemError(211) END;
+ 2238                                             t := SymTab.UCharType(); .)
+ 2239      | "CHR8" "(" Expr<et, q> ")"
+ 2240                                          (. IF (et # SymTab.InvalidType)
+ 2241    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
+ 2242                                               SemError(211) END;
+ 2243                                             QbeGen.WidenLong(q, qa);
+ 2244                                             QbeGen.CheckRange(qa, "0", "255");
+ 2245                                             t := SymTab.CharType(); .)
+ 2246      | "UORD" "(" Expr<et, q> ")"
+ 2247                                          (. (* UORD(u): the codepoint as a
+ 2248                                                32-bit ordinal (INTEGER),
+ 2249                                                cf. ORD for CHAR. *)
+ 2250                                             IF (et # SymTab.InvalidType)
+ 2251    AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
+ 2252                                               SemError(211) END;
+ 2253                                             t := SymTab.IntType(); .)
+ 2254      | "ABS" "(" Expr<et, q> ")"
+ 2255                                          (. IF (et # SymTab.InvalidType)
+ 2256   AND NOT SymTab.IsIntFamily(et)
+ 2257   AND (SymTab.ClassOf(et) #
+ 2258                                                  SymTab.ClReal) THEN
+ 2259                                               SemError(211)
+ 2260                                             ELSE QbeGen.AbsQ(q, qa,
+ 2261                                                    SymTab.ClassOf(et) =
+ 2262                                                      SymTab.ClReal);
+ 2263                                               QbeGen.CopyOp(qa, q)
+ 2264                                             END;
+ 2265                                             t := et; .)
+ 2266      | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
+ 2267                                          (. IF NOT SymTab.Lookup(vn) THEN
+ 2268                                               SemError(201);
+ 2269                                               t := SymTab.InvalidType
+ 2270                                             ELSE vt := SymTab.SymType(vn);
+ 2271                                               IF vt = SymTab.InvalidType THEN
+ 2272                                                 t := SymTab.InvalidType
+ 2273                                               ELSIF et =
+ 2274                                                  SymTab.InvalidType THEN
+ 2275                                                 t := vt
+ 2276                                               ELSE
+ 2277                                                 c1 := SymTab.ClassOf(et);
+ 2278                                                 c2 := SymTab.ClassOf(vt);
+ 2279                                                 IF ((c1 = SymTab.ClInt)
+ 2280                                                     OR (c1 =
+ 2281                                                        SymTab.ClChar)
+ 2282                                                     OR (c1 =
+ 2283                                                        SymTab.ClBool)
+ 2284                                                     OR (c1 =
+ 2285                                                        SymTab.ClEnum))
+ 2286   AND ((c2 = SymTab.ClInt)
+ 2287                                                     OR (c2 =
+ 2288                                                        SymTab.ClChar)
+ 2289                                                     OR (c2 =
+ 2290                                                        SymTab.ClBool)
+ 2291                                                     OR (c2 =
+ 2292                                                        SymTab.ClEnum)) THEN
  2293                                                   t := vt
- 2294                                                 ELSE SemError(230);
- 2295                                                   t := SymTab.InvalidType
- 2296                                                 END
- 2297                                               END
- 2298                                             END; .)
- 2299      | "(" Expr<et, q> ")"               (. t := et; .)
- 2300      | SetLit<st, sq>                    (. t := st;
- 2301                                             QbeGen.CopyOp(sq, q); .)
- 2302      | ( "NOT" | "~" ) Fact<t2, q2>      (. IF SymTab.BoolCheck(t2) THEN
- 2303                                               t := SymTab.BoolType()
- 2304                                             ELSE SemError(212);
- 2305                                               t := SymTab.InvalidType END;
- 2306                                             IF t # SymTab.InvalidType THEN
- 2307                                               QbeGen.NotQ(q2, q)
- 2308                                             ELSE QbeGen.CopyOp("0", q)
- 2309                                             END; .) .
- 2310    (* Set literals are SET OF [0..255] (8 words); elements validated
- 2311       0..255 statically when foldable (222 otherwise), runtime trap
- 2312       for computed elements. Ranges always lower via SetRange. *)
- 2313    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2314      = "{"                               (. t := SymTab.NewSet(
- 2315                                               SymTab.NewSubR(0, 255));
- 2316                                             QbeGen.NewSetTemp(8, q);
- 2317                                             QbeGen.SetZero(q, 8); .)
- 2318        [ SetElem<t, q> { "," SetElem<t, q> } ]
- 2319        "}" .
- 2320    (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
- 2321       BITSET{}.  The declared type (not SET OF [0..255]) sets the
- 2322       width and element span. *)
- 2323    TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2324                                          (. VAR nw: CARDINAL; .)
- 2325      = "{"                               (. IF SymTab.ClassOf(vt) #
- 2326                                                SymTab.ClSet THEN
- 2327                                               SemError(230); nw := 8
- 2328                                             ELSE nw := SymTab.SetWords(vt);
- 2329                                               IF nw = 0 THEN nw := 8 END
- 2330                                             END;
- 2331                                             QbeGen.NewSetTemp(nw, q);
- 2332                                             QbeGen.SetZero(q, nw); .)
- 2333        [ SetElem<vt, q> { "," SetElem<vt, q> } ]
- 2334        "}" .
- 2335    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
- 2336                                               qe, q2: QbeGen.QVal;
- 2337                                               v, v2: INTEGER;
- 2338                                               lo: INTEGER;
- 2339                                               span: CARDINAL;
- 2340                                               cl, cl2: INTEGER;
- 2341                                               hasR: BOOLEAN; .)
- 2342      =                                   (. hasR := FALSE; .)
- 2343        Expr<et, qe>
- 2344        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
- 2345                                          (. lo := SymTab.SetBaseLo(st);
- 2346                                             span := SymTab.SetCount(st);
- 2347                                             IF (et = SymTab.InvalidType)
- 2348                                                OR (hasR AND (et2 =
- 2349                                                   SymTab.InvalidType)) THEN
- 2350                                             ELSE cl :=
- 2351                                                    SymTab.ClassOf(et);
- 2352                                               IF hasR THEN
- 2353                                                 cl2 :=
- 2354                                                   SymTab.ClassOf(et2)
- 2355                                               ELSE cl2 := SymTab.ClInt
- 2356                                               END;
- 2357                                               IF ((cl # SymTab.ClInt)
- 2358   AND (cl # SymTab.ClChar)
- 2359   AND (cl # SymTab.ClBool))
- 2360                                                  OR (hasR AND 
- 2361                                                     ((cl2
- 2362                                                       # SymTab.ClInt)
- 2363   AND (cl2
- 2364                                                        # SymTab.ClChar)
- 2365   AND (cl2
- 2366                                                        # SymTab.ClBool))) THEN
- 2367                                                 SemError(222)
- 2368                                               ELSIF hasR
- 2369   AND SymTab.ConstInt(qe, v)
- 2370   AND SymTab.ConstInt(q2,
- 2371                                                     v2)
- 2372   AND ((v < lo)
- 2373                                                     OR (v2 < lo)
- 2374                                                     OR (v >= lo +
- 2375                                                        VAL(INTEGER, span))
- 2376                                                     OR (v2 >= lo +
- 2377                                                        VAL(INTEGER, span))
- 2378                                                     OR (v > v2)) THEN
- 2379                                                 SemError(222)
- 2380                                                ELSIF hasR THEN
- 2381                                                  QbeGen.SetRange(sq, qe, q2,
- 2382                                                    lo, span)
- 2383                                                ELSIF SymTab.ConstInt(qe,
- 2384                                                        v)
- 2385   AND ((v < lo)
- 2386                                                      OR (v >= lo +
- 2387                                                         VAL(INTEGER,
- 2388                                                           span))) THEN
- 2389                                                  SemError(222)
- 2390                                                ELSE QbeGen.SetBit(sq, qe,
- 2391                                                  lo, span)
- 2392                                               END
- 2393                                             END; .) .
- 2394    GetIdent<VAR n: SymTab.Name>
- 2395      = ident                             (. LexName(n); .) .
- 2396  
- 2397  END M2.
+ 2294                                                 ELSIF (c1 = SymTab.ClPtr)
+ 2295   AND (c2 = SymTab.ClPtr) THEN
+ 2296                                                   t := vt
+ 2297                                                 ELSIF (c1 = SymTab.ClReal)
+ 2298   AND (c2 = SymTab.ClReal) THEN
+ 2299                                                   t := vt
+ 2300                                                 ELSE SemError(230);
+ 2301                                                   t := SymTab.InvalidType
+ 2302                                                 END
+ 2303                                               END
+ 2304                                             END; .)
+ 2305      | "(" Expr<et, q> ")"               (. t := et; .)
+ 2306      | SetLit<st, sq>                    (. t := st;
+ 2307                                             QbeGen.CopyOp(sq, q); .)
+ 2308      | ( "NOT" | "~" ) Fact<t2, q2>      (. IF SymTab.BoolCheck(t2) THEN
+ 2309                                               t := SymTab.BoolType()
+ 2310                                             ELSE SemError(212);
+ 2311                                               t := SymTab.InvalidType END;
+ 2312                                             IF t # SymTab.InvalidType THEN
+ 2313                                               QbeGen.NotQ(q2, q)
+ 2314                                             ELSE QbeGen.CopyOp("0", q)
+ 2315                                             END; .) .
+ 2316    (* Set literals are SET OF [0..255] (8 words); elements validated
+ 2317       0..255 statically when foldable (222 otherwise), runtime trap
+ 2318       for computed elements. Ranges always lower via SetRange. *)
+ 2319    SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2320      = "{"                               (. t := SymTab.NewSet(
+ 2321                                               SymTab.NewSubR(0, 255));
+ 2322                                             QbeGen.NewSetTemp(8, q);
+ 2323                                             QbeGen.SetZero(q, 8); .)
+ 2324        [ SetElem<t, q> { "," SetElem<t, q> } ]
+ 2325        "}" .
+ 2326    (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
+ 2327       BITSET{}.  The declared type (not SET OF [0..255]) sets the
+ 2328       width and element span. *)
+ 2329    TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
+ 2330                                          (. VAR nw: CARDINAL; .)
+ 2331      = "{"                               (. IF SymTab.ClassOf(vt) #
+ 2332                                                SymTab.ClSet THEN
+ 2333                                               SemError(230); nw := 8
+ 2334                                             ELSE nw := SymTab.SetWords(vt);
+ 2335                                               IF nw = 0 THEN nw := 8 END
+ 2336                                             END;
+ 2337                                             QbeGen.NewSetTemp(nw, q);
+ 2338                                             QbeGen.SetZero(q, nw); .)
+ 2339        [ SetElem<vt, q> { "," SetElem<vt, q> } ]
+ 2340        "}" .
+ 2341    SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal>         (. VAR et, et2: SymTab.TypeIndex;
+ 2342                                               qe, q2: QbeGen.QVal;
+ 2343                                               v, v2: INTEGER;
+ 2344                                               lo: INTEGER;
+ 2345                                               span: CARDINAL;
+ 2346                                               cl, cl2: INTEGER;
+ 2347                                               hasR: BOOLEAN; .)
+ 2348      =                                   (. hasR := FALSE; .)
+ 2349        Expr<et, qe>
+ 2350        [ ".." Expr<et2, q2>              (. hasR := TRUE; .) ]
+ 2351                                          (. lo := SymTab.SetBaseLo(st);
+ 2352                                             span := SymTab.SetCount(st);
+ 2353                                             IF (et = SymTab.InvalidType)
+ 2354                                                OR (hasR AND (et2 =
+ 2355                                                   SymTab.InvalidType)) THEN
+ 2356                                             ELSE cl :=
+ 2357                                                    SymTab.ClassOf(et);
+ 2358                                               IF hasR THEN
+ 2359                                                 cl2 :=
+ 2360                                                   SymTab.ClassOf(et2)
+ 2361                                               ELSE cl2 := SymTab.ClInt
+ 2362                                               END;
+ 2363                                               IF ((cl # SymTab.ClInt)
+ 2364   AND (cl # SymTab.ClChar)
+ 2365   AND (cl # SymTab.ClBool))
+ 2366                                                  OR (hasR AND 
+ 2367                                                     ((cl2
+ 2368                                                       # SymTab.ClInt)
+ 2369   AND (cl2
+ 2370                                                        # SymTab.ClChar)
+ 2371   AND (cl2
+ 2372                                                        # SymTab.ClBool))) THEN
+ 2373                                                 SemError(222)
+ 2374                                               ELSIF hasR
+ 2375   AND SymTab.ConstInt(qe, v)
+ 2376   AND SymTab.ConstInt(q2,
+ 2377                                                     v2)
+ 2378   AND ((v < lo)
+ 2379                                                     OR (v2 < lo)
+ 2380                                                     OR (v >= lo +
+ 2381                                                        VAL(INTEGER, span))
+ 2382                                                     OR (v2 >= lo +
+ 2383                                                        VAL(INTEGER, span))
+ 2384                                                     OR (v > v2)) THEN
+ 2385                                                 SemError(222)
+ 2386                                                ELSIF hasR THEN
+ 2387                                                  QbeGen.SetRange(sq, qe, q2,
+ 2388                                                    lo, span)
+ 2389                                                ELSIF SymTab.ConstInt(qe,
+ 2390                                                        v)
+ 2391   AND ((v < lo)
+ 2392                                                      OR (v >= lo +
+ 2393                                                         VAL(INTEGER,
+ 2394                                                           span))) THEN
+ 2395                                                  SemError(222)
+ 2396                                                ELSE QbeGen.SetBit(sq, qe,
+ 2397                                                  lo, span)
+ 2398                                               END
+ 2399                                             END; .) .
+ 2400    GetIdent<VAR n: SymTab.Name>
+ 2401      = ident                             (. LexName(n); .) .
+ 2402  
+ 2403  END M2.
 
     0 errors
 

+ 11 - 4
compiler/src/SymTab.def

@@ -78,8 +78,11 @@ PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
    (used for VAR identifier lists whose type is parsed afterwards).
    Returns FALSE on duplicate (entry not recorded). *)
 
-PROCEDURE FixPending (t: TypeIndex);
-(* Assigns type t to all pending entries, clears the buffer. *)
+PROCEDURE FixPending (t: TypeIndex) : BOOLEAN;
+(* Assigns type t to all pending entries, clears the buffer, and
+   returns TRUE.  When the current heading resumed a DEFINITION, the
+   just-typed formals are compared against the snapshot (strict 231):
+   FALSE = mismatch. *)
 
 PROCEDURE PendCount (): CARDINAL;
 (* Number of entries currently waiting for FixPending. *)
@@ -148,8 +151,12 @@ PROCEDURE EnterParam (name: ARRAY OF CHAR; isVar: BOOLEAN): BOOLEAN;
 (* Enters a KindParam in the heading scope and chains it into the
    current procedure's positional param list. FALSE on duplicate. *)
 
-PROCEDURE SetProcRes (t: TypeIndex);
-(* Sets the current procedure's result type (InvalidType = none). *)
+PROCEDURE SetProcRes (t: TypeIndex) : BOOLEAN;
+(* Sets the current procedure's result type (InvalidType = none) and
+   returns TRUE.  When the heading resumed a DEFINITION
+   (ResumeProc), it also performs the strict-231 signature check
+   (result, formal count, formal types, VAR-ness) and returns the
+   outcome; FALSE means the implementation does not match. *)
 
 PROCEDURE ProcRes (name: ARRAY OF CHAR): TypeIndex;
 (* Result type of the named procedure, InvalidType if absent/none. *)

+ 159 - 39
compiler/src/SymTab.mod

@@ -17,6 +17,11 @@ CONST
   FClass = 13; FOpenArr = 14; FNil = 15; FLong = 16; FProc = 17;
   FUChar = 18; FUStr = 19;
 
+  (* signatures compared by the strict 231 check are bounded to this many
+     formals (self-hosting uses far fewer). *)
+  MaxSnap = 16;
+  HighSnap = MaxSnap - 1;
+
 TYPE
   SymPtr = POINTER TO SymNode;
   ScopePtr = POINTER TO ScopeNode;
@@ -34,6 +39,11 @@ TYPE
     fwd   : BOOLEAN;    (* KindProc: FORWARD body pending *)
     virt  : BOOLEAN;    (* KindProc: VIRTUAL method *)
     fdep  : CARDINAL;   (* KindProc: lexical function-nesting depth *)
+    snapRes : TypeIndex;  (* KindProc: DEFINITION result (ResumeProc) *)
+    snapT : ARRAY [0 .. MaxSnap - 1] OF TypeIndex;  (* DEF formal types *)
+    snapV : ARRAY [0 .. MaxSnap - 1] OF BOOLEAN;    (* DEF formal VARs *)
+    nSnap : CARDINAL;   (* KindProc: number of snapshot formals *)
+    fsnap : BOOLEAN;    (* KindProc: signature snapshotted, compare *)
     ext   : BOOLEAN;    (* KindProc: EXTERNAL (no body emitted) *)
     link  : Name;       (* KindProc: external link (C) name *)
     sym   : Name;       (* base symbol name (differs from name for
@@ -83,6 +93,8 @@ VAR
   nTypes : CARDINAL;
   curProc : SymPtr;   (* heading being declared *)
   curPTail : SymPtr;  (* positional param chain tail *)
+  snapT : ARRAY [0 .. 15] OF TypeIndex;  (* signature snapshot scratch *)
+  snapV : ARRAY [0 .. 15] OF BOOLEAN;
   procStk : ARRAY [0 .. 15] OF SymPtr;
   nProc : CARDINAL;
   nextUid : CARDINAL;
@@ -255,6 +267,7 @@ PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): SymPtr;
     node^.left := NIL;
     node^.right := NIL;
     node^.val[0] := CHR(0);
+    node^.fsnap := FALSE;   (* no DEFINITION signature snapshotted *)
     IF NOT TreeInsert(curScope, node) THEN RETURN NIL END;
     RETURN node
   END RawEnter;
@@ -274,14 +287,97 @@ PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
     RETURN node # NIL
   END EnterPending;
 
-PROCEDURE FixPending (t: TypeIndex);
-  VAR i: CARDINAL;
+PROCEDURE VarParamOk (actual, formal: TypeIndex): BOOLEAN;
+(* Addressable-designator compatibility for VAR formals: same type,
+   or fixed array into open array with same element type, or string
+   literal into open CHAR array. *)
+  VAR fa, fe: TypeIndex;
   BEGIN
+    IF (actual = InvalidType) OR (formal = InvalidType) THEN
+      RETURN TRUE
+    END;
+    IF SameType(actual, formal) THEN RETURN TRUE END;
+    (* ADDRESS is interchangeable with any pointer for VAR params
+       (ADDRESS is a predefined alias, so ClassOf is enough here) *)
+    IF (formal = dAddr) AND (ClassOf(actual) = ClPtr) THEN
+      RETURN TRUE
+    END;
+    IF (actual = dAddr) AND (ClassOf(formal) = ClPtr) THEN
+      RETURN TRUE
+    END;
+    IF IsOpenArray(formal)
+ AND (ClassOf(actual) = ClArray) AND (ArrayDepth(actual) = 1) THEN
+      fa := ArrayElem(actual); fe := ArrayElem(formal);
+      IF SameType(fa, fe) THEN RETURN TRUE END
+    END;
+    IF IsOpenArray(formal) AND (ClassOf(actual) = ClStr) THEN
+      fe := ArrayElem(formal);
+      IF ClassOf(fe) = ClChar THEN RETURN TRUE END
+    END;
+    IF IsOpenArray(formal) AND (ClassOf(actual) = ClUStr) THEN
+      fe := ArrayElem(formal);
+      IF ClassOf(fe) = ClUChar THEN RETURN TRUE END
+    END;
+    RETURN FALSE
+  END VarParamOk;
+
+PROCEDURE FormalOk (a, b: TypeIndex): BOOLEAN;
+(* Value-formal equivalence for the strict 231 check: the same type, or
+   both integer-family (one family per the scalar model), or two
+   string-compatible types. *)
+  BEGIN
+    IF (a = InvalidType) OR (b = InvalidType) THEN
+      (* an unresolved type is not honest evidence; treat as ok so a
+         single root 221/201 is not multiplied by 231 *)
+      RETURN TRUE
+    END;
+    IF SameType(a, b) THEN RETURN TRUE END;
+    IF IsIntFamily(a) AND IsIntFamily(b) THEN RETURN TRUE END;
+    RETURN StrCompat(a, b)
+  END FormalOk;
+
+PROCEDURE FixPending (t: TypeIndex) : BOOLEAN;
+(* Assigns type t to all pending entries, clears the buffer, and
+   returns TRUE.  When the current procedure heading resumed a
+   DEFINITION (snapshot present), this is where a formal's type is
+   known, so the just-typed formals are compared against the
+   snapshot: FALSE = a strict-231 mismatch. *)
+  VAR i, base, k, n: CARDINAL;
+    f: SymPtr;
+    isV, ok: BOOLEAN;
+  BEGIN
+    n := nPend;              (* formals typed by this call *)
     i := 0;
     WHILE i < nPend DO
       pend[i]^.typ := t; INC(i)
     END;
-    nPend := 0
+    nPend := 0;
+    IF (curProc = NIL) OR (curProc^.nSnap = 0) THEN RETURN TRUE END;
+    (* number of formals already in the chain *)
+    base := 0;
+    f := curProc^.plink;
+    WHILE f # NIL DO INC(base); f := f^.plink END;
+    IF base > curProc^.nSnap THEN RETURN FALSE END;
+    (* the just-typed formals are chain indexes base-n .. base-1 *)
+    FOR k := 0 TO n - 1 DO
+      IF base >= n THEN
+        (* walk to index base-n+k *)
+        f := curProc^.plink;
+        i := 0;
+        WHILE (i < base - n + k) AND (f # NIL) DO
+          f := f^.plink; INC(i)
+        END;
+        IF f # NIL THEN
+          isV := f^.isVar;
+          IF isV THEN ok := VarParamOk(f^.typ, curProc^.snapT[base - n + k])
+          ELSE ok := FormalOk(f^.typ, curProc^.snapT[base - n + k]) END;
+          IF (isV # curProc^.snapV[base - n + k]) OR NOT ok THEN
+            RETURN FALSE
+          END
+        END
+      END
+    END;
+    RETURN TRUE
   END FixPending;
 
 PROCEDURE PendCount (): CARDINAL;
@@ -1143,6 +1239,7 @@ PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
     node^.fwd := FALSE;
     node^.virt := FALSE;
     node^.ext := FALSE;
+    node^.fsnap := FALSE;
     node^.link[0] := CHR(0);
     node^.uid := nextUid; INC(nextUid);
     node^.fdep := nProc;
@@ -1154,12 +1251,36 @@ PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
   END EnterProc;
 
 PROCEDURE ResumeProc (name: ARRAY OF CHAR): BOOLEAN;
-  VAR node: SymPtr;
+(* Resumes a DEFINITION procedure heading for its IMPLEMENTATION
+   body.  The definition's signature (result type, formals in order,
+   VAR-ness) is snapshotted before the implementation re-enters its
+   own formals; SetProcRes/FixPending then compare (strict 231). *)
+  VAR node, f: SymPtr;
+    i, n: CARDINAL;
   BEGIN
     IF curUnit # UnitImpl THEN RETURN FALSE END;
     node := TreeFind(curScope^.root, name);
     IF node = NIL THEN RETURN FALSE END;
     IF node^.kind # KindProc THEN RETURN FALSE END;
+    (* snapshot the definition signature *)
+    node^.snapRes := node^.rslt;
+    node^.nSnap := 0;
+    n := 0;
+    f := node^.plink;
+    WHILE (f # NIL) AND (n <= HighSnap) DO
+      snapT[n] := f^.typ;
+      snapV[n] := f^.isVar;
+      INC(n);
+      f := f^.plink
+    END;
+    FOR i := 0 TO HighSnap DO
+      IF i < n THEN
+        node^.snapT[i] := snapT[i];
+        node^.snapV[i] := snapV[i]
+      END
+    END;
+    node^.nSnap := n;
+    node^.fsnap := TRUE;
     node^.plink := NIL;   (* implementation re-enters formals *)
     curProc := node;
     curPTail := NIL;
@@ -1204,9 +1325,40 @@ PROCEDURE EnterParam (name: ARRAY OF CHAR; isVar: BOOLEAN): BOOLEAN;
     RETURN TRUE
   END EnterParam;
 
-PROCEDURE SetProcRes (t: TypeIndex);
-  BEGIN
-    IF curProc # NIL THEN curProc^.rslt := t END
+PROCEDURE SetProcRes (t: TypeIndex) : BOOLEAN;
+(* Sets the current procedure's result type.  If the heading resumed
+   a DEFINITION (ResumeProc), this is the strict-231 checkpoint: the
+   implementation's result type, formal count, formal types and
+   VAR-ness are compared against the snapshot; the outcome is
+   returned (TRUE = match). *)
+  VAR f, node: SymPtr;
+    i, n: CARDINAL;
+    isV: BOOLEAN;
+  BEGIN
+    IF curProc # NIL THEN curProc^.rslt := t END;
+    node := curProc;
+    IF (node = NIL) OR NOT node^.fsnap THEN RETURN TRUE END;
+    IF NOT FormalOk(t, node^.snapRes) THEN RETURN FALSE END;
+    (* count the implementation heading's formals *)
+    n := 0;
+    f := node^.plink;
+    WHILE (f # NIL) AND (n <= HighSnap) DO INC(n); f := f^.plink END;
+    IF n # node^.nSnap THEN RETURN FALSE END;
+    f := node^.plink;
+    i := 0;
+    WHILE f # NIL DO
+      IF i > HighSnap THEN RETURN FALSE END;
+      isV := f^.isVar;
+      IF isV # node^.snapV[i] THEN RETURN FALSE END;
+      IF isV THEN
+        IF NOT VarParamOk(f^.typ, node^.snapT[i]) THEN RETURN FALSE END
+      ELSE
+        IF NOT FormalOk(f^.typ, node^.snapT[i]) THEN RETURN FALSE END
+      END;
+      f := f^.plink;
+      INC(i)
+    END;
+    RETURN TRUE
   END SetProcRes;
 
 PROCEDURE ProcRes (name: ARRAY OF CHAR): TypeIndex;
@@ -1335,38 +1487,6 @@ PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
     RETURN p^.isVar
   END ParamIsVar;
 
-PROCEDURE VarParamOk (actual, formal: TypeIndex): BOOLEAN;
-(* Addressable-designator compatibility for VAR formals: same type,
-   or fixed array into open array with same element type, or string
-   literal into open CHAR array. *)
-  VAR fa, fe: TypeIndex;
-  BEGIN
-    IF (actual = InvalidType) OR (formal = InvalidType) THEN
-      RETURN TRUE
-    END;
-    IF SameType(actual, formal) THEN RETURN TRUE END;
-    (* ADDRESS is interchangeable with any pointer for VAR params *)
-    IF (Resolve(formal) = dAddr) AND (ClassOf(actual) = ClPtr) THEN
-      RETURN TRUE
-    END;
-    IF (Resolve(actual) = dAddr) AND (ClassOf(formal) = ClPtr) THEN
-      RETURN TRUE
-    END;
-    IF IsOpenArray(formal)
- AND (ClassOf(actual) = ClArray) AND (ArrayDepth(actual) = 1) THEN
-      fa := ArrayElem(actual); fe := ArrayElem(formal);
-      IF SameType(fa, fe) THEN RETURN TRUE END
-    END;
-    IF IsOpenArray(formal) AND (ClassOf(actual) = ClStr) THEN
-      fe := ArrayElem(formal);
-      IF ClassOf(fe) = ClChar THEN RETURN TRUE END
-    END;
-    IF IsOpenArray(formal) AND (ClassOf(actual) = ClUStr) THEN
-      fe := ArrayElem(formal);
-      IF ClassOf(fe) = ClUChar THEN RETURN TRUE END
-    END;
-    RETURN FALSE
-  END VarParamOk;
 
 (* ---------------- modules / separate compilation (step 4.3) ---------------- *)
 

+ 1 - 0
compiler/src/compiler.frm

@@ -107,6 +107,7 @@ MODULE -->Grammar;
         | 232: Msg("bad RETURN")
         | 233: Msg("invalid call")
         | 234: Msg("invalid UTF-8 in U-literal")
+        | 235: Msg("implementation does not match definition")
         ELSE         Msg("Error: "); WriteInt(f, nr, 0);
         END
       END ErrText;

+ 4 - 0
compiler/tests/sig.def

@@ -0,0 +1,4 @@
+DEFINITION MODULE Sig;
+PROCEDURE Add(a, b : INTEGER) : INTEGER;
+PROCEDURE Fill(VAR buf : ARRAY OF CHAR; n : CARDINAL);
+END Sig.

+ 8 - 0
compiler/tests/sig.mod

@@ -0,0 +1,8 @@
+IMPLEMENTATION MODULE Sig;
+(* Mismatched implementation: Add has the right arity but a wrong
+   result type; Fill's first formal is missing VAR. *)
+PROCEDURE Add(a, b : INTEGER) : CHAR;
+BEGIN RETURN "x" END Add;
+PROCEDURE Fill(buf : ARRAY OF CHAR; n : CARDINAL);
+BEGIN END Fill;
+END Sig.

+ 5 - 0
compiler/tests/sig_prog.mod

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

+ 12 - 11
docs/features.md

@@ -1,4 +1,4 @@
-# m2compiler-V3 — feature status (at `v3-strcat`, 128/128 green)
+# m2compiler-V3 — feature status (at `v3-sigcheck`, 129/129 green)
 
 Pipeline: Coco/R `M2.atg` (1748 lines, 73 productions) → `gm2`-built
 `M2` → QBE `.ssa` → `qbe` → `cc` → run. `SymTab.mod` 1623 lines,
@@ -35,7 +35,9 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
 - ✅ `DEFINITION`/`IMPLEMENTATION` modules, `IMPORT`/`FROM … IMPORT`,
   `EXPORT` (parsed), nested local `MODULE` (parsed; lowering pending).
 - ✅ Opaque completion; module `BEGIN` init bodies.
-- ⏸ Strict 231 impl-vs-def signature checks (arity checked, types not).
+- ✅ Strict impl-vs-def signature checks (error **235**): result type,
+  formal count, formal types and `VAR`-ness are compared against the
+  `DEFINITION` (was arity-only).
 
 ## Statements
 - ✅ Assignment, `IF/ELSIF/ELSE`, `CASE` (labels, ranges, `ELSE`),
@@ -79,7 +81,8 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
 
 ## Error codes
 - ✅ 200/201/202, 210–222, 223 (declared), 230, 231, 232,
-  **233 `invalid call`**, **234 `invalid UTF-8 in U-literal`**, plus
+  **233 `invalid call`**, **234 `invalid UTF-8 in U-literal`**,
+  **235 `implementation does not match definition`**, plus
   `file:line:col` console format.
 
 ## Library
@@ -90,16 +93,14 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
 
 ## Not started
 - ⏸ Clarion `CLASS` lowering (declared + checked only); Unicode
-  `UString` whole-string assignment; strict `231` def/impl signature
-  checks; `IOChan` beyond the standard streams; variant records. (ISO
-  `ConvResults` enumerations are now expressible.) The TopSpeed
-  legacy grammar (`TopSpeed-V3-M2.atg`) is a separate sidecar, not
-  merged.
+  `UString` whole-string assignment; `IOChan` beyond the standard
+  streams; variant records. (ISO `ConvResults` enumerations are now
+  expressible.) The TopSpeed legacy grammar (`TopSpeed-V3-M2.atg`) is
+  a separate sidecar, not merged.
 
 (Self-hosting is reached: `bootstrap/fixpoint.sh` builds a
 byte-identical compiler image; `stdlib/` + `runtime/syslib` are in
 use. See `docs/summary_selfhosting.md`.)
 
-Next: strict `231` def/impl signature checks, variant records,
-`IOChan` over files. Roadmap: `docs/plan.md`,
-`docs/blaise-phases-map.md`.
+Next: variant records, `IOChan` over files, `UString` assignment.
+Roadmap: `docs/plan.md`, `docs/blaise-phases-map.md`.

+ 69 - 0
docs/summary_sigcheck.md

@@ -0,0 +1,69 @@
+# Step: strict implementation-vs-definition signature checks
+
+Tag `v3-sigcheck`. Suite **129/129**; fixpoint **OK**
+(`bootstrap/fixpoint.sh`, image **2,102,326 bytes**).
+
+## What changed
+
+An `IMPLEMENTATION` procedure heading must now match its `DEFINITION`
+(or exported `FORWARD`) beyond arity:
+
+- **result type**, **formal count**, each **formal type**, and each
+  formal's **`VAR`-ness**.
+
+Mismatch → new semantic error **235
+`implementation does not match definition`**.
+
+Before, only the *arity* was effectively covered and a differing
+result type or parameter type was silently accepted (a real
+separate-compilation hazard).
+
+## How it works
+
+- `ResumeProc` (the implementation heading resuming a DEFINITION
+  procedure) snapshots the definition signature into the symbol:
+  `snapRes` (result), `snapT[]`/`snapV[]` (formal types / VAR-ness),
+  `nSnap`, and sets `fsnap`.
+- The implementation heading re-enters its own formals; as each
+  formal's type becomes known (`FixPending`), the formal is compared
+  against the snapshot. `SetProcRes` compares the result type (and is
+  the backstop for a parameterless heading).
+- Comparisons use `FormalOk` (value formals: same type, both
+  integer-family, or string-compatible) and `VarParamOk` (VAR
+  formals); a mismatched `VAR`-ness is caught directly. InvalidType is
+  treated as "no evidence" so a single root error is not multiplied.
+- Signatures are bounded to `MaxSnap = 16` formals (self-hosting uses
+  far fewer).
+
+## Deliberate leniency
+
+- `INTEGER`/`CARDINAL` are accepted interchangeably for **value**
+  formals and results: V3 models them as one integer family (a per-
+  type split would reject the compiler's own valid-looking source).
+  For `VAR` formals the types must match exactly.
+- `VAR` open arrays vs fixed arrays still follow `VarParamOk` (a fixed
+  array is an acceptable actual for an open formal).
+
+## Tests
+
+`tests/{sig.def,sig.mod,sig_prog.mod}` + `expect_fail_files sig`:
+`sig.mod` declares `Add(a,b):CHAR` where the definition says
+`:INTEGER`, and `Fill(buf:ARRAY OF CHAR;n:CARDINAL)` where the
+definition has `VAR buf`. Both report 235. Exact-match sessions still
+compile (verified with the full `m5` case).
+
+## Notes
+
+- Error 231 is already "opaque type outside definition", so the
+  signature mismatch got its own code, 235.
+- `qbe`/`.ssa` output is suppressed when 235 fires (the session is
+  rejected before codegen), matching other semantic errors.
+
+## Files
+
+`compiler/src/SymTab.def`/`.mod` (`ResumeProc` snapshot, `FixPending`
+and `SetProcRes` returning the check result, `FormalOk`, `MaxSnap`),
+`compiler/src/M2.atg` (report 235 at `SetProcRes`/`FixPending`),
+`compiler/src/compiler.frm` (message 235),
+`compiler/tests/{sig.def,sig.mod,sig_prog.mod}`,
+`compiler/run_tests.sh`, `docs/features.md`.