M2compiler-V3/compiler/src/QbeGen.mod

IMPLEMENTATION MODULE QbeGen;

IMPORT FileIO, SymTab;

VAR
  out    : FileIO.File;
  opened : BOOLEAN;
  inBody : BOOLEAN;
  dead   : BOOLEAN;  (* TRUE past a terminator: next instruction opens
                         an unreachable block with a fresh label, so
                         the .ssa stays valid QBE (no dangling temps,
                         no instruction outside a block). *)
  nTemp  : CARDINAL;
  nLab   : CARDINAL;
  loopTop : CARDINAL;
  loopSt  : ARRAY [0 .. 15] OF QVal;
  nR     : CARDINAL;  (* non-zero REAL consts flushed at BeginBody *)
  rNames : ARRAY [0 .. 31] OF QVal;
  rVals  : ARRAY [0 .. 31] OF QVal;
  nStr   : CARDINAL;  (* string-literal data counter *)
  strNams : ARRAY [0 .. 4095] OF QVal;
  strTexts : ARRAY [0 .. 4095] OF ARRAY [0 .. 255] OF CHAR;
  (* UString literals: decoded codepoints, recorded for EndModule. *)
  ustrN : CARDINAL;
  ustrNams : ARRAY [0 .. 255] OF QVal;
  ustrStart : ARRAY [0 .. 255] OF CARDINAL;
  ustrCount : ARRAY [0 .. 255] OF CARDINAL;
  ustrPool : ARRAY [0 .. 8191] OF INTEGER;
  ustrUsed : CARDINAL;
  (* array constructors: pooled static descriptors *)
  ctorN : CARDINAL;
  ctorNam : ARRAY [0 .. 255] OF QVal;
  ctorTxt : ARRAY [0 .. 255] OF ARRAY [0 .. 4095] OF CHAR;
  ctorUse : ARRAY [0 .. 255] OF BOOLEAN;  (* FALSE once inlined as a field *)
  ctorTop : CARDINAL;
  ctorTyp : ARRAY [0 .. 7] OF INTEGER;
  ctorCnt : ARRAY [0 .. 7] OF CARDINAL;
  ctorBuf : ARRAY [0 .. 7] OF ARRAY [0 .. 4095] OF CHAR;
  ctorEv : ARRAY [0 .. 7] OF ARRAY [0 .. 255] OF QVal;
  ctorEk : ARRAY [0 .. 7] OF ARRAY [0 .. 255] OF INTEGER;
  withTop : CARDINAL;
  withSt  : ARRAY [0 .. 7] OF QVal;
  noEmit : BOOLEAN;  (* TRUE while parsing nested procedures in 4.1:
                        SymTab tracks, QbeGen suppresses output *)
  inFunc : BOOLEAN;  (* TRUE inside an emitted function body *)
  useStack : BOOLEAN;(* TRUE: NewHeap allocates stack slots *)
  funcRes : CHAR;    (* current function result class *)
  nLoc : CARDINAL;   (* function-local name table entries *)
  locNames : ARRAY [0 .. 255] OF SymTab.Name;
  locTag : ARRAY [0 .. 255] OF INTEGER;  (* 0 slot, 1 data, 2 addr *)
  locRep : ARRAY [0 .. 255] OF QVal;     (* slot temp / mangled / addr *)
  locCls : ARRAY [0 .. 255] OF CHAR;
  locTyp : ARRAY [0 .. 255] OF INTEGER;
  funcDepth : CARDINAL;  (* open BeginFuncs; main body = 0 *)
  scopeTop : CARDINAL;   (* open procedure scopes *)
  scopeBase : ARRAY [0 .. 16] OF CARDINAL;
  scopeLink : ARRAY [0 .. 15] OF QVal;  (* per-scope link records *)
  slTmp : QVal;          (* current static-link param temp *)
  hdrComma : BOOLEAN;
  stkLink : ARRAY [0 .. 15] OF QVal;    (* per-call static links *)
  stkExt : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call external flag *)
  stkInd : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call indirect flag *)
  outSel : CARDINAL;  (* 0 = file, else nestBufs[outSel-1] *)
  nInit : CARDINAL;
  initNames : ARRAY [0 .. 31] OF QVal;
  sessBuf : ARRAY [0 .. 4194303] OF CHAR;  (* whole image, buffered (4 MiB:
                                              must hold the compiler's own
                                              image text when self-hosting) *)
  sessUsed : CARDINAL;
  nestBufs : ARRAY [0 .. 15] OF ARRAY [0 .. 65535] OF CHAR;
  nestUsed : ARRAY [0 .. 15] OF CARDINAL;
  (* Short-circuit AND/OR: the RHS operand's code is buffered here
     (delayTop > 0) and replayed inside the branch. *)
  delayBuf : ARRAY [0 .. 15] OF ARRAY [0 .. 8191] OF CHAR;
  delayUsed : ARRAY [0 .. 15] OF CARDINAL;
  delayTop : CARDINAL;
  (* one buffer per nesting depth: each nested function stays
     contiguous no matter how deep the parse interleaves *)
  nPar : CARDINAL;   (* recorded formal params for the header *)
  parCls : ARRAY [0 .. 63] OF CHAR;
  parTmp : ARRAY [0 .. 63] OF QVal;
  parNam : ARRAY [0 .. 63] OF SymTab.Name;
  parVar : ARRAY [0 .. 63] OF BOOLEAN;
  parTyp : ARRAY [0 .. 63] OF INTEGER;
  argBuf : ARRAY [0 .. 4095] OF CHAR;   (* accumulated call args *)
  hbuf : ARRAY [0 .. 2047] OF CHAR;     (* buffered function header *)
  nArg : CARDINAL;
  recvQ : QVal;                         (* armed class-method receiver *)
  recvArmed : BOOLEAN;
  callDepth : CARDINAL;                 (* nested-call stack *)
  stkName : ARRAY [0 .. 15] OF QVal;
  stkRes : ARRAY [0 .. 15] OF CHAR;
  stkArg : ARRAY [0 .. 15] OF ARRAY [0 .. 1023] OF CHAR;
  stkN : ARRAY [0 .. 15] OF CARDINAL;
  funcName : QVal;   (* current function / call target *)
  curModName : SymTab.Name;  (* module being compiled (global names) *)
  outName : SymTab.Name;     (* image-file override (Lower compare) *)
  hasOutName : BOOLEAN;
  nVal : ARRAY [0 .. 255] OF QVal;  (* VAR-actual note keys *)
  nAddr : ARRAY [0 .. 255] OF QVal; (* VAR-actual note addresses *)
  nn : CARDINAL;
  (* Forward-global designator patch sites: a not-yet-declared
     identifier inside a procedure body emits "site =l copy 0" plus a
     load/store operand "fwd<id>"; both are text-patched once the
     module's declarations are complete. *)
  nFwd : CARDINAL;
  dbgFwd : INTEGER;
  fwdSite : ARRAY [0 .. 255] OF SymTab.Name;  (* real name to patch in *)
  fwdOper : ARRAY [0 .. 255] OF QVal;         (* final load/store class *)
  fwdGlob : ARRAY [0 .. 255] OF BOOLEAN;
  (* Session-state snapshot: Lower runs per unit while the grammar's
     suppressed inline emit still mutates these, so Lower saves/restores
     its own values around each unit. *)
  sav_nTemp, sav_nLab, sav_loopTop, sav_nR, sav_nStr, sav_nLoc,
  sav_nPar, sav_nArg, sav_nn, sav_nInit, sav_sessUsed, sav_delayTop,
  sav_ustrN, sav_ustrUsed, sav_ctorN, sav_ctorTop, sav_funcDepth,
  sav_scopeTop, sav_callDepth, sav_outSel, sav_withTop : CARDINAL;
  sav_inBody, sav_inFunc, sav_useStack, sav_recvArmed : BOOLEAN;

PROCEDURE SaveSession;
  BEGIN
    sav_nTemp := nTemp; sav_nLab := nLab; sav_loopTop := loopTop;
    sav_nR := nR; sav_nStr := nStr; sav_nLoc := nLoc; sav_nPar := nPar;
    sav_nArg := nArg; sav_nn := nn; sav_nInit := nInit;
    sav_sessUsed := sessUsed; sav_delayTop := delayTop;
    sav_ustrN := ustrN; sav_ustrUsed := ustrUsed;
    sav_ctorN := ctorN; sav_ctorTop := ctorTop;
    sav_funcDepth := funcDepth; sav_scopeTop := scopeTop;
    sav_callDepth := callDepth; sav_outSel := outSel;
    sav_withTop := withTop;
    sav_inBody := inBody; sav_inFunc := inFunc;
    sav_useStack := useStack; sav_recvArmed := recvArmed
  END SaveSession;

PROCEDURE RestoreSession;
  VAR i : CARDINAL;
  BEGIN
    nTemp := sav_nTemp; nLab := sav_nLab; loopTop := sav_loopTop;
    nR := sav_nR; nStr := sav_nStr; nLoc := sav_nLoc; nPar := sav_nPar;
    nArg := sav_nArg; nInit := sav_nInit;
    sessUsed := sav_sessUsed; delayTop := sav_delayTop;
    ustrN := sav_ustrN; ustrUsed := sav_ustrUsed;
    ctorN := sav_ctorN; ctorTop := sav_ctorTop;
    funcDepth := sav_funcDepth; scopeTop := sav_scopeTop;
    callDepth := sav_callDepth; outSel := sav_outSel;
    withTop := sav_withTop;
    inBody := sav_inBody; inFunc := sav_inFunc;
    useStack := sav_useStack; recvArmed := sav_recvArmed;
    (* Clear the VAR-actual note ring.  The grammar's suppressed
       parse-time emit never reaches the buffer, but its NoteAddr calls
       do fill this ring; AddrOfVal scans the whole ring and the keys
       are temps that restart per function, so a stale grammar entry can
       false-match Lower's own key.  Lower re-notes its own VAR
       actuals, so starting from an empty ring is correct. *)
    nn := 0;
    i := 0;
    WHILE i <= HIGH(nVal) DO
      nVal[i][0] := CHR(0); nAddr[i][0] := CHR(0); INC(i)
    END
  END RestoreSession;

(* ---------------- small string utilities ---------------- *)

PROCEDURE Len (s: ARRAY OF CHAR): CARDINAL;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
    RETURN i
  END Len;

PROCEDURE Cpy (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(d)) AND (i <= HIGH(s)) AND (s[i] # CHR(0)) DO
      d[i] := s[i]; INC(i)
    END;
    IF i <= HIGH(d) THEN d[i] := CHR(0) END
  END Cpy;

PROCEDURE App (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
  VAR i, j : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(d)) AND (d[i] # CHR(0)) DO INC(i) END;
    j := 0;
    WHILE (i <= HIGH(d)) AND (j <= HIGH(s)) AND (s[j] # CHR(0)) DO
      d[i] := s[j]; INC(i); INC(j)
    END;
    IF i <= HIGH(d) THEN d[i] := CHR(0) END
  END App;

PROCEDURE BufApp (VAR buf: ARRAY OF CHAR; VAR used: CARDINAL;
                   s: ARRAY OF CHAR; eol: BOOLEAN);
  VAR j : CARDINAL;
  BEGIN
    j := 0;
    WHILE (used < HIGH(buf)) AND (j <= HIGH(s)) AND (s[j] # CHR(0)) DO
      buf[used] := s[j]; INC(used); INC(j)
    END;
    IF eol AND (used < HIGH(buf)) THEN
      buf[used] := CHR(10); INC(used)
    END;
    IF used <= HIGH(buf) THEN buf[used] := CHR(0) END
  END BufApp;

PROCEDURE WEmit (s: ARRAY OF CHAR; eol: BOOLEAN);
(* Single output sink: the session buffer, or a nesting-depth
   buffer for nested functions (QBE rejects definitions inside
   functions, so nested bodies hoist until EndModule). *)
  VAR b, u, j : CARDINAL;
  BEGIN
    IF NOT opened OR noEmit THEN RETURN END;
    IF delayTop > 0 THEN
      b := delayTop - 1;
      u := delayUsed[b]; j := 0;
      WHILE (u < HIGH(delayBuf[b])) AND (j <= HIGH(s))
            AND (s[j] # CHR(0)) DO
        delayBuf[b][u] := s[j]; INC(u); INC(j)
      END;
      IF eol AND (u < HIGH(delayBuf[b])) THEN
        delayBuf[b][u] := CHR(10); INC(u)
      END;
      IF u <= HIGH(delayBuf[b]) THEN delayBuf[b][u] := CHR(0) END;
      delayUsed[b] := u;
      RETURN
    END;
    IF outSel = 0 THEN
      BufApp(sessBuf, sessUsed, s, eol);
      RETURN
    END;
    b := outSel - 1;
    IF b > HIGH(nestBufs) THEN b := HIGH(nestBufs) END;
    u := nestUsed[b];
    j := 0;
    WHILE (u < HIGH(nestBufs[b])) AND (j <= HIGH(s)) AND (s[j] # CHR(0)) DO
      nestBufs[b][u] := s[j]; INC(u); INC(j)
    END;
    IF eol AND (u < HIGH(nestBufs[b])) THEN
      nestBufs[b][u] := CHR(10); INC(u)
    END;
    IF u <= HIGH(nestBufs[b]) THEN nestBufs[b][u] := CHR(0) END;
    nestUsed[b] := u
  END WEmit;

PROCEDURE W (s: ARRAY OF CHAR);
  BEGIN
    WEmit(s, FALSE)
  END W;

PROCEDURE WL (s: ARRAY OF CHAR);
  BEGIN
    WEmit(s, TRUE)
  END WL;

PROCEDURE SetNoEmit (b: BOOLEAN);
  BEGIN
    noEmit := b
  END SetNoEmit;

PROCEDURE DelayBegin;
(* Start buffering output (the RHS operand of a short-circuit AND/OR). *)
  BEGIN
    IF delayTop <= HIGH(delayBuf) THEN
      delayUsed[delayTop] := 0;
      delayBuf[delayTop][0] := CHR(0);
      INC(delayTop)
    END
  END DelayBegin;

PROCEDURE DelayEnd;
(* Stop buffering (restore the previous output sink). *)
  BEGIN
    IF delayTop > 0 THEN DEC(delayTop) END
  END DelayEnd;

PROCEDURE DelayFlush;
(* Emit the buffered RHS operand's code into the current sink.
   DelayEnd already popped delayTop, so the just-used buffer index is
   delayTop itself. *)
  VAR b: CARDINAL;
  BEGIN
    b := delayTop;
    IF b <= HIGH(delayBuf) THEN WEmit(delayBuf[b], FALSE) END
  END DelayFlush;

PROCEDURE Slot4 (VAR s: QVal);
  BEGIN
    NewTemp(s);
    Revive;
    W("  "); W(s); W(" =l alloc4 4"); WL("")
  END Slot4;

PROCEDURE StoreW (slot: ARRAY OF CHAR; val: ARRAY OF CHAR);
  BEGIN
    Revive;
    W("  storew "); W(val); W(", "); WL(slot)
  END StoreW;

PROCEDURE LoadW (slot: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =w loadw "); WL(slot)
  END LoadW;

PROCEDURE SetModule (name: ARRAY OF CHAR);
(* Names the module whose globals are being emitted (QBE symbols
   become "<mod>_<name>" so separate modules never collide). *)
  BEGIN
    Cpy(curModName, name)
  END SetModule;

PROCEDURE SetOutName (name: ARRAY OF CHAR);
(* Overrides the image file name written by EndModule (gen_ssa/<name>.ssa)
   without changing the symbol name EndModule mangles.  Test-only hook for
   the two-phase Lower comparison. *)
  BEGIN
    Cpy(outName, name); hasOutName := TRUE
  END SetOutName;

PROCEDURE SymRef (name: ARRAY OF CHAR; VAR ref: QVal);
(* "$<mod>_<sym>" for module-level entries (avoids cross-module
   collisions); "$<name>" fallback otherwise. *)
  VAR g : SymTab.Name;
  BEGIN
    Cpy(ref, "$");
    IF SymTab.GlobalRef(name, g) THEN App(ref, g)
    ELSE App(ref, name)
    END
  END SymRef;

PROCEDURE Wc (c: CHAR);
(* Writes a single class character (w/d/l). *)
  VAR s : ARRAY [0 .. 1] OF CHAR;
  BEGIN
    s[0] := c; s[1] := CHR(0);
    W(s)
  END Wc;

PROCEDURE AppNum (VAR d: ARRAY OF CHAR; v: CARDINAL);
(* Appends v in decimal to d. *)
  VAR buf : ARRAY [0 .. 15] OF CHAR;
    n, i, L : CARDINAL;
  BEGIN
    n := 0;
    IF v = 0 THEN buf[0] := "0"; n := 1 END;
    WHILE (v > 0) AND (n <= HIGH(buf)) DO
      buf[n] := CHR(ORD("0") + v MOD 10); v := v DIV 10; INC(n)
    END;
    i := n;
    WHILE i > 0 DO
      DEC(i);
      L := Len(d);
      IF L < HIGH(d) THEN d[L] := buf[i]; d[L + 1] := CHR(0) END
    END
  END AppNum;

PROCEDURE FwdDesignator (): INTEGER;
(* Reserves a forward-global patch site and returns its id. *)
  BEGIN
    IF nFwd > HIGH(fwdSite) THEN RETURN 0 END;
    INC(nFwd);
    RETURN VAL(INTEGER, nFwd)
  END FwdDesignator;

PROCEDURE FwdMangle (id: INTEGER; VAR q: QVal);
  BEGIN
    Cpy(q, "$fwd");
    AppNum(q, VAL(CARDINAL, id))
  END FwdMangle;

PROCEDURE FwdAddrOper (id: INTEGER; VAR q: QVal);
(* Stand-in address operand for forward site id. *)
  BEGIN
    FwdMangle(id, q)
  END FwdAddrOper;

PROCEDURE FixLoadClass (ph: ARRAY OF CHAR; cls: CHAR);
(* Re-class "<tmp> =<x> load<x> <ph>" -> "<tmp> =<cls> load<cls> <ph>".
   The default emit for an unresolved alias is `l` (pointer-like). *)
  VAR i, j, n: CARDINAL; found: BOOLEAN;
  BEGIN
    n := Len(ph);
    i := 0;
    WHILE i + n <= sessUsed DO
      (* "=c loadc " is 9 chars: '=', c, ' ', 'l','o','a','d', c, ' ' *)
      found := (i + 9 + n <= sessUsed);
      IF found THEN
        found := (sessBuf[i] = "=")
                 AND (sessBuf[i+2] = " ")
                 AND (sessBuf[i+3] = "l") AND (sessBuf[i+4] = "o")
                 AND (sessBuf[i+5] = "a") AND (sessBuf[i+6] = "d")
                 AND (sessBuf[i+8] = " ")
                 AND (sessBuf[i+1] = sessBuf[i+7])
      END;
      IF found THEN
        j := 0; found := TRUE;
        WHILE (j < n) AND found DO
          IF sessBuf[i + 9 + j] # ph[j] THEN found := FALSE END; INC(j)
        END
      END;
      IF found THEN
        sessBuf[i + 1] := cls;
        sessBuf[i + 7] := cls
      END;
      INC(i)
    END
  END FixLoadClass;

PROCEDURE FixStoreClass (ph: ARRAY OF CHAR; cls: CHAR);
(* Re-class "store<x> <val>, <ph>" -> "store<cls> <val>, <ph>": blinks
   the opcode word that opens the line holding the operand <ph>. *)
  VAR i, j, n: CARDINAL; found: BOOLEAN;
  BEGIN
    n := Len(ph);
    i := 0;
    WHILE i + n <= sessUsed DO
      found := TRUE; j := 0;
      WHILE (j < n) AND found DO
        IF sessBuf[i + j] # ph[j] THEN found := FALSE END; INC(j)
      END;
      IF found THEN
        j := i;
        WHILE (j > 0) AND (sessBuf[j - 1] # CHR(10)) DO DEC(j) END;
        WHILE (j < i) AND ((sessBuf[j] = " ") OR (sessBuf[j] = CHR(9))) DO
          INC(j)
        END;
        IF (j + 6 <= i)
           AND (sessBuf[j] = "s") AND (sessBuf[j+1] = "t")
           AND (sessBuf[j+2] = "o") AND (sessBuf[j+3] = "r")
           AND (sessBuf[j+4] = "e") THEN
          sessBuf[j + 5] := cls
        END
      END;
      INC(i)
    END
  END FixStoreClass;

PROCEDURE BufReplaceAll (pat, rep: ARRAY OF CHAR);
(* Literal substring replacement over sessBuf (in place, memmove
   semantics for both growth and shrink). *)
  VAR i, j: CARDINAL; n, m, tail, k: CARDINAL; found: BOOLEAN;
  BEGIN
    n := Len(pat); m := Len(rep);
    IF (n = 0) OR (m = 0) THEN RETURN END;
    i := 0;
    WHILE i + n <= sessUsed DO
      found := TRUE; j := 0;
      WHILE (j < n) AND found DO
        IF sessBuf[i + j] # pat[j] THEN found := FALSE END; INC(j)
      END;
      IF NOT found THEN INC(i)
      ELSE
        IF m > n THEN
          tail := sessUsed;
          k := m - n;
          IF tail + k <= HIGH(sessBuf) THEN
            WHILE tail > i + n DO
              DEC(tail);
              sessBuf[tail + k] := sessBuf[tail]
            END;
            sessUsed := sessUsed + k
          END
        ELSIF m < n THEN
          tail := i + n;
          k := n - m;
          WHILE tail < sessUsed DO
            sessBuf[tail - k] := sessBuf[tail]; INC(tail)
          END;
          sessUsed := sessUsed - k
        END;
        j := 0;
        WHILE j < m DO sessBuf[i + j] := rep[j]; INC(j) END;
        i := i + m
      END
    END;
    IF sessUsed <= HIGH(sessBuf) THEN sessBuf[sessUsed] := CHR(0) END
  END BufReplaceAll;

PROCEDURE FwdPatchAll;
(* Rewrites each forward placeholder into the real designator, and
   re-classes the load that reads through it.  Loads are emitted by the
   frontend as "<tmp> =<x> load<x> <ph>"; the default class is `w`, so
   for a `d`/`l` slot the opcode is rewritten to loadd/loadl.  Stores
   are emitted as "store<x> <val>, <ph>"; the class letter of the store
   is rewritten in place. *)
  VAR k: INTEGER; ph, sym: QVal; c: CHAR;
  BEGIN
    k := 0;
    WHILE k < VAL(INTEGER, nFwd) DO
      IF fwdSite[k][0] # CHR(0) THEN
        FwdMangle(k + 1, ph);
        Cpy(sym, fwdSite[k]);
        IF fwdOper[k][0] = CHR(0) THEN c := "w" ELSE c := fwdOper[k][0] END;
        FixLoadClass(ph, c);
        FixStoreClass(ph, c);
        BufReplaceAll(ph, sym)
      END;
      INC(k)
    END;
    nFwd := 0
  END FwdPatchAll;



(* ---------------- exported helpers ---------------- *)

PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
  BEGIN
    Cpy(d, s)
  END CopyOp;

PROCEDURE NoteAddr (val: ARRAY OF CHAR; addr: ARRAY OF CHAR);
(* Records value-temp → address mapping for VAR actuals. Ring of
   256: safe because SSA temps are never reused (stale entries can
   never false-match, only age out on pathological expressions). *)
  BEGIN
    Cpy(nVal[nn], val);
    Cpy(nAddr[nn], addr);
    nn := nn + 1;
    IF nn > HIGH(nVal) THEN nn := 0 END
  END NoteAddr;

PROCEDURE AddrOfVal (val: ARRAY OF CHAR; VAR addr: QVal): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i <= HIGH(nVal) DO
      IF SymTab.Equal(nVal[i], val) THEN
        Cpy(addr, nAddr[i]);
        RETURN TRUE
      END;
      INC(i)
    END;
    RETURN FALSE
  END AddrOfVal;

PROCEDURE AddrOf (name: ARRAY OF CHAR; VAR q: QVal);
  VAR idx : INTEGER;
    levels : CARDINAL;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN
        IF locTag[idx] = 1 THEN
          Cpy(q, "$");
          App(q, locRep[idx])
        ELSE
          Cpy(q, locRep[idx])
        END
      ELSE
        UpAddrOf(idx, levels, q)
      END;
      RETURN
    END;
    SymRef(name, q)
  END AddrOf;

PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
  VAR neg : BOOLEAN;
    mag : CARDINAL;
    buf : ARRAY [0 .. 15] OF CHAR;
    n, i, L : CARDINAL;
    t : CHAR;
  BEGIN
    neg := v < 0;
    IF neg THEN mag := VAL(CARDINAL, -v) ELSE mag := VAL(CARDINAL, v) END;
    n := 0;
    IF mag = 0 THEN buf[0] := "0"; n := 1 END;
    WHILE (mag > 0) AND (n < HIGH(buf)) DO
      buf[n] := CHR(ORD("0") + mag MOD 10); mag := mag DIV 10; INC(n)
    END;
    i := 0;
    WHILE i < n DIV 2 DO
      t := buf[i]; buf[i] := buf[n - 1 - i]; buf[n - 1 - i] := t; INC(i)
    END;
    s[0] := CHR(0);
    IF neg THEN App(s, "-") END;
    i := 0;
    WHILE i < n DO
      L := Len(s);
      IF L < HIGH(s) THEN s[L] := buf[i]; s[L + 1] := CHR(0) END;
      INC(i)
    END
  END IntStr;

PROCEDURE HexVal (ch: CHAR): INTEGER;
  BEGIN
    IF (ch >= "0") AND (ch <= "9") THEN RETURN ORD(ch) - ORD("0") END;
    IF (ch >= "A") AND (ch <= "F") THEN RETURN ORD(ch) - ORD("A") + 10 END;
    IF (ch >= "a") AND (ch <= "f") THEN RETURN ORD(ch) - ORD("a") + 10 END;
    RETURN 0
  END HexVal;

PROCEDURE NormInt (s: ARRAY OF CHAR; VAR d: QVal);
(* "0xFF" -> "255", plain decimals are copied through. *)
  VAR n, i : CARDINAL;
    v : INTEGER;
  BEGIN
    n := Len(s);
    IF (n > 2) AND (s[0] = "0")
 AND ((s[1] = "x") OR (s[1] = "X")) THEN
      v := 0; i := 2;
      WHILE i < n DO v := v * 16 + HexVal(s[i]); INC(i) END;
      IntStr(v, d)
    ELSE
      Cpy(d, s)
    END
  END NormInt;

PROCEDURE NormLit (s: ARRAY OF CHAR; VAR d: QVal; VAR isCh: BOOLEAN);
(* Full V3 integer literal: octal B/b, hex H/h and C/c suffixes plus
   the 0x/0X prefix; C marks a character constant.  The suffix letter
   is excluded from the digit run (HexVal would read 'B' as 11).
   A 0x/0X prefix takes priority over any trailing B/C/H (C-style
   hex digits, so 0xB is 11, never an octal suffix). *)
  VAR n, i, hi, base : CARDINAL;
    v : INTEGER;
    ch : CHAR;
  BEGIN
    n := Len(s);
    isCh := FALSE;
    IF n = 0 THEN Cpy(d, "0"); RETURN END;
    i := 0;
    IF (n >= 3) AND (s[0] = "0") AND ((s[1] = "x") OR (s[1] = "X")) THEN
      base := 16; hi := n; i := 2
    ELSE
      ch := s[n - 1];
      IF (ch = "B") OR (ch = "b") THEN
        base := 8; hi := n - 1
      ELSIF (ch = "H") OR (ch = "h") THEN
        base := 16; hi := n - 1
      ELSIF (ch = "C") OR (ch = "c") THEN
        base := 16; hi := n - 1; isCh := TRUE
      ELSE
        base := 10; hi := n
      END
    END;
    v := 0;
    WHILE i < hi DO
      v := v * VAL(INTEGER, base) + HexVal(s[i]); INC(i)
    END;
    IntStr(v, d)
  END NormLit;

PROCEDURE NormReal (s: ARRAY OF CHAR; VAR d: QVal);
(* "3.14" -> "d_3.14" (QBE double immediates carry a d_ prefix). *)
  BEGIN
    Cpy(d, "d_");
    App(d, s)
  END NormReal;

PROCEDURE CharVal (s: ARRAY OF CHAR): INTEGER;
  BEGIN
    IF Len(s) >= 2 THEN RETURN ORD(s[1]) END;
    RETURN 0
  END CharVal;

PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: QVal);
(* Safe for a and q being the same variable. *)
  VAR i, j, L : CARDINAL;
    tmp : QVal;
  BEGIN
    Cpy(tmp, a);
    IF Len(tmp) = 0 THEN Cpy(q, "0"); RETURN END;
    IF tmp[0] = "-" THEN
      i := 1; j := 0;
      WHILE (tmp[i] # CHR(0)) AND (j < HIGH(q)) DO
        q[j] := tmp[i]; INC(i); INC(j)
      END;
      IF j <= HIGH(q) THEN q[j] := CHR(0) END
    ELSIF (tmp[0] = "d") AND (Len(tmp) > 1) AND (tmp[1] = "_") THEN
      Cpy(q, "d_-");
      i := 2;
      WHILE tmp[i] # CHR(0) DO
        L := Len(q);
        IF L < HIGH(q) THEN q[L] := tmp[i]; q[L + 1] := CHR(0) END;
        INC(i)
      END
    ELSE
      Cpy(q, "-");
      App(q, tmp)
    END
  END NegFold;

PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    IF Len(s) = 0 THEN RETURN FALSE END;
    RETURN ((s[0] >= "0") AND (s[0] <= "9")) OR (s[0] = "-")
           OR (s[0] = "d")
  END IsImm;

PROCEDURE ParseInt (s: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
  VAR i, nd, d: CARDINAL;
    neg: BOOLEAN;
  BEGIN
    v := 0; i := 0; neg := FALSE; nd := 0;
    IF (i <= HIGH(s)) AND (s[i] = "-") THEN neg := TRUE; INC(i) END;
    IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN FALSE END;
    WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO
      d := ORD(s[i]);
      IF (d < ORD("0")) OR (d > ORD("9")) THEN RETURN FALSE END;
      v := v * 10 + VAL(INTEGER, d - ORD("0"));
      INC(i); INC(nd)
    END;
    IF nd = 0 THEN RETURN FALSE END;
    IF neg THEN v := -v END;
    RETURN TRUE
  END ParseInt;

PROCEDURE Fold2 (kind: INTEGER; a, b: ARRAY OF CHAR; VAR r: QVal): BOOLEAN;
  VAR x, y, z: INTEGER;
  BEGIN
    IF NOT ParseInt(a, x) THEN RETURN FALSE END;
    IF NOT ParseInt(b, y) THEN RETURN FALSE END;
    IF kind = 0 THEN z := x + y
    ELSIF kind = 1 THEN z := x - y
    ELSIF kind = 2 THEN z := x * y
    ELSIF kind = 3 THEN
      IF y = 0 THEN RETURN FALSE END;
      z := x DIV y
    ELSE
      IF y = 0 THEN RETURN FALSE END;
      z := x MOD y
    END;
    IntStr(z, r);
    RETURN TRUE
  END Fold2;

(* ---------------- module / data section ---------------- *)

PROCEDURE OpenModule (name: ARRAY OF CHAR);
  VAR i : CARDINAL;
  BEGIN
    opened := TRUE;
    inBody := FALSE;
    dead := FALSE;
    hasOutName := FALSE;
    nTemp := 0; nLab := 0; loopTop := 0; nR := 0; nStr := 0;
    withTop := 0;
    noEmit := FALSE; inFunc := FALSE; useStack := FALSE;
    ctorN := 0; ctorTop := 0;
    nLoc := 0; nPar := 0; nArg := 0; nn := 0; callDepth := 0;
    recvArmed := FALSE;
    funcDepth := 0; scopeTop := 0; scopeBase[0] := 0;
    nInit := 0;
    outSel := 0;
    sessUsed := 0; sessBuf[0] := CHR(0);
    delayTop := 0;
    ustrN := 0; ustrUsed := 0;
    i := 0;
    WHILE i <= HIGH(nestBufs) DO
      nestBufs[i][0] := CHR(0); nestUsed[i] := 0; INC(i)
    END;
    WL("# QBE IR generated by the V3 step-1 backend");
    WL("")
  END OpenModule;

PROCEDURE DataLine (name: ARRAY OF CHAR; isReal: BOOLEAN;
                   init: ARRAY OF CHAR);
  BEGIN
    IF NOT opened THEN RETURN END;
    W("data $"); W(name);
    IF isReal THEN W(" = { d ") ELSE W(" = { w ") END;
    W(init);
    WL(" }")
  END DataLine;

PROCEDURE DataLineL (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
  BEGIN
    IF NOT opened THEN RETURN END;
    W("data $"); W(name);
    W(" = { l ");
    W(init);
    WL(" }")
  END DataLineL;

PROCEDURE DeclLocal (name: ARRAY OF CHAR; t: INTEGER);
(* Function-local variable: stack slot + static init, recorded. *)
  VAR slot : QVal;
  BEGIN
    AllocLocal(t, slot);
    LocAdd(name, 0, slot, ResClass(t), t)
  END DeclLocal;

PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
(* Module-level variable: emitted as data "$<mod>_<name>". *)
  VAR g : QVal;
  BEGIN
    IF inFunc THEN DeclLocal(name, t); RETURN END;
    Cpy(g, curModName); App(g, "_"); App(g, name);
    IF SymTab.ClassOf(t) = SymTab.ClReal THEN DataLine(g, TRUE, "0")
    ELSIF SymTab.ClassOf(t) = SymTab.ClArray THEN DeclArr(g, t)
    ELSIF SymTab.ClassOf(t) = SymTab.ClSet THEN DeclSet(g, t)
    ELSIF (SymTab.ClassOf(t) = SymTab.ClRecord)
       OR (SymTab.ClassOf(t) = SymTab.ClClass) THEN
      DeclRec(g, t)
    ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
       OR (SymTab.ClassOf(t) = SymTab.ClLong)
       OR (SymTab.ClassOf(t) = SymTab.ClProc) THEN DataLineL(g, "0")
    ELSE DataLine(g, FALSE, "0")
    END
  END DeclVar;

PROCEDURE IsZeroReal (val: ARRAY OF CHAR): BOOLEAN;
(* TRUE when the "d_..." literal denotes zero (checked textually). *)
  VAR i : CARDINAL;
    seen : BOOLEAN;
    ch : CHAR;
  BEGIN
    i := 0;
    IF (Len(val) > 1) AND (val[0] = "d") AND (val[1] = "_") THEN i := 2 END;
    IF (Len(val) > i) AND (val[i] = "-") THEN INC(i) END;
    seen := FALSE;
    WHILE val[i] # CHR(0) DO
      ch := val[i];
      IF (ch >= "0") AND (ch <= "9") THEN
        seen := TRUE;
        IF ch # "0" THEN RETURN FALSE END
      ELSIF (ch # ".") AND (ch # "E") AND (ch # "e")
 AND (ch # "+") AND (ch # "-") THEN
        RETURN FALSE
      END;
      INC(i)
    END;
    RETURN seen
  END IsZeroReal;

PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
  VAR cls : INTEGER;
    mang : QVal;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF inFunc THEN
      Cpy(mang, funcName); App(mang, "_"); App(mang, name);
      LocAdd(name, 1, mang, ResClass(t), t)
    ELSE
      Cpy(mang, curModName); App(mang, "_"); App(mang, name)
    END;
    IF (cls = SymTab.ClStr) OR NOT IsImm(val) THEN
      DataLine(mang, FALSE, "0"); RETURN
    END;
    IF cls = SymTab.ClLong THEN
      DataLineL(mang, val)
    ELSIF cls = SymTab.ClReal THEN
      (* This qbe accepts only integer/zero literals in "data":
         non-zero REALs flush at BeginBody. *)
      DataLine(mang, TRUE, "0");
      IF NOT IsZeroReal(val) AND (nR <= HIGH(rNames)) THEN
        Cpy(rNames[nR], mang); Cpy(rVals[nR], val); INC(nR)
      END
    ELSE DataLine(mang, FALSE, val)
    END
  END DeclConst;

(* ---------------- function body ---------------- *)

PROCEDURE BeginInit (mod: ARRAY OF CHAR);
(* Module BEGIN body as `<mod>_init`; main calls it at startup. *)
  VAR sym : QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    Cpy(sym, mod);
    App(sym, "_init");
    WL("");
    W("export function w $"); W(sym); WL("() {");
    WL("@start");
    IF nInit <= HIGH(initNames) THEN
      Cpy(initNames[nInit], sym); INC(nInit)
    END
  END BeginInit;

PROCEDURE EndInit;
  BEGIN
    Revive;
    WL("  ret 0");
    WL("}")
  END EndInit;

PROCEDURE BeginBody;
  VAR i : CARDINAL;
    t : QVal;
  BEGIN
    IF NOT opened OR inBody THEN RETURN END;
    WL("");
    WL("export function w $main() {");
    WL("@start");
    inBody := TRUE;
    i := 0;
    WHILE i < nR DO
      NewTemp(t);
      W("  "); W(t); W(" =d copy "); WL(rVals[i]);
      StoreVar(rNames[i], t, TRUE);
      INC(i)
    END;
    i := 0;
    WHILE i < nInit DO
      W("  call $"); W(initNames[i]); WL("()");
      INC(i)
    END
  END BeginBody;

PROCEDURE EndModule (name: ARRAY OF CHAR);
  VAR i : CARDINAL;
    fname : ARRAY [0 .. 127] OF CHAR;
    ref : QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    (* Per-unit Lower emission: the grammar's own unit-end EndModule must
       not flush/close/write while the legacy emit is suppressed.  The
       real session image is written by Lower.EndSession. *)
    IF noEmit THEN RETURN END;
    IF NOT inBody THEN BeginBody END;
    IF SymTab.Lookup("ExitCode")
 AND (SymTab.SymKind("ExitCode") = SymTab.KindVar)
 AND SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
      Cpy(ref, "$"); App(ref, name); App(ref, "_ExitCode");
      W("  %ec =w loadw "); WL(ref);
      WL("  ret %ec")
    ELSE
      WL("  ret 0")
    END;
    WL("}");
    (* hoisted nested functions, then deferred data *)
    i := 0;
    WHILE i <= HIGH(nestBufs) DO
      IF nestUsed[i] > 0 THEN
        BufApp(sessBuf, sessUsed, nestBufs[i], FALSE)
      END;
      INC(i)
    END;
    FlushStrings;
    FlushUStrings;
    FlushCtors;
    EmitVTables;
    FwdPatchAll;
    (* the image is named after the program module *)
    fname[0] := CHR(0);
    App(fname, "gen_ssa/");
    IF hasOutName THEN App(fname, outName) ELSE App(fname, name) END;
    App(fname, ".ssa");
    FileIO.Open(out, fname, TRUE);
    IF FileIO.Okay THEN
      (* Flush exactly sessUsed bytes. FileIO.WriteString scans for a
         NUL and misbehaves for multi-megabyte buffers, so write the
         image byte by byte up to sessUsed. *)
      i := 0;
      WHILE i < sessUsed DO
        FileIO.Write(out, sessBuf[i]); INC(i)
      END
    END;
    FileIO.Close(out);
    opened := FALSE
  END EndModule;

(* ---------------- functions and calls (step 4.1) ---------------- *)
(* Module-level procedures only (nested → NoEmit until 4.2).
   Value params arrive as SSA values and are copied to slots;
   composite value params arrive as addresses and are copied;
   VAR params stay addresses. Locals live in stack slots. *)

PROCEDURE LocFind (name: ARRAY OF CHAR): INTEGER;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nLoc DO
      IF SymTab.Equal(locNames[i], name) THEN RETURN VAL(INTEGER, i) END;
      INC(i)
    END;
    RETURN -1
  END LocFind;

PROCEDURE ScopeBegin;
(* Pushes a procedure scope (always balanced, even under NoEmit). *)
  BEGIN
    IF scopeTop > HIGH(scopeLink) THEN RETURN END;
    scopeBase[scopeTop] := nLoc;
    INC(scopeTop);
    scopeBase[scopeTop] := nLoc
  END ScopeBegin;

PROCEDURE ScopeEnd;
  BEGIN
    IF scopeTop > 0 THEN
      DEC(scopeTop);
      nLoc := scopeBase[scopeTop]
    END
  END ScopeEnd;

PROCEDURE LocFindUp (name: ARRAY OF CHAR; VAR levels: CARDINAL;
                      VAR flat: INTEGER): BOOLEAN;
(* Innermost procedure scope holding name; levels = scopes crossed,
   flat = table index. FALSE when purely global. *)
  VAR s, top, lo, hi, j : CARDINAL;
  BEGIN
    levels := 0; flat := -1;
    IF scopeTop = 0 THEN RETURN FALSE END;
    top := scopeTop - 1;
    s := top;
    LOOP
      lo := scopeBase[s];
      IF s = top THEN hi := nLoc ELSE hi := scopeBase[s + 1] END;
      j := lo;
      WHILE j < hi DO
        IF SymTab.Equal(locNames[j], name) THEN
          levels := top - s;
          flat := VAL(INTEGER, j);
          RETURN TRUE
        END;
        INC(j)
      END;
      IF s = 0 THEN RETURN FALSE END;
      DEC(s)
    END
  END LocFindUp;

PROCEDURE LocAdd (name: ARRAY OF CHAR; tag: INTEGER; rep: ARRAY OF CHAR;
                   cls: CHAR; typ: INTEGER);
  VAR idx : CARDINAL;
    off : QVal;
    lk : QVal;
  BEGIN
    IF (scopeTop = 0) OR (nLoc > HIGH(locNames)) THEN RETURN END;
    idx := nLoc - scopeBase[scopeTop - 1];
    IF idx > 63 THEN RETURN END;
    Cpy(locNames[nLoc], name);
    locTag[nLoc] := tag;
    Cpy(locRep[nLoc], rep);
    locCls[nLoc] := cls;
    locTyp[nLoc] := typ;
    INC(nLoc);
    IF tag = 1 THEN RETURN END;
    Cpy(lk, scopeLink[scopeTop - 1]);
    IntStr(VAL(INTEGER, 8 * (idx + 1)), off);
    NewTemp(lk);
    Op3L("add", lk, scopeLink[scopeTop - 1], off);
    Revive;
    W("  storel "); W(rep); W(", "); WL(lk)
  END LocAdd;

PROCEDURE LocFull (): BOOLEAN;
(* TRUE past 64 locals in the current scope (→ 233). *)
  BEGIN
    IF scopeTop = 0 THEN RETURN FALSE END;
    RETURN nLoc - scopeBase[scopeTop - 1] > 63
  END LocFull;

PROCEDURE UpAddr (levels: CARDINAL; rel: CARDINAL; VAR q: QVal);
(* Address of an up-level local: walks the static chain, then
   loads the link cell (slot address or actual address). *)
  VAR cur, t, off : QVal;
    L : CARDINAL;
  BEGIN
    Cpy(cur, scopeLink[scopeTop - 1]);
    L := levels;
    WHILE L > 0 DO
      NewTemp(t);
      Revive;
      W("  "); W(t); W(" =l loadl "); WL(cur);
      Cpy(cur, t);
      DEC(L)
    END;
    IntStr(VAL(INTEGER, 8 * (rel + 1)), off);
    NewTemp(t);
    Op3L("add", t, cur, off);
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l loadl "); WL(t)
  END UpAddr;

PROCEDURE ResClass (t: INTEGER): CHAR;
  VAR cls : INTEGER;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClReal THEN RETURN "d" END;
    IF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
       OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
       OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
       OR (cls = SymTab.ClProc) THEN
      RETURN "l"
    END;
    RETURN "w"
  END ResClass;

PROCEDURE Mangled (pname: ARRAY OF CHAR; uid: CARDINAL; VAR q: QVal);
(* External procedures bind to their C link name; everything else
   mangles to <name>_<uid> (deterministic, collision-free). *)
  VAR link, base : SymTab.Name;
  BEGIN
    IF SymTab.ProcLink(pname, link) THEN
      Cpy(q, link);
      RETURN
    END;
    IF NOT SymTab.SymBase(pname, base) THEN Cpy(base, pname) END;
    Cpy(q, base);
    App(q, "_");
    AppNum(q, uid)
  END Mangled;

PROCEDURE AllocLocal (t: INTEGER; VAR slot: QVal);
(* Stack slot sized for t's inline footprint; arrays/records get
   full objects + static init. Scalar/pointer/set slots are
   zero-initialized: QBE rejects reads of never-stored slots, and
   the frontend emits a dead load for assignment targets (Test2
   heritage, harmless for zero-initialized globals). Locals match
   the globals' zero-init convention. *)
  VAR cls : INTEGER;
    nb : QVal;
  BEGIN
    cls := SymTab.ClassOf(t);
    NewTemp(slot);
    Revive;
    W("  "); W(slot);
    IF (cls = SymTab.ClArray) THEN
      IntStr(VAL(INTEGER, HeapSize(t)), nb);
      W(" =l alloc8 "); WL(nb);
      InitStack(slot, t)
    ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
      IntStr(VAL(INTEGER, SymTab.TypeSize(t)), nb);
      W(" =l alloc8 "); WL(nb);
      InitStack(slot, t)
    ELSIF cls = SymTab.ClSet THEN
      IntStr(VAL(INTEGER, SymTab.SetWords(t) * 4), nb);
      W(" =l alloc8 "); WL(nb);
      SetZero(slot, SymTab.SetWords(t))
    ELSIF cls = SymTab.ClReal THEN
      W(" =l alloc8 8"); WL("");
      W("  stored d_0.0, "); WL(slot)
    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
       OR (cls = SymTab.ClProc) THEN
      W(" =l alloc8 8"); WL("");
      W("  storel 0, "); WL(slot)
    ELSE
      W(" =l alloc4 4"); WL("");
      W("  storew 0, "); WL(slot)
    END
  END AllocLocal;

PROCEDURE BeginFunc (mangled: ARRAY OF CHAR);
(* Opens function context and scope; the header (with a leading
   static-link param) buffers until EndFuncHeader. FORWARD/DefUnit
   paths discard via AbortFunc. *)
  BEGIN
    ScopeBegin;
    INC(funcDepth);
    inFunc := TRUE;
    nPar := 0;
    funcRes := "w";
    Cpy(funcName, mangled);
    hbuf[0] := CHR(0);
    NewTemp(slTmp);
    HApp("l ");
    HApp(slTmp);
    hdrComma := TRUE;
    IF funcDepth > 1 THEN
      outSel := funcDepth - 1;
      IF outSel > HIGH(nestBufs) + 1 THEN
        outSel := HIGH(nestBufs) + 1
      END
    ELSE
      outSel := 0
    END
  END BeginFunc;

PROCEDURE SetFuncRes (t: INTEGER);
  BEGIN
    funcRes := ResClass(t)
  END SetFuncRes;

PROCEDURE HApp (s: ARRAY OF CHAR);
(* Appends to the header buffer (bounded: FormalParams cap it). *)
  VAR i, j : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(hbuf)) AND (hbuf[i] # CHR(0)) DO INC(i) END;
    j := 0;
    WHILE (i < HIGH(hbuf)) AND (j <= HIGH(s)) AND (s[j] # CHR(0)) DO
      hbuf[i] := s[j]; INC(i); INC(j)
    END;
    IF i <= HIGH(hbuf) THEN hbuf[i] := CHR(0) END
  END HApp;

PROCEDURE FuncParam (name: ARRAY OF CHAR; isVar: BOOLEAN;
                     t: INTEGER): BOOLEAN;
  VAR c : CHAR;
    tmp : QVal;
    buf : ARRAY [0 .. 71] OF CHAR;
  BEGIN
    IF nPar > HIGH(parCls) THEN RETURN FALSE END;
    IF isVar THEN c := "l" ELSE c := ResClass(t) END;
    parCls[nPar] := c;
    NewTemp(tmp);
    Cpy(parTmp[nPar], tmp);
    Cpy(parNam[nPar], name);
    parVar[nPar] := isVar;
    parTyp[nPar] := t;
    IF hdrComma THEN HApp(", ") END;
    hdrComma := TRUE;
    buf[0] := c; buf[1] := " "; buf[2] := CHR(0);
    App(buf, tmp);
    HApp(buf);
    INC(nPar);
    RETURN TRUE
  END FuncParam;

PROCEDURE EndFuncHeader;
(* Flushes the buffered header + body label, allocates the link
   record ([0] = parent link), then emits entry copies. *)
  VAR i : CARDINAL;
    slot, nb, lk : QVal;
    cls : INTEGER;
  BEGIN
    W("export function "); Wc(funcRes); W(" $"); W(funcName); W("(");
    W(hbuf);
    WL(") {");
    WL("@start");
    inBody := TRUE;
    NewTemp(lk);
    Cpy(scopeLink[scopeTop - 1], lk);
    Revive;
    W("  "); W(lk); W(" =l alloc8 520"); WL("");
    W("  storel "); W(slTmp); W(", "); WL(lk);
    i := 0;
    WHILE i < nPar DO
      cls := SymTab.ClassOf(parTyp[i]);
      IF parVar[i] THEN
        LocAdd(parNam[i], 2, parTmp[i], parCls[i], parTyp[i])
      ELSE
        AllocLocal(parTyp[i], slot);
        LocAdd(parNam[i], 0, slot, parCls[i], parTyp[i]);
        IF cls = SymTab.ClArray THEN
          CopyArray(slot, parTmp[i], parTyp[i])
        ELSIF cls = SymTab.ClSet THEN
          CopySet(slot, parTmp[i],
            SymTab.SetWords(parTyp[i]), SymTab.SetWords(parTyp[i]))
        ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
          CopyRecord(slot, parTmp[i], parTyp[i])
        ELSIF cls = SymTab.ClReal THEN
          Revive;
          W("  stored "); W(parTmp[i]); W(", "); WL(slot)
        ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
           OR (cls = SymTab.ClLong) THEN
          Revive;
          W("  storel "); W(parTmp[i]); W(", "); WL(slot)
        ELSE
          Revive;
          W("  storew "); W(parTmp[i]); W(", "); WL(slot)
        END
      END;
      INC(i)
    END
  END EndFuncHeader;

PROCEDURE AbortFunc;
(* Discards function context without emitting (DefUnit headings,
   FORWARD, methods): pops the scope, restores the depth. *)
  BEGIN
    ScopeEnd;
    IF funcDepth > 0 THEN DEC(funcDepth) END;
    inFunc := funcDepth > 0;
    inBody := FALSE;
    nPar := 0;
    IF funcDepth > 1 THEN outSel := funcDepth - 1
    ELSE outSel := 0
    END
  END AbortFunc;

PROCEDURE EndFunc (resT: INTEGER);
  VAR rc : CHAR;
  BEGIN
    rc := ResClass(resT);
    Revive;
    IF rc = "d" THEN WL("  ret d_0.0")
    ELSIF rc = "l" THEN WL("  ret 0")
    ELSE WL("  ret 0")
    END;
    WL("}");
    ScopeEnd;
    IF funcDepth > 0 THEN DEC(funcDepth) END;
    inFunc := funcDepth > 0;
    inBody := FALSE;
    IF funcDepth > 1 THEN outSel := funcDepth - 1
    ELSE outSel := 0
    END
  END EndFunc;

PROCEDURE EmitRet (q: ARRAY OF CHAR; hasVal: BOOLEAN);
  BEGIN
    Revive;
    IF hasVal THEN W("  ret "); WL(q)
    ELSE WL("  ret 0")
    END;
    dead := TRUE
  END EmitRet;

PROCEDURE ProcAddr (mangled: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    Cpy(q, "$");
    App(q, mangled)
  END ProcAddr;

PROCEDURE CallBeginInd (callee: ARRAY OF CHAR; resT: INTEGER;
                         isExt: BOOLEAN);
(* Indirect call through the code pointer in `callee`. *)
  BEGIN
    IF callDepth > HIGH(stkName) THEN RETURN END;
    Cpy(stkName[callDepth], callee);
    stkRes[callDepth] := ResClass(resT);
    stkExt[callDepth] := isExt;
    stkInd[callDepth] := TRUE;
    Cpy(stkLink[callDepth], "0");
    stkArg[callDepth][0] := CHR(0);
    stkN[callDepth] := 0;
    INC(callDepth);
    IF recvArmed THEN
      IF NOT CallArg(recvQ, "l") THEN
      END;
      recvArmed := FALSE
    END
  END CallBeginInd;

PROCEDURE VirtCallBegin (obj: ARRAY OF CHAR; slot: INTEGER; resT: INTEGER);
(* Virtual dispatch: load obj's vtable pointer, fetch slot `slot`,
   and begin an indirect call through it.  The receiver (obj) must be
   armed (ArmRecv). *)
  VAR vt, off, ea, fp: QVal;
  BEGIN
    NewTemp(vt);
    W("  "); W(vt); W(" =l loadl "); WL(obj);
    IntStr(slot * 8, off);
    NewTemp(ea);
    Op3L("add", ea, vt, off);
    NewTemp(fp);
    W("  "); W(fp); W(" =l loadl "); WL(ea);
    CallBeginInd(fp, resT, FALSE)
  END VirtCallBegin;

PROCEDURE ArmRecv (q: ARRAY OF CHAR);
(* Arms the receiver for the next class-method call: CallBegin passes
   it as the hidden first argument. *)
  BEGIN
    Cpy(recvQ, q);
    recvArmed := TRUE
  END ArmRecv;

PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
                       fdep: CARDINAL; isExt: BOOLEAN);
(* Pushes a call level; the static link is resolved now (caller
   context cannot change mid-call): module callers pass 0, others
   walk the chain (inFuncDepth - fdep) from their link record.
   External callees take no static link. *)
  VAR walks : INTEGER;
    cur, t : QVal;
  BEGIN
    IF callDepth > HIGH(stkName) THEN RETURN END;
    Cpy(stkName[callDepth], mangled);
    stkRes[callDepth] := ResClass(resT);
    stkExt[callDepth] := isExt;
    stkInd[callDepth] := FALSE;
    stkArg[callDepth][0] := CHR(0);
    stkN[callDepth] := 0;
    IF isExt THEN
      Cpy(stkLink[callDepth], "0")
    ELSIF funcDepth = 0 THEN
      Cpy(stkLink[callDepth], "0")
    ELSE
      walks := VAL(INTEGER, funcDepth) - VAL(INTEGER, fdep);
      Cpy(cur, scopeLink[scopeTop - 1]);
      WHILE walks > 0 DO
        NewTemp(t);
        Revive;
        W("  "); W(t); W(" =l loadl "); WL(cur);
        Cpy(cur, t);
        DEC(walks)
      END;
      Cpy(stkLink[callDepth], cur)
    END;
    INC(callDepth);
    IF recvArmed THEN
      (* class method: the receiver is the hidden first argument *)
      IF NOT CallArg(recvQ, "l") THEN
      END;
      recvArmed := FALSE
    END
  END CallBegin;

PROCEDURE CallArg (q: ARRAY OF CHAR; cls: CHAR): BOOLEAN;
(* Appends "c operand, " to the current level. FALSE when full. *)
  VAR need, have, i, j, d : CARDINAL;
  BEGIN
    d := callDepth - 1;
    IF callDepth = 0 THEN RETURN FALSE END;
    IF d > HIGH(stkArg) THEN d := HIGH(stkArg) END;
    need := Len(q) + 5;
    have := Len(stkArg[d]);
    IF (stkN[d] >= 64) OR (have + need > HIGH(stkArg[d])) THEN
      RETURN FALSE
    END;
    i := have; j := 0;
    stkArg[d][i] := cls; INC(i);
    stkArg[d][i] := " "; INC(i);
    WHILE q[j] # CHR(0) DO
      stkArg[d][i] := q[j]; INC(i); INC(j)
    END;
    stkArg[d][i] := ","; INC(i);
    stkArg[d][i] := " "; INC(i);
    stkArg[d][i] := CHR(0);
    INC(stkN[d]);
    RETURN TRUE
  END CallArg;

PROCEDURE CallEnd (wantRes: BOOLEAN; VAR q: QVal);
  VAR i, d : CARDINAL;
    rc : CHAR;
    body : ARRAY [0 .. 1023] OF CHAR;
  BEGIN
    IF callDepth = 0 THEN Cpy(q, "0"); RETURN END;
    DEC(callDepth);
    d := callDepth;
    IF d > HIGH(stkArg) THEN d := HIGH(stkArg) END;
    Cpy(funcName, stkName[d]);
    rc := stkRes[d];
    i := 0;
    WHILE (stkArg[d][i] # CHR(0)) AND (i < HIGH(body)) DO
      body[i] := stkArg[d][i]; INC(i)
    END;
    IF (i >= 2) AND (body[i-2] = ",") THEN
      body[i-2] := CHR(0)
    ELSE
      body[i] := CHR(0)
    END;
    Revive;
    IF wantRes THEN
      NewTemp(q);
      W("  "); W(q); W(" ="); Wc(rc)
    ELSE
      W("  ")
    END;
    IF stkInd[d] THEN
      W(" call "); W(funcName); W("(")   (* callee operand already %-prefixed *)
    ELSE
      W(" call $"); W(funcName); W("(")
    END;
    IF stkExt[d] THEN
      W(body)                       (* C callee: no static link *)
    ELSE
      W("l "); W(stkLink[d]);
      IF body[0] # CHR(0) THEN W(", "); W(body) END
    END;
    WL(")")
  END CallEnd;

PROCEDURE InitStack (addr: ARRAY OF CHAR; t: INTEGER);
  BEGIN
    useStack := TRUE;
    InitHeap(addr, t);
    useStack := FALSE
  END InitStack;

PROCEDURE ArgClass (t: INTEGER): CHAR;
(* Formal/actual class for call emission. *)
  BEGIN
    RETURN ResClass(t)
  END ArgClass;

PROCEDURE CArg (q: ARRAY OF CHAR; t: INTEGER; VAR out: QVal;
                VAR cls: CHAR);
  BEGIN
    cls := ArgClass(t);
    IF SymTab.ClassOf(t) = SymTab.ClStr THEN
      NewTemp(out); Op3L("add", out, q, "8"); cls := "l"
    ELSIF (SymTab.ClassOf(t) = SymTab.ClArray)
       AND SymTab.IsCharArray(t) THEN
      NewTemp(out); Op3L("add", out, q, "8"); cls := "l"
    ELSE Cpy(out, q)
    END
  END CArg;

PROCEDURE CArgAdd (q: ARRAY OF CHAR; t: INTEGER; VAR out: QVal;
                   VAR cls: CHAR);
  BEGIN
    CArg(q, t, out, cls);
    IF NOT CallArg(out, cls) THEN END
  END CArgAdd;

(* ---------------- temporaries and operators ---------------- *)

PROCEDURE NewTemp (VAR t: QVal);
  BEGIN
    Cpy(t, "%t");
    AppNum(t, nTemp);
    INC(nTemp)
  END NewTemp;

PROCEDURE LocLoadFlat (idx: INTEGER; long: BOOLEAN; VAR q: QVal);
(* Loads a same-scope entry: slots/data by class (or long for
   pointers), addr entries via ElemLoad. *)
  BEGIN
    IF locTag[idx] = 2 THEN
      ElemLoad(locRep[idx], locTyp[idx], q);
      RETURN
    END;
    NewTemp(q);
    Revive;
    W("  "); W(q);
    IF long THEN W(" =l loadl ")
    ELSIF locCls[idx] = "d" THEN W(" =d loadd ")
    ELSE W(" =w loadw ")
    END;
    IF locTag[idx] = 1 THEN W("$") END;
    WL(locRep[idx])
  END LocLoadFlat;

PROCEDURE LocStoreFlat (idx: INTEGER; q: ARRAY OF CHAR; long: BOOLEAN);
(* Stores a same-scope entry: slots/data by class (or long), addr
   via ElemStore. Data stores are grammar-unreachable (consts). *)
  BEGIN
    IF locTag[idx] = 2 THEN
      ElemStore(locRep[idx], q, locTyp[idx]);
      RETURN
    END;
    Revive;
    IF long THEN W("  storel ")
    ELSIF locCls[idx] = "d" THEN W("  stored ")
    ELSE W("  storew ")
    END;
    W(q); W(", ");
    IF locTag[idx] = 1 THEN W("$") END;
    WL(locRep[idx])
  END LocStoreFlat;

PROCEDURE UpLoad (flat: INTEGER; levels: CARDINAL; long: BOOLEAN;
                   VAR q: QVal);
(* Up-level load: data entries live globally; otherwise the link
   cell yields the address and ElemLoad reads through it. *)
  VAR a : QVal;
    rel : CARDINAL;
  BEGIN
    IF locTag[flat] = 1 THEN
      NewTemp(q);
      Revive;
      W("  "); W(q);
      IF long THEN W(" =l loadl $")
      ELSIF locCls[flat] = "d" THEN W(" =d loadd $")
      ELSE W(" =w loadw $")
      END;
      WL(locRep[flat]);
      RETURN
    END;
    rel := VAL(CARDINAL, flat) - scopeBase[scopeTop - 1 - levels];
    UpAddr(levels, rel, a);
    ElemLoad(a, locTyp[flat], q)
  END UpLoad;

PROCEDURE UpStore (flat: INTEGER; levels: CARDINAL; q: ARRAY OF CHAR;
                    long: BOOLEAN);
  VAR a : QVal;
    rel : CARDINAL;
  BEGIN
    IF locTag[flat] = 1 THEN
      Revive;
      IF long THEN W("  storel ")
      ELSIF locCls[flat] = "d" THEN W("  stored ")
      ELSE W("  storew ")
      END;
      W(q); W(", $"); WL(locRep[flat]);
      RETURN
    END;
    rel := VAL(CARDINAL, flat) - scopeBase[scopeTop - 1 - levels];
    UpAddr(levels, rel, a);
    ElemStore(a, q, locTyp[flat])
  END UpStore;

PROCEDURE UpAddrOf (flat: INTEGER; levels: CARDINAL; VAR q: QVal);
(* Up-level address: data entries name globals; otherwise the
   link cell holds it (composites) or points at it. For scalars
   the cell IS the usable address (slot or actual address). *)
  VAR a : QVal;
    rel : CARDINAL;
  BEGIN
    IF locTag[flat] = 1 THEN
      Cpy(q, "$");
      App(q, locRep[flat]);
      RETURN
    END;
    rel := VAL(CARDINAL, flat) - scopeBase[scopeTop - 1 - levels];
    UpAddr(levels, rel, q)
  END UpAddrOf;

PROCEDURE LoadDesignator (name: ARRAY OF CHAR; t: INTEGER; k: INTEGER;
                           VAR q: QVal): BOOLEAN;
  VAR cls : INTEGER;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF SymTab.Equal(name, "TRUE") THEN
      Cpy(q, "1"); RETURN TRUE
    ELSIF SymTab.Equal(name, "FALSE") THEN
      Cpy(q, "0"); RETURN TRUE
    ELSIF SymTab.Equal(name, "NIL") THEN
      Cpy(q, "0"); RETURN TRUE
    END;
    IF (k = SymTab.KindVar) OR (k = SymTab.KindParam)
       OR (k = SymTab.KindConst) THEN
      IF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
         OR (cls = SymTab.ClChar) OR (cls = SymTab.ClReal) THEN
        LoadVar(name, cls = SymTab.ClReal, q); RETURN TRUE
      ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
        LoadPtr(name, q); RETURN TRUE
      ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
         OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        AddrOf(name, q); RETURN TRUE
      END
    END;
    Cpy(q, "0");
    RETURN FALSE
  END LoadDesignator;

PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocLoadFlat(idx, FALSE, q)
      ELSE UpLoad(idx, levels, FALSE, q)
      END;
      RETURN
    END;
    NewTemp(q);
    Revive;
    SymRef(name, ref);
    W("  "); W(q);
    IF isReal THEN W(" =d loadd ") ELSE W(" =w loadw ") END;
    WL(ref)
  END LoadVar;

PROCEDURE LoadPtr (name: ARRAY OF CHAR; VAR q: QVal);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocLoadFlat(idx, TRUE, q)
      ELSE UpLoad(idx, levels, TRUE, q)
      END;
      RETURN
    END;
    NewTemp(q);
    Revive;
    SymRef(name, ref);
    W("  "); W(q); W(" =l loadl ");
    WL(ref)
  END LoadPtr;

PROCEDURE LoadLong (name: ARRAY OF CHAR; VAR q: QVal);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocLoadFlat(idx, TRUE, q)
      ELSE UpLoad(idx, levels, TRUE, q)
      END;
      RETURN
    END;
    NewTemp(q);
    Revive;
    SymRef(name, ref);
    W("  "); W(q); W(" =l loadl ");
    WL(ref)
  END LoadLong;

PROCEDURE StoreLong (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocStoreFlat(idx, q, TRUE)
      ELSE UpStore(idx, levels, q, TRUE)
      END;
      RETURN
    END;
    Revive;
    SymRef(name, ref);
    W("  storel "); W(q); W(", "); WL(ref)
  END StoreLong;

PROCEDURE WidenLong (a: ARRAY OF CHAR; VAR q: QVal);
(* INTEGER (w) -> LONGINT (l) via extsw. *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l extsw "); WL(a)
  END WidenLong;

PROCEDURE CmpLong (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal);
(* 64-bit comparison (result w). *)
  VAR mn : ARRAY [0 .. 7] OF CHAR;
  BEGIN
    mn[0] := CHR(0);
    IF op = SymTab.OpEq THEN Cpy(mn, "ceql")
    ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cnel")
    ELSIF op = SymTab.OpLt THEN Cpy(mn, "csltl")
    ELSIF op = SymTab.OpLe THEN Cpy(mn, "cslel")
    ELSIF op = SymTab.OpGt THEN Cpy(mn, "csgtl")
    ELSE Cpy(mn, "csgel")
    END;
    NewTemp(q);
    Op3(mn, q, l, r, FALSE)
  END CmpLong;

PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocStoreFlat(idx, q, FALSE)
      ELSE UpStore(idx, levels, q, FALSE)
      END;
      RETURN
    END;
    Revive;
    SymRef(name, ref);
    IF isReal THEN W("  stored ") ELSE W("  storew ") END;
    W(q); W(", "); WL(ref)
  END StoreVar;

PROCEDURE StorePtr (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
  VAR idx : INTEGER;
    levels : CARDINAL;
    ref : QVal;
  BEGIN
    IF LocFindUp(name, levels, idx) THEN
      IF levels = 0 THEN LocStoreFlat(idx, q, TRUE)
      ELSE UpStore(idx, levels, q, TRUE)
      END;
      RETURN
    END;
    Revive;
    SymRef(name, ref);
    W("  storel "); W(q); W(", "); WL(ref)
  END StorePtr;

PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
               isReal: BOOLEAN);
  BEGIN
    Revive;
    W("  "); W(res);
    IF isReal THEN W(" =d ") ELSE W(" =w ") END;
    W(mn); W(" "); W(l); W(", "); WL(r)
  END Op3;

PROCEDURE AbsQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
  VAR c, neg : QVal;
    lNeg, lPos, lDone : QVal;
  BEGIN
    IF isReal THEN Cmp(SymTab.OpLt, a, "d_0.0", c, TRUE)
    ELSE Cmp(SymTab.OpLt, a, "0", c, FALSE)
    END;
    NewLabel(lNeg); NewLabel(lPos); NewLabel(lDone);
    NewTemp(neg);
    NegQ(a, neg, isReal);
    Jnz(c, lNeg, lPos);
    EmitLabel(lNeg);
    CopyOp(neg, q);
    Jmp(lDone);
    EmitLabel(lPos);
    CopyOp(a, q);
    EmitLabel(lDone)
  END AbsQ;

PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
  BEGIN
    NewTemp(q);
    IF isReal THEN Op3("sub", q, "d_0.0", a, TRUE)
    ELSE Op3("sub", q, "0", a, FALSE)
    END
  END NegQ;

PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
(* INTEGER -> REAL widening for assignments (swtof). *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =d swtof "); WL(a)
  END ConvIR;

PROCEDURE NarrowLong (a: ARRAY OF CHAR; VAR q: QVal);
(* LONGINT (l) -> INTEGER (w): keep the low 32 bits. *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =w copy "); WL(a)
  END NarrowLong;

PROCEDURE ConvRI (a: ARRAY OF CHAR; VAR q: QVal);
(* REAL -> INTEGER (truncate toward zero). *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =w dtosi "); WL(a)
  END ConvRI;

PROCEDURE ConvRL (a: ARRAY OF CHAR; VAR q: QVal);
(* REAL -> LONGINT (truncate toward zero). *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l dtosi "); WL(a)
  END ConvRL;

PROCEDURE ConvLR (a: ARRAY OF CHAR; VAR q: QVal);
(* LONGINT -> REAL. *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =d sltof "); WL(a)
  END ConvLR;

PROCEDURE NotQ (a: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    Op3("xor", q, "1", a, FALSE)
  END NotQ;

PROCEDURE CapQ (a: ARRAY OF CHAR; VAR q: QVal);
(* Branchless UPCASE: q := a - 32 * (a >= 'a' AND a <= 'z'). *)
  VAR lo, hi, in1, delta: QVal;
  BEGIN
    NewTemp(lo); Op3("csgew", lo, a, "97", FALSE);
    NewTemp(hi); Op3("cslew", hi, a, "122", FALSE);
    NewTemp(in1); Op3("and", in1, lo, hi, FALSE);
    NewTemp(delta); Op3("mul", delta, in1, "32", FALSE);
    NewTemp(q); Op3("sub", q, a, delta, FALSE)
  END CapQ;

PROCEDURE NewLabel (VAR l: QVal);
  BEGIN
    Cpy(l, "@L");
    AppNum(l, nLab);
    INC(nLab)
  END NewLabel;

PROCEDURE Revive;
(* Opens an unreachable block if past a terminator. Keeps every
   temporary defined and every instruction inside a block, even for
   dead source tails (EXIT followed by more statements) and CASE
   chains whose compares follow a Jmp. Counter-driven: fixpoint-safe. *)
  VAR b: QVal;
  BEGIN
    IF opened AND dead THEN
      NewLabel(b);
      WL(b);
      dead := FALSE
    END
  END Revive;

PROCEDURE EmitLabel (l: ARRAY OF CHAR);
  BEGIN
    WL(l);
    dead := FALSE
  END EmitLabel;

PROCEDURE Jmp (l: ARRAY OF CHAR);
  BEGIN
    IF dead THEN RETURN END;  (* unreachable: a terminator with no
      intervening label can never be reached; emitting it would end
      the block and orphan whatever follows. *)
    W("  jmp "); WL(l);
    dead := TRUE
  END Jmp;

PROCEDURE Jnz (c, t, f: ARRAY OF CHAR);
  BEGIN
    IF dead THEN RETURN END;
    W("  jnz "); W(c); W(", "); W(t); W(", "); WL(f);
    dead := TRUE
  END Jnz;

PROCEDURE Cmp (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal;
               isReal: BOOLEAN);
  VAR mn : ARRAY [0 .. 7] OF CHAR;
  BEGIN
    mn[0] := CHR(0);
    IF isReal THEN
      IF op = SymTab.OpEq THEN Cpy(mn, "ceqd")
      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cned")
      ELSIF op = SymTab.OpLt THEN Cpy(mn, "cltd")
      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cled")
      ELSIF op = SymTab.OpGt THEN Cpy(mn, "cgtd")
      ELSE Cpy(mn, "cged")
      END
    ELSE
      IF op = SymTab.OpEq THEN Cpy(mn, "ceqw")
      ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN Cpy(mn, "cnew")
      ELSIF op = SymTab.OpLt THEN Cpy(mn, "csltw")
      ELSIF op = SymTab.OpLe THEN Cpy(mn, "cslew")
      ELSIF op = SymTab.OpGt THEN Cpy(mn, "csgtw")
      ELSE Cpy(mn, "csgew")
      END
    END;
    NewTemp(q);
    Op3(mn, q, l, r, FALSE)
  END Cmp;

PROCEDURE StrEq (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal);
(* String equality via the shim: q := (l = r) as a BOOLEAN, negated for
   OpNeq.  Operands are descriptor addresses; the shim strcmps the
   NUL-terminated contents. *)
  VAR t: QVal;
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =w call $m2streq(l ");
    W(l); W(", l "); W(r); WL(")");
    IF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN
      NewTemp(t);
      W("  "); W(t); W(" =w xor "); W(q); WL(", 1");
      Cpy(q, t)
    END
  END StrEq;

PROCEDURE StrAssign (dst, src: ARRAY OF CHAR);
(* Copy the string src into the CHAR array at dst (content copy,
   truncated to the destination capacity, NUL-terminated). *)
  BEGIN
    W("  call $m2strassign(l "); W(dst); W(", l "); W(src); WL(")")
  END StrAssign;

PROCEDURE UAssign (dst, src: ARRAY OF CHAR);
(* Copy a U"..." descriptor (count + 4-byte codepoints) into the UCHAR
   array at dst: min(count, capacity) codepoints + a 0 terminator. *)
  BEGIN
    W("  call $m2uassign(l "); W(dst); W(", l "); W(src); WL(")")
  END UAssign;

PROCEDURE UStrLen (s: ARRAY OF CHAR; VAR q: QVal);
(* q := the UString codepoint count (INTEGER). *)
  VAR t: QVal;
  BEGIN
    NewTemp(t);
    W("  "); W(t); W(" =w call $m2ustrlen(l "); W(s); WL(")");
    Cpy(q, t)
  END UStrLen;

PROCEDURE DecQ (VAR q: QVal);
(* q := q - 1 (w domain; q is an INTEGER count). *)
  VAR t: QVal;
  BEGIN
    NewTemp(t);
    Op3("sub", t, q, "1", FALSE);
    Cpy(q, t)
  END DecQ;

PROCEDURE UStrCat (a, b: ARRAY OF CHAR; VAR q: QVal);
(* q := a + b (a UString descriptor in the shim's concat buffer). *)
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =l call $m2ustrcat(l "); W(a); W(", l "); W(b); WL(")")
  END UStrCat;

PROCEDURE UStrFrom (cp: ARRAY OF CHAR; VAR q: QVal);
(* q := a 1-codepoint UString descriptor for the UCHAR value cp. *)
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =l call $m2ustrfrom(l "); W(cp); WL(")")
  END UStrFrom;

PROCEDURE StrCat (a, b: ARRAY OF CHAR; VAR q: QVal);
(* q := a + b (a descriptor in the shim's concat buffer). *)
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =l call $m2strcat(l "); W(a); W(", l "); W(b); WL(")")
  END StrCat;

(* ---------------- arrays: length-prefixed layout ---------------- *)
(* Indexes and counts are LONGCARD (l) in emitted code; immediates
   pass through, w-temps widen via extsw. Traps call $abort + hlt
   (interim; runtime/syslib/Trap replaces them later). *)

PROCEDURE ElemCls (t: SymTab.TypeIndex): INTEGER;
  BEGIN
    RETURN SymTab.ClassOf(SymTab.ArrayElem(t))
  END ElemCls;

PROCEDURE ElemSize (t: SymTab.TypeIndex): CARDINAL;
(* Storage size of t's elements: CHAR 1, REAL 8, nested/pointer/long 8,
   records/classes/sets their inline footprint, else 4.  t is an array
   (or string) descriptor. *)
  VAR cls: INTEGER; et: SymTab.TypeIndex;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClStr THEN RETURN 1 END;
    et := SymTab.ArrayElem(t);
    cls := SymTab.ClassOf(et);
    IF cls = SymTab.ClChar THEN RETURN 1
    ELSIF cls = SymTab.ClReal THEN RETURN 8
    ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
       OR (cls = SymTab.ClLong) THEN RETURN 8
    ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
       OR (cls = SymTab.ClSet) THEN
      RETURN SymTab.TypeSize(et)
    ELSE RETURN 4
    END
  END ElemSize;

PROCEDURE Op3L (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR);
  BEGIN
    Revive;
    W("  "); W(res);
    W(" =l ");
    W(mn); W(" "); W(l); W(", "); WL(r)
  END Op3L;

PROCEDURE HaltQ;
  BEGIN
    Revive;
    WL("  call $exit(w 1)");
    WL("  hlt");
    dead := TRUE
  END HaltQ;

PROCEDURE Trap;
  BEGIN
    Revive;
    WL("  call $abort()");
    WL("  hlt");
    dead := TRUE
  END Trap;

(* ---------------- records: flat blobs, pointer fields ---------------- *)
(* Scalars/sets inline, array fields as inline descriptors (8-byte length
   word + data), nested records inline. Static offsets throughout. *)

PROCEDURE HasNestedArray (t: SymTab.TypeIndex): BOOLEAN;
(* TRUE when record type t (recursively) has an ARRAY OF ARRAY field,
   i.e. a field whose element is itself an array.  Only such record
   arrays need per-element expansion (their nested sub-descriptors must
   be emitted); plain record arrays stay a compact zero blob. *)
  VAR i: CARDINAL; fn: SymTab.Name; ft, et: SymTab.TypeIndex; cls: INTEGER;
  BEGIN
    i := 0;
    WHILE i < SymTab.FieldCount(t) DO
      SymTab.FieldName(t, i, fn);
      ft := SymTab.FieldType(t, fn);
      cls := SymTab.ClassOf(ft);
      IF cls = SymTab.ClArray THEN
        et := SymTab.ArrayElem(ft);
        IF SymTab.ClassOf(et) = SymTab.ClArray THEN RETURN TRUE END
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        IF HasNestedArray(ft) THEN RETURN TRUE END
      END;
      INC(i)
    END;
    RETURN FALSE
  END HasNestedArray;

PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
(* Inline contents of an array descriptor (no "data $name = {" wrapper
   and no closing brace): "l <n>[, <elem>...]".  Nested levels are
   referenced as $prefix_i (emitted by ArrData).  Record/class elements
   with nested-array fields are expanded per element (EmitRec) so their
   sub-descriptors are referenced; others stay a compact zero blob. *)
   VAR n, i: CARDINAL;
     elem: SymTab.TypeIndex;
     ecls: INTEGER;
     esz: CARDINAL;
     bv, sub: QVal;
     first: BOOLEAN;

   (* One inline record: mirrors RecItems (same field order and comma
      handling), but array fields recurse into the enclosing
      ArrBodyItems.  Nested here so no FORWARD declaration is needed. *)
   PROCEDURE EmitRec (rt: SymTab.TypeIndex; rpre: ARRAY OF CHAR;
                      VAR first: BOOLEAN);
     VAR i, k, w: CARDINAL;
       fn: SymTab.Name;
       ft: SymTab.TypeIndex;
       cls: INTEGER;
       rsub: QVal;

     PROCEDURE Sep;
       BEGIN
         IF first THEN first := FALSE ELSE W(", ") END
       END Sep;

     BEGIN
       i := 0;
       WHILE i < SymTab.FieldCount(rt) DO
         SymTab.FieldName(rt, i, fn);
         ft := SymTab.FieldType(rt, fn);
         cls := SymTab.ClassOf(ft);
         IF cls = SymTab.ClReal THEN Sep; W("d 0")
         ELSIF cls = SymTab.ClChar THEN Sep; W("b 0")
         ELSIF cls = SymTab.ClArray THEN
           Sep;
           Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
           ArrBodyItems(rsub, ft)
         ELSIF cls = SymTab.ClSet THEN
           w := SymTab.SetWords(ft);
           IF w = 0 THEN w := 1 END;
           Sep; W("w 0");
           k := 1;
           WHILE k < w DO W(", w 0"); INC(k) END
         ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
           Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
           EmitRec(ft, rsub, first)
         ELSE Sep; W("w 0")
         END;
         INC(i)
       END
     END EmitRec;

   BEGIN
    n := SymTab.ArrayLen(t);
    elem := SymTab.ArrayElem(t);
    ecls := SymTab.ClassOf(elem);
    W("l ");
    IntStr(VAL(INTEGER, n), bv);
    W(bv);
    IF ecls = SymTab.ClArray THEN
      i := 0;
      WHILE i < n DO
        W(", l $"); W(prefix); W("_");
        IntStr(VAL(INTEGER, i), bv);
        W(bv);
        INC(i)
      END
    ELSIF ((ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass))
       AND HasNestedArray(elem) THEN
      (* Per-element record expansion: nested-array field descriptors. *)
      i := 0;
      WHILE i < n DO
        Cpy(sub, prefix); App(sub, "_");
        IntStr(VAL(INTEGER, i), bv); App(sub, bv);
        first := FALSE;
        EmitRec(elem, sub, first);
        INC(i)
      END
    ELSE
      IF ecls = SymTab.ClChar THEN
        (* CHAR: n data bytes + one NUL terminator slot *)
        W(", z ");
        IntStr(VAL(INTEGER, n + 1), bv);
        W(bv)
      ELSIF ecls = SymTab.ClUChar THEN
        (* UCHAR: n codepoints + one 0-codepoint terminator slot *)
        W(", z ");
        IntStr(VAL(INTEGER, (n + 1) * 4), bv);
        W(bv)
      ELSE
        IF (ecls = SymTab.ClReal) OR (ecls = SymTab.ClPtr)
           OR (ecls = SymTab.ClProc) OR (ecls = SymTab.ClLong) THEN esz := 8
        ELSIF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass)
           OR (ecls = SymTab.ClSet) THEN
          (* inline footprint, not a fixed 4 (same fix as ElemSize) *)
          esz := SymTab.TypeSize(elem)
        ELSE esz := 4
        END;
        IF n > 0 THEN
          W(", z ");
          IntStr(VAL(INTEGER, n * esz), bv);
          W(bv)
        END
      END
    END
   END ArrBodyItems;

PROCEDURE ArrData (name: ARRAY OF CHAR; t: INTEGER);
(* "data $name = { <items> }" plus, for nested levels, the recursive
   sub-descriptor data $name_i. *)
   VAR n, i: CARDINAL;
     elem: SymTab.TypeIndex;
     bv: QVal;
     sub: QVal;

   (* Mirrors RecStatics, but nested-array sub-descriptors recurse into
      the enclosing ArrData.  Nested here so no FORWARD is needed. *)
   PROCEDURE EmitRecStatics (rpre: ARRAY OF CHAR; rt: SymTab.TypeIndex);
     VAR k, j, an: CARDINAL;
       fn: SymTab.Name;
       ft, et: SymTab.TypeIndex;
       cls: INTEGER;
       rsub, bv2: QVal;
   BEGIN
     k := 0;
     WHILE k < SymTab.FieldCount(rt) DO
       SymTab.FieldName(rt, k, fn);
       ft := SymTab.FieldType(rt, fn);
       cls := SymTab.ClassOf(ft);
       IF cls = SymTab.ClArray THEN
         et := SymTab.ArrayElem(ft);
         IF SymTab.ClassOf(et) = SymTab.ClArray THEN
           an := SymTab.ArrayLen(ft);
           j := 0;
           WHILE j < an DO
             Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
             App(rsub, "_");
             IntStr(VAL(INTEGER, j), bv2);
             App(rsub, bv2);
             ArrData(rsub, et);
             INC(j)
           END
         END
       ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
         Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
         EmitRecStatics(rsub, ft)
       END;
       INC(k)
     END
   END EmitRecStatics;

   BEGIN
    IF NOT opened THEN RETURN END;
    W("data $"); W(name);
    W(" = { ");
    ArrBodyItems(name, t);
    WL(" }");
    elem := SymTab.ArrayElem(t);
    IF SymTab.ClassOf(elem) = SymTab.ClArray THEN
      n := SymTab.ArrayLen(t);
      i := 0;
      WHILE i < n DO
        Cpy(sub, name); App(sub, "_");
        IntStr(VAL(INTEGER, i), bv);
        App(sub, bv);
        ArrData(sub, elem);
        INC(i)
      END
    ELSIF ((SymTab.ClassOf(elem) = SymTab.ClRecord)
           OR (SymTab.ClassOf(elem) = SymTab.ClClass))
       AND HasNestedArray(elem) THEN
      (* Sub-descriptors referenced (as $name_i_field_k) from the inline
         items emitted by ArrBodyItems; one set per element. *)
      n := SymTab.ArrayLen(t);
      i := 0;
      WHILE i < n DO
        Cpy(sub, name); App(sub, "_");
        IntStr(VAL(INTEGER, i), bv);
        App(sub, bv);
        EmitRecStatics(sub, elem);
        INC(i)
      END
    END
   END ArrData;

PROCEDURE RecStatics (recname: ARRAY OF CHAR; t: SymTab.TypeIndex);
(* Pre-pass: static sub-descriptors for NESTED array fields (the
   top-level array field is now inline in the record), recursive. *)
  VAR n, i, k, an: CARDINAL;
    fn: SymTab.Name;
    ft, et: SymTab.TypeIndex;
    cls: INTEGER;
    sub, bv: QVal;
  BEGIN
    n := SymTab.FieldCount(t);
    i := 0;
    WHILE i < n DO
      SymTab.FieldName(t, i, fn);
      ft := SymTab.FieldType(t, fn);
      cls := SymTab.ClassOf(ft);
      IF cls = SymTab.ClArray THEN
        et := SymTab.ArrayElem(ft);
        IF SymTab.ClassOf(et) = SymTab.ClArray THEN
          an := SymTab.ArrayLen(ft);
          k := 0;
          WHILE k < an DO
            Cpy(sub, recname); App(sub, "_"); App(sub, fn);
            App(sub, "_");
            IntStr(VAL(INTEGER, k), bv);
            App(sub, bv);
            ArrData(sub, et);
            INC(k)
          END
        END
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        Cpy(sub, recname); App(sub, "_"); App(sub, fn);
        RecStatics(sub, ft)
      END;
      INC(i)
    END
  END RecStatics;

PROCEDURE RecItems (t: SymTab.TypeIndex; prefix: ARRAY OF CHAR;
                    VAR first: BOOLEAN);
(* Comma-separated item list (no wrapper); nested records inline.
   Emission order follows the (prepend-built) field chain, i.e.
   reverse declaration; offsets (not positions) place everything. *)
  VAR n, i, k, w: CARDINAL;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    cls: INTEGER;
    sub: QVal;

  PROCEDURE Sep;
    BEGIN
      IF first THEN first := FALSE ELSE W(", ") END
    END Sep;

  BEGIN
    n := SymTab.FieldCount(t);
    i := 0;
    WHILE i < n DO
      SymTab.FieldName(t, i, fn);
      ft := SymTab.FieldType(t, fn);
      cls := SymTab.ClassOf(ft);
      IF cls = SymTab.ClReal THEN Sep; W("d 0")
      ELSIF cls = SymTab.ClChar THEN Sep; W("b 0")
      ELSIF cls = SymTab.ClArray THEN
        (* array field: inline descriptor (was a pointer) *)
        Sep;
        Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
        ArrBodyItems(sub, ft)
      ELSIF cls = SymTab.ClSet THEN
        w := SymTab.SetWords(ft);
        IF w = 0 THEN w := 1 END;
        Sep; W("w 0");
        k := 1;
        WHILE k < w DO W(", w 0"); INC(k) END
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
        RecItems(ft, sub, first)
      ELSE Sep; W("w 0")
      END;
      INC(i)
    END
  END RecItems;

PROCEDURE VtRef (t: INTEGER; VAR q: QVal);
(* The class's vtable symbol ($vt_<typeindex>). *)
  VAR bv: QVal;
  BEGIN
    Cpy(q, "$vt_");
    IntStr(t, bv);
    App(q, bv)
  END VtRef;

PROCEDURE EmitVTables;
(* One data array per class with a vtable: slots (inherited first) as
   method code addresses. *)
  VAR k, j, n: CARDINAL;
    t: INTEGER;
    nm: SymTab.Name;
    mg, vt: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    k := 0;
    WHILE k < SymTab.VtClassCount() DO
      t := SymTab.VtClassAt(k);
      n := SymTab.VtCount(t);
      VtRef(t, vt);
      W("data "); W(vt); W(" = { ");
      j := 0;
      WHILE j < n DO
        IF SymTab.VtName(t, j, nm) THEN
          IF j > 0 THEN W(", ") END;
          IF SymTab.VtHasBody(t, j) THEN
            Mangled(nm, SymTab.VtUid(t, j), mg);
            W("l $"); W(mg)
          ELSE
            W("l 0")   (* declared but never implemented *)
          END
        END;
        INC(j)
      END;
      IF n = 0 THEN W("l 0") END;
      WL(" }");
      INC(k)
    END
  END EmitVTables;

PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
  VAR first: BOOLEAN;
    vt, sz: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    IF SymTab.IsVariant(t) AND (SymTab.ClassOf(t) = SymTab.ClRecord) THEN
      (* variant record: fields overlay, so emit one zero-filled blob
         of the record's (max) size *)
      IntStr(VAL(INTEGER, SymTab.TypeSize(t)), sz);
      W("data $"); W(name); W(" = { z "); W(sz); WL(" }");
      RETURN
    END;
    RecStatics(name, t);
    W("data $"); W(name);
    W(" = { ");
    first := TRUE;
    (* a class with a vtable stores its vtable pointer at offset 0 *)
    IF (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
      VtRef(t, vt);
      W("l "); W(vt);
      first := FALSE
    END;
    RecItems(t, name, first);
    IF first THEN W("w 0") END;
    WL(" }")
  END DeclRec;

PROCEDURE FieldAddr (base: ARRAY OF CHAR; off: INTEGER; VAR q: QVal);
  VAR sb: QVal;
  BEGIN
    NewTemp(q);
    IntStr(off, sb);
    Op3L("add", q, base, sb)
  END FieldAddr;

PROCEDURE ThisBase (VAR q: QVal);
(* The current method's receiver address (the hidden THIS VAR param). *)
  BEGIN
    AddrOf("THIS", q)
  END ThisBase;

PROCEDURE PushWith (base: ARRAY OF CHAR);
  BEGIN
    IF withTop <= HIGH(withSt) THEN
      Cpy(withSt[withTop], base); INC(withTop)
    END
  END PushWith;

PROCEDURE PopWith;
  BEGIN
    IF withTop > 0 THEN DEC(withTop) END
  END PopWith;

PROCEDURE TopWith (VAR base: QVal): BOOLEAN;
  BEGIN
    IF withTop = 0 THEN RETURN FALSE END;
    Cpy(base, withSt[withTop - 1]);
    RETURN TRUE
  END TopWith;

PROCEDURE CopyRecord (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                       t: INTEGER);
(* Whole-record copy: a flat byte blit of the record's (max) size.
   Records are flat blobs (scalars/sets/pointers inline, arrays and
   nested records inline), so this is correct — and the only correct
   choice for variant records, whose fields overlay. *)
  VAR n: QVal;
  BEGIN
    IntStr(VAL(INTEGER, SymTab.TypeSize(t)), n);
    Revive;
    W("  call $memcpy(l "); W(dst); W(", l "); W(src);
    W(", l "); W(n); WL(")")
  END CopyRecord;

PROCEDURE WordsBytes (words: CARDINAL): CARDINAL;
  BEGIN
    IF words = 0 THEN RETURN 8 END;
    RETURN ((words * 4 + 7) DIV 8) * 8
  END WordsBytes;

PROCEDURE DeclSet (name: ARRAY OF CHAR; t: INTEGER);
  VAR w, i: CARDINAL;
  BEGIN
    IF NOT opened THEN RETURN END;
    w := SymTab.SetWords(t);
    IF w = 0 THEN w := 1 END;
    W("data $"); W(name);
    W(" = { w 0");
    i := 1;
    WHILE i < w DO
      W(", w 0");
      INC(i)
    END;
    WL(" }")
  END DeclSet;

PROCEDURE NewSetTemp (words: CARDINAL; VAR q: QVal);
  VAR nb: QVal;
  BEGIN
    NewTemp(q);
    Revive;
    IntStr(VAL(INTEGER, WordsBytes(words)), nb);
    W("  "); W(q); W(" =l alloc8 "); WL(nb)
  END NewSetTemp;

PROCEDURE SetZero (addr: ARRAY OF CHAR; words: CARDINAL);
  VAR i: CARDINAL;
    a, z, off: QVal;
  BEGIN
    NewTemp(z);
    Op3("xor", z, "0", "0", FALSE);
    i := 0;
    WHILE i < words DO
      NewTemp(a);
      IntStr(VAL(INTEGER, i * 4), off);
      Op3L("add", a, addr, off);
      Revive;
      W("  storew "); W(z); W(", "); WL(a);
      INC(i)
    END
  END SetZero;

PROCEDURE SetBit (addr: ARRAY OF CHAR; val: ARRAY OF CHAR;
                   lo: INTEGER; span: CARDINAL);
(* ORs one element in: off = val - lo trapped in [0, span). *)
  VAR off, offL, hiS, loS: QVal;
    wi, bi, wil, off4, wa, wcur, m, wn: QVal;
  BEGIN
    NewTemp(off);
    IntStr(lo, loS);
    Op3("sub", off, val, loS, FALSE);
    WidenIndex(off, offL);
    IntStr(VAL(INTEGER, span) - 1, hiS);
    CheckRange(offL, "0", hiS);
    NewTemp(wi);
    Op3("shr", wi, off, "5", FALSE);
    NewTemp(bi);
    Op3("and", bi, off, "31", FALSE);
    WidenIndex(wi, wil);
    NewTemp(off4);
    Op3L("mul", off4, wil, "4");
    NewTemp(wa);
    Op3L("add", wa, addr, off4);
    NewTemp(m);
    Op3("shl", m, "1", bi, FALSE);
    NewTemp(wcur);
    W("  "); W(wcur); W(" =w loadw "); WL(wa);
    NewTemp(wn);
    Op3("or", wn, wcur, m, FALSE);
    Revive;
    W("  storew "); W(wn); W(", "); WL(wa)
  END SetBit;

PROCEDURE SetClearBit (addr: ARRAY OF CHAR; val: ARRAY OF CHAR;
                       lo: INTEGER; span: CARDINAL);
(* ANDs one element out: off = val - lo trapped in [0, span). *)
  VAR off, offL, hiS, loS: QVal;
    wi, bi, wil, off4, wa, wcur, m, nm, wn: QVal;
  BEGIN
    NewTemp(off);
    IntStr(lo, loS);
    Op3("sub", off, val, loS, FALSE);
    WidenIndex(off, offL);
    IntStr(VAL(INTEGER, span) - 1, hiS);
    CheckRange(offL, "0", hiS);
    NewTemp(wi);
    Op3("shr", wi, off, "5", FALSE);
    NewTemp(bi);
    Op3("and", bi, off, "31", FALSE);
    WidenIndex(wi, wil);
    NewTemp(off4);
    Op3L("mul", off4, wil, "4");
    NewTemp(wa);
    Op3L("add", wa, addr, off4);
    NewTemp(m);
    Op3("shl", m, "1", bi, FALSE);
    NewTemp(nm);
    Op3("xor", nm, m, "-1", FALSE);
    NewTemp(wcur);
    W("  "); W(wcur); W(" =w loadw "); WL(wa);
    NewTemp(wn);
    Op3("and", wn, wcur, nm, FALSE);
    Revive;
    W("  storew "); W(wn); W(", "); WL(wa)
  END SetClearBit;

PROCEDURE SetShift (src: ARRAY OF CHAR; n: ARRAY OF CHAR;
                    words: CARDINAL; span: CARDINAL; isRot: BOOLEAN;
                    VAR q: QVal);
(* Bit-by-bit shift/rotate by a runtime amount n over [0, span);
   bits that leave the span are dropped (SHIFT) or wrapped (ROTATE). *)
  VAR out, nn, sp, hi, i: QVal;
    wi, bi, wil, off4, wa, m, t, bit, nzb: QVal;
    j, c, cs, jw: QVal;
    ok1, ok2, ok, wj, bj, wjl, o2, wb2, mm, mm2, mm3: QVal;
    wcur, wn, ip1: QVal;
    ltop, lbody, lend: QVal;
  BEGIN
    NewSetTemp(words, out);
    SetZero(out, words);
    Cpy(nn, n);
    IntStr(VAL(INTEGER, span), sp);
    IntStr(VAL(INTEGER, span) - 1, hi);
    IF isRot THEN
      NewTemp(j);   Op3("rem", j, n, sp, FALSE);
      NewTemp(ok1); Op3("add", ok1, j, sp, FALSE);
      NewTemp(cs);  Op3("rem", cs, ok1, sp, FALSE);
      Cpy(nn, cs)
    END;
    NewTemp(i);   Op3("add", i, "0", "0", FALSE);
    NewLabel(ltop); NewLabel(lbody); NewLabel(lend);
    EmitLabel(ltop);
    NewTemp(c); Op3("cslew", c, i, hi, FALSE);
    Jnz(c, lbody, lend);
    EmitLabel(lbody);
    NewTemp(wi);   Op3("shr", wi, i, "5", FALSE);
    NewTemp(bi);   Op3("and", bi, i, "31", FALSE);
    WidenIndex(wi, wil);
    NewTemp(off4); Op3L("mul", off4, wil, "4");
    NewTemp(wa);   Op3L("add", wa, src, off4);
    NewTemp(m);    Op3("shl", m, "1", bi, FALSE);
    NewTemp(t);    W("  "); W(t); W(" =w loadw "); WL(wa);
    NewTemp(bit);  Op3("and", bit, t, m, FALSE);
    NewTemp(nzb);  Op3("cnew", nzb, bit, "0", FALSE);
    NewTemp(j);    Op3("add", j, i, nn, FALSE);
    IF isRot THEN
      NewTemp(c);  Op3("csgew", c, j, sp, FALSE);
      NewTemp(cs); Op3("mul", cs, c, sp, FALSE);
      NewTemp(jw); Op3("sub", jw, j, cs, FALSE);
      Cpy(j, jw)
    END;
    NewTemp(ok1);  Op3("csgew", ok1, j, "0", FALSE);
    NewTemp(ok2);  Op3("cslew", ok2, j, hi, FALSE);
    NewTemp(ok);   Op3("and", ok, ok1, ok2, FALSE);
    NewTemp(wj);   Op3("shr", wj, j, "5", FALSE);
    NewTemp(bj);   Op3("and", bj, j, "31", FALSE);
    WidenIndex(wj, wjl);
    NewTemp(o2);   Op3L("mul", o2, wjl, "4");
    NewTemp(wb2);  Op3L("add", wb2, out, o2);
    NewTemp(mm);   Op3("shl", mm, "1", bj, FALSE);
    NewTemp(mm2);  Op3("mul", mm2, mm, nzb, FALSE);
    NewTemp(mm3);  Op3("mul", mm3, mm2, ok, FALSE);
    NewTemp(wcur); W("  "); W(wcur); W(" =w loadw "); WL(wb2);
    NewTemp(wn);   Op3("or", wn, wcur, mm3, FALSE);
    Revive;
    W("  storew "); W(wn); W(", "); WL(wb2);
    Op3("add", i, i, "1", FALSE);
    Jmp(ltop);
    EmitLabel(lend);
    Cpy(q, out)
  END SetShift;

PROCEDURE SetRange (addr: ARRAY OF CHAR; a: ARRAY OF CHAR;
                     b: ARRAY OF CHAR; lo: INTEGER; span: CARDINAL);
  VAR al, bl, hiS: QVal;
    cur, c: QVal;
    ltop, lbody, lend: QVal;
  BEGIN
    WidenIndex(a, al);
    WidenIndex(b, bl);
    IntStr(VAL(INTEGER, span) - 1, hiS);
    CheckRange(al, "0", hiS);
    CheckRange(bl, "0", hiS);
    NewTemp(cur);
    Op3("add", cur, a, "0", FALSE);
    NewLabel(ltop); NewLabel(lbody); NewLabel(lend);
    EmitLabel(ltop);
    NewTemp(c);
    Op3("cslew", c, cur, b, FALSE);
    Jnz(c, lbody, lend);
    EmitLabel(lbody);
    SetBit(addr, cur, lo, span);
    Op3("add", cur, cur, "1", FALSE);
    Jmp(ltop);
    EmitLabel(lend)
  END SetRange;

PROCEDURE SetBinOp (sel: INTEGER; l: ARRAY OF CHAR; r: ARRAY OF CHAR;
                    lw, rw: CARDINAL; VAR q: QVal);
(* Union/intersection/difference/symdiff over possibly different
   spans: overlap via op, larger-side extras copied (union/symdiff/
   left-diff) or zeroed. Result has max words. *)
  VAR i, m, res: CARDINAL;
    la, ra, ta, a, b, c, nb, z: QVal;
  BEGIN
    m := lw;
    IF rw < m THEN m := rw END;
    res := lw;
    IF rw > res THEN res := rw END;
    NewSetTemp(res, q);
    NewTemp(z);
    Op3("xor", z, "0", "0", FALSE);
    i := 0;
    WHILE i < m DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(la); Op3L("add", la, l, nb);
      NewTemp(ra); Op3L("add", ra, r, nb);
      NewTemp(ta); Op3L("add", ta, q, nb);
      NewTemp(a);
      W("  "); W(a); W(" =w loadw "); WL(la);
      NewTemp(b);
      W("  "); W(b); W(" =w loadw "); WL(ra);
      NewTemp(c);
      IF sel = 0 THEN Op3("or", c, a, b, FALSE)
      ELSIF sel = 1 THEN Op3("and", c, a, b, FALSE)
      ELSIF sel = 2 THEN
        NewTemp(nb);
        Op3("xor", nb, b, "-1", FALSE);
        Op3("and", c, a, nb, FALSE)
      ELSE Op3("xor", c, a, b, FALSE)
      END;
      Revive;
      W("  storew "); W(c); W(", "); WL(ta);
      INC(i)
    END;
    WHILE i < lw DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(la); Op3L("add", la, l, nb);
      NewTemp(ta); Op3L("add", ta, q, nb);
      IF (sel = 0) OR (sel = 2) OR (sel = 3) THEN
        NewTemp(a);
        W("  "); W(a); W(" =w loadw "); WL(la);
        Revive;
        W("  storew "); W(a); W(", "); WL(ta)
      ELSE
        Revive;
        W("  storew "); W(z); W(", "); WL(ta)
      END;
      INC(i)
    END;
    WHILE i < rw DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(ra); Op3L("add", ra, r, nb);
      NewTemp(ta); Op3L("add", ta, q, nb);
      IF (sel = 0) OR (sel = 3) THEN
        NewTemp(b);
        W("  "); W(b); W(" =w loadw "); WL(ra);
        Revive;
        W("  storew "); W(b); W(", "); WL(ta)
      ELSE
        Revive;
        W("  storew "); W(z); W(", "); WL(ta)
      END;
      INC(i)
    END
  END SetBinOp;

PROCEDURE CmpSet (op: INTEGER; l: ARRAY OF CHAR; r: ARRAY OF CHAR;
                  lw, rw: CARDINAL; VAR q: QVal);
  VAR i, m: CARDINAL;
    la, ra, a, b, c, acc, nb: QVal;
  BEGIN
    NewTemp(acc);
    Op3("xor", acc, "1", "0", FALSE);
    m := lw;
    IF rw < m THEN m := rw END;
    i := 0;
    WHILE i < m DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(la); Op3L("add", la, l, nb);
      NewTemp(ra); Op3L("add", ra, r, nb);
      NewTemp(a);
      W("  "); W(a); W(" =w loadw "); WL(la);
      NewTemp(b);
      W("  "); W(b); W(" =w loadw "); WL(ra);
      NewTemp(c);
      Op3("ceqw", c, a, b, FALSE);
      NewTemp(q);
      Op3("and", q, acc, c, FALSE);
      CopyOp(q, acc);
      INC(i)
    END;
    WHILE i < lw DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(la); Op3L("add", la, l, nb);
      NewTemp(a);
      W("  "); W(a); W(" =w loadw "); WL(la);
      NewTemp(c);
      Op3("ceqw", c, a, "0", FALSE);
      NewTemp(q);
      Op3("and", q, acc, c, FALSE);
      CopyOp(q, acc);
      INC(i)
    END;
    WHILE i < rw DO
      IntStr(VAL(INTEGER, i * 4), nb);
      NewTemp(ra); Op3L("add", ra, r, nb);
      NewTemp(b);
      W("  "); W(b); W(" =w loadw "); WL(ra);
      NewTemp(c);
      Op3("ceqw", c, b, "0", FALSE);
      NewTemp(q);
      Op3("and", q, acc, c, FALSE);
      CopyOp(q, acc);
      INC(i)
    END;
    IF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN
      NewTemp(q);
      Op3("xor", q, acc, "1", FALSE)
    ELSE
      CopyOp(acc, q)
    END
  END CmpSet;

PROCEDURE CopySet (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                    dw, sw: CARDINAL);
(* Copies min words via memcpy, zero-fills dst extras. Src extras
   beyond dst must be zero (trap) — otherwise out-of-span bits
   would vanish silently on narrowing assignment. *)
  VAR m, i: CARDINAL;
    n, da, sa, a, z, off, c: QVal;
    qr, acc, lok, lbad: QVal;
  BEGIN
    m := dw;
    IF sw < m THEN m := sw END;
    IF sw > dw THEN
      NewTemp(acc);
      Op3("xor", acc, "1", "0", FALSE);
      i := dw;
      WHILE i < sw DO
        IntStr(VAL(INTEGER, i * 4), off);
        NewTemp(a); Op3L("add", a, src, off);
        NewTemp(c);
        W("  "); W(c); W(" =w loadw "); WL(a);
        NewTemp(qr);
        Op3("ceqw", qr, c, "0", FALSE);
        NewTemp(c);
        Op3("and", c, acc, qr, FALSE);
        CopyOp(c, acc);
        INC(i)
      END;
      NewLabel(lok); NewLabel(lbad);
      Jnz(acc, lok, lbad);
      EmitLabel(lbad);
      Trap;
      EmitLabel(lok)
    END;
    IF m > 0 THEN
      IntStr(VAL(INTEGER, m * 4), n);
      NewTemp(qr);
      W("  "); W(qr); W(" =l call $memcpy(l ");
      W(dst); W(", l "); W(src); W(", l "); W(n); WL(")")
    END;
    NewTemp(z);
    Op3("xor", z, "0", "0", FALSE);
    i := m;
    WHILE i < dw DO
      NewTemp(a);
      IntStr(VAL(INTEGER, i * 4), off);
      Op3L("add", a, dst, off);
      Revive;
      W("  storew "); W(z); W(", "); WL(a);
      INC(i)
    END
  END CopySet;

PROCEDURE InSet (x: ARRAY OF CHAR; s: ARRAY OF CHAR; lo: INTEGER;
                  span: CARDINAL; VAR q: QVal);
(* Membership bit test with span trap; q is fresh w 0/1. *)
  VAR off, offL, hiS, loS: QVal;
    wi, bi, wil, off4, wa, wcur, m, a: QVal;
    spanS: QVal;
  BEGIN
    NewTemp(off);
    IntStr(lo, loS);
    Op3("sub", off, x, loS, FALSE);
    WidenIndex(off, offL);
    IntStr(VAL(INTEGER, span) - 1, spanS);
    CheckRange(offL, "0", spanS);
    NewTemp(wi);
    Op3("shr", wi, off, "5", FALSE);
    NewTemp(bi);
    Op3("and", bi, off, "31", FALSE);
    WidenIndex(wi, wil);
    NewTemp(off4);
    Op3L("mul", off4, wil, "4");
    NewTemp(wa);
    Op3L("add", wa, s, off4);
    NewTemp(wcur);
    W("  "); W(wcur); W(" =w loadw "); WL(wa);
    NewTemp(m);
    Op3("shl", m, "1", bi, FALSE);
    NewTemp(a);
    Op3("and", a, wcur, m, FALSE);
    NewTemp(q);
    Op3("cnew", q, a, "0", FALSE)
  END InSet;

PROCEDURE WidenIndex (idx: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    IF IsImm(idx) THEN Cpy(q, idx)
    ELSE
      NewTemp(q);
      Revive;
      W("  "); W(q); W(" =l extsw "); WL(idx)
    END
  END WidenIndex;

PROCEDURE OpenHi (base: ARRAY OF CHAR; VAR q: QVal);
  VAR c: QVal;
  BEGIN
    NewTemp(c);
    Revive;
    W("  "); W(c); W(" =l loadl "); WL(base);
    NewTemp(q);
    Op3L("sub", q, c, "1")
  END OpenHi;

PROCEDURE OpenHiChar (base: ARRAY OF CHAR; VAR q: QVal);
(* q := loadl(base) — the open-array count, i.e. the index of the NUL
   terminator slot that CHAR arrays reserve. *)
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l loadl "); WL(base)
  END OpenHiChar;

PROCEDURE LoadCount (base: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l loadl "); WL(base)
  END LoadCount;

PROCEDURE CheckRange (idx, lo, hi: ARRAY OF CHAR);
(* l-domain operands (widened index, immediates, or open hi temp);
   comparisons are long (result w). *)
  VAR c1, c2, c: QVal;
    lok, lbad: QVal;
  BEGIN
    NewTemp(c1);
    Op3("csgel", c1, idx, lo, FALSE);
    NewTemp(c2);
    Op3("cslel", c2, idx, hi, FALSE);
    NewTemp(c);
    Op3("and", c, c1, c2, FALSE);
    NewLabel(lok); NewLabel(lbad);
    Jnz(c, lok, lbad);
    EmitLabel(lbad);
    Trap;
    EmitLabel(lok)
  END CheckRange;

PROCEDURE ElemAddr (base, idx, lo: ARRAY OF CHAR; elemT: INTEGER;
                    VAR q: QVal);
(* q := base + 8 + (idx - lo) * elemSize in l, fresh temp.
   elemT is the array descriptor (open or fixed); all operands
   l-domain (immediates pass, temps pre-widened). *)
  VAR t1, t2, tb, sb: QVal;
  BEGIN
    NewTemp(t1);
    Op3L("sub", t1, idx, lo);
    IntStr(VAL(INTEGER, ElemSize(elemT)), sb);
    NewTemp(t2);
    Op3L("mul", t2, t1, sb);
    NewTemp(tb);
    Op3L("add", tb, base, "8");
    NewTemp(q);
    Op3L("add", q, tb, t2)
  END ElemAddr;

PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
(* Loads one element of (element-)type t. Nested/pointer elements
   are addresses (loadl). *)
  VAR cls: INTEGER;
  BEGIN
    cls := SymTab.ClassOf(t);
    NewTemp(q);
    Revive;
    W("  "); W(q);
    IF cls = SymTab.ClReal THEN W(" =d loadd ")
    ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClProc)
       OR (cls = SymTab.ClClass) THEN
      W(" =l loadl ")
    ELSIF cls = SymTab.ClChar THEN W(" =w loadub ")
    ELSE W(" =w loadw ")
    END;
    WL(addr)
  END ElemLoad;

PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
  VAR cls: INTEGER;
  BEGIN
    cls := SymTab.ClassOf(t);
    Revive;
    IF cls = SymTab.ClReal THEN W("  stored ")
    ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClProc)
       OR (cls = SymTab.ClClass) THEN
      W("  storel ")
    ELSIF cls = SymTab.ClChar THEN W("  storeb ")
    ELSE W("  storew ")
    END;
    W(v); W(", "); WL(addr)
  END ElemStore;

PROCEDURE CopyArray (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                      t: INTEGER);
(* Whole-array copy with runtime count check + blit. Nested levels
   recurse through a runtime loop; counts mismatch traps. dst/src
   are descriptor address operands; t is the destination type. *)
  VAR dc, sc, ok: QVal;
    lok, lbad: QVal;
    ecls: INTEGER;
    n, da, sa: QVal;
    sb: QVal;
    qr: QVal;
    i, c, de, se, di, si, dd0, doff, sd0, soff: QVal;
    ltop, lbody, lend: QVal;
  BEGIN
    NewTemp(dc);
    Revive;
    W("  "); W(dc); W(" =l loadl "); WL(dst);
    NewTemp(sc);
    W("  "); W(sc); W(" =l loadl "); WL(src);
    NewTemp(ok);
    Op3("ceql", ok, dc, sc, FALSE);
    NewLabel(lok); NewLabel(lbad);
    Jnz(ok, lok, lbad);
    EmitLabel(lbad);
    Trap;
    EmitLabel(lok);
    ecls := ElemCls(t);
    IF (ecls = SymTab.ClArray) THEN
      NewTemp(i);
      W("  "); W(i); W(" =l copy 0"); WL("");
      NewLabel(ltop); NewLabel(lbody); NewLabel(lend);
      EmitLabel(ltop);
      NewTemp(c);
      Op3("csltl", c, i, dc, FALSE);
      Jnz(c, lbody, lend);
      EmitLabel(lbody);
      NewTemp(dd0); Op3L("add", dd0, dst, "8");
      NewTemp(doff); Op3L("mul", doff, i, "8");
      NewTemp(de); Op3L("add", de, dd0, doff);
      NewTemp(sd0); Op3L("add", sd0, src, "8");
      NewTemp(soff); Op3L("mul", soff, i, "8");
      NewTemp(se); Op3L("add", se, sd0, soff);
      NewTemp(di);
      W("  "); W(di); W(" =l loadl "); WL(de);
      NewTemp(si);
      W("  "); W(si); W(" =l loadl "); WL(se);
      CopyArray(di, si, SymTab.ArrayElem(t));
      Op3L("add", i, i, "1");
      Jmp(ltop);
      EmitLabel(lend)
    ELSE
      IntStr(VAL(INTEGER, ElemSize(t)), sb);
      NewTemp(n);
      Op3L("mul", n, dc, sb);
      NewTemp(da);
      Op3L("add", da, dst, "8");
      NewTemp(sa);
      Op3L("add", sa, src, "8");
      NewTemp(qr);
      W("  "); W(qr); W(" =l call $memcpy(l ");
      W(da); W(", l "); W(sa); W(", l "); W(n); WL(")")
    END
  END CopyArray;

PROCEDURE DeclStr (text: ARRAY OF CHAR; VAR q: QVal);
(* Records a quoted literal for top-level emission at EndModule and
   returns its address operand ($strN). Data definitions may only
   appear outside functions, but literals occur mid-body. *)
  VAR nm: QVal;
  BEGIN
    Cpy(nm, "str");
    AppNum(nm, nStr);
    IF nStr <= HIGH(strNams) THEN
      Cpy(strNams[nStr], nm);
      Cpy(strTexts[nStr], text);
      INC(nStr)
    END;
    Cpy(q, "$");
    App(q, nm)
  END DeclStr;

PROCEDURE DeclUStr (text: ARRAY OF CHAR; VAR q: QVal;
                    VAR single: BOOLEAN; VAR cp: INTEGER;
                    VAR ok: BOOLEAN);
(* text is the raw lexeme U'...' / U"..."  Strict RFC3629-decode the
   bytes between the quotes. Exactly one codepoint -> single:=TRUE,
   cp:=it.  Otherwise record a UString descriptor and q := "$ustrN".
   ok:=FALSE for invalid UTF-8 (overlong / surrogate / >10FFFF /
   truncation). *)
  VAR L, i, cnt, base: CARDINAL;
    b0, b1, b2, b3, ch: INTEGER;
    nm: QVal;

  PROCEDURE Cont (VAR b: INTEGER): BOOLEAN;
  (* consume a continuation byte, or fail *)
    BEGIN
      IF i >= L - 1 THEN RETURN FALSE END;
      b := ORD(text[i]); INC(i);
      RETURN (b >= 128) AND (b <= 191)
    END Cont;

  BEGIN
    single := FALSE; cp := 0; ok := TRUE;
    q[0] := "0"; q[1] := CHR(0);
    L := Len(text);
    IF (L < 3) OR (text[0] # "U") THEN ok := FALSE; RETURN END;
    i := 2; cnt := 0; base := ustrUsed;
    WHILE i < L - 1 DO
      b0 := ORD(text[i]); INC(i);
      ch := -1;
      IF b0 <= 127 THEN
        ch := b0
      ELSIF (b0 >= 194) AND (b0 <= 223) THEN
        IF Cont(b1) THEN ch := ((b0 - 192) * 64) + (b1 - 128) END
      ELSIF (b0 >= 224) AND (b0 <= 239) THEN
        IF Cont(b1) AND Cont(b2) THEN
          ch := ((b0 - 224) * 4096) + ((b1 - 128) * 64) + (b2 - 128);
          IF ch < 2048 THEN ch := -1 END
        END
      ELSIF (b0 >= 240) AND (b0 <= 244) THEN
        IF Cont(b1) AND Cont(b2) AND Cont(b3) THEN
          ch := ((b0 - 240) * 262144) + ((b1 - 128) * 4096)
                + ((b2 - 128) * 64) + (b3 - 128);
          IF ch < 65536 THEN ch := -1 END
        END
      ELSE ok := FALSE
      END;
      IF ok AND (ch < 0) THEN ok := FALSE END;
      IF ok AND (ch >= 55296) AND (ch <= 57343) THEN ok := FALSE END;
      IF ok AND (ch > 1114111) THEN ok := FALSE END;
      IF NOT ok THEN RETURN END;
      IF ustrUsed <= HIGH(ustrPool) THEN
        ustrPool[ustrUsed] := ch; INC(ustrUsed)
      END;
      INC(cnt)
    END;
    IF cnt = 1 THEN
      single := TRUE; cp := ustrPool[base]
    ELSE
      Cpy(nm, "ustr"); AppNum(nm, ustrN);
      IF ustrN <= HIGH(ustrNams) THEN
        Cpy(ustrNams[ustrN], nm);
        ustrStart[ustrN] := base; ustrCount[ustrN] := cnt; INC(ustrN)
      END;
      Cpy(q, "$"); App(q, nm)
    END
  END DeclUStr;

PROCEDURE FlushUStrings;
  VAR k, i: CARDINAL;
    bv: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    k := 0;
    WHILE k < ustrN DO
      W("data $"); W(ustrNams[k]); W(" = { l ");
      IntStr(VAL(INTEGER, ustrCount[k]), bv); W(bv);
      i := 0;
      WHILE i < ustrCount[k] DO
        W(", w ");
        IntStr(ustrPool[ustrStart[k] + i], bv); W(bv);
        INC(i)
      END;
      WL(" }");
      INC(k)
    END
  END FlushUStrings;

PROCEDURE DeclCharStr (ch: ARRAY OF CHAR; VAR q: QVal);
  VAR v: INTEGER;
    txt: ARRAY [0 .. 3] OF CHAR;
  BEGIN
    IF ParseInt(ch, v) AND (v >= 0) AND (v < 256) THEN
      txt[0] := '"'; txt[1] := CHR(v); txt[2] := '"'; txt[3] := CHR(0);
      DeclStr(txt, q)
    ELSE Cpy(q, "0")
    END
  END DeclCharStr;

PROCEDURE FindStrPos (v: ARRAY OF CHAR; VAR k: CARDINAL): BOOLEAN;
  VAR j: CARDINAL;
    sv: QVal;
  BEGIN
    j := 0;
    WHILE j < nStr DO
      Cpy(sv, "$"); App(sv, strNams[j]);
      IF SymTab.Equal(sv, v) THEN k := j; RETURN TRUE END;
      INC(j)
    END;
    RETURN FALSE
  END FindStrPos;

PROCEDURE StrFold (a, b: ARRAY OF CHAR; clsA, clsB: INTEGER;
                   VAR q: QVal; VAR ok: BOOLEAN);
(* Constant-fold `a + b` into one string literal descriptor. *)
  VAR ka, kb: CARDINAL;
    ta, tb, joined: ARRAY [0 .. 1023] OF CHAR;
    oa, ob, ord: INTEGER;
    i, L: CARDINAL;
    isCharA, isCharB: BOOLEAN;

  PROCEDURE AppendInner (VAR s: ARRAY OF CHAR; txt: ARRAY OF CHAR);
    VAR n: CARDINAL;
      c2: ARRAY [0 .. 1] OF CHAR;
  BEGIN
    n := Len(txt);
    IF n >= 2 THEN
      i := 1;
      WHILE i < n - 1 DO
        c2[0] := txt[i]; c2[1] := CHR(0);
        App(s, c2);
        INC(i)
      END
    END
  END AppendInner;

  BEGIN
    ok := FALSE;
    isCharA := (clsA = SymTab.ClChar) OR (clsA = SymTab.ClEnum)
               OR (clsA = SymTab.ClBool);
    isCharB := (clsB = SymTab.ClChar) OR (clsB = SymTab.ClEnum)
               OR (clsB = SymTab.ClBool);
    IF isCharA THEN
      IF NOT ParseInt(a, oa) THEN RETURN END
    ELSIF NOT FindStrPos(a, ka) THEN RETURN
    END;
    IF isCharB THEN
      IF NOT ParseInt(b, ob) THEN RETURN END
    ELSIF NOT FindStrPos(b, kb) THEN RETURN
    END;
    joined[0] := '"'; joined[1] := CHR(0);
    IF isCharA THEN
      IF (oa < 0) OR (oa > 255) THEN RETURN END;
      joined[1] := CHR(oa); joined[2] := CHR(0)
    ELSE AppendInner(joined, strTexts[ka])
    END;
    IF isCharB THEN
      IF (ob < 0) OR (ob > 255) THEN RETURN END;
      L := Len(joined); joined[L] := CHR(ob); joined[L + 1] := CHR(0)
    ELSE AppendInner(joined, strTexts[kb])
    END;
    L := Len(joined); joined[L] := '"'; joined[L + 1] := CHR(0);
    DeclStr(joined, q);
    ok := TRUE
  END StrFold;

PROCEDURE FlushStrings;
(* Emits all recorded string literals as top-level data. *)
  VAR k, i, L: CARDINAL;
    bv: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    k := 0;
    WHILE k < nStr DO
      L := Len(strTexts[k]);
      IF L >= 2 THEN
        W("data $"); W(strNams[k]);
        W(" = { l ");
        IntStr(VAL(INTEGER, L - 2), bv);
        W(bv);
        i := 1;
        WHILE i < L - 1 DO
          W(", b ");
          IntStr(ORD(strTexts[k][i]), bv);
          W(bv);
          INC(i)
        END;
        W(", b 0");   (* NUL terminator (count excludes it) *)
        WL(" }")
      END;
      INC(k)
    END
  END FlushStrings;

PROCEDURE DeclArr (name: ARRAY OF CHAR; t: INTEGER);
  BEGIN
    IF SymTab.IsOpenArray(t) OR (SymTab.ArrayDepth(t) = 0) THEN
      DataLine(name, FALSE, "0"); RETURN
    END;
    ArrData(name, t)
  END DeclArr;

(* ---------------- array constructors (step: `T{...}`) ---------------- *)
(* A constructor becomes a pooled static descriptor with the same
   layout as a declared array: "l <ArrayLen>, <items>" (CHAR/UCHAR
   get a trailing zero terminator slot, like ArrBodyItems).  Nested
   arrays are emitted as their own pooled descriptors and referenced
   by `l $ctoK` so the runtime descriptor pointers stay valid. *)

PROCEDURE IsBakeOp (v: ARRAY OF CHAR): BOOLEAN;
(* TRUE when v may be embedded in a static descriptor: an immediate,
   or a pooled constructor/label reference ($ctoN).  A plain global
   address ($mod_var) is NOT bakeable into an inline field. *)
  BEGIN
    IF (v[0] = CHR(0)) OR (v[0] = "%") THEN RETURN FALSE END;
    IF v[0] # "$" THEN RETURN TRUE END;
    (* accept $ctoN only *)
    RETURN (v[1] = "c") AND (v[2] = "t") AND (v[3] = "o")
  END IsBakeOp;

PROCEDURE CtorItem (VAR buf: ARRAY OF CHAR; v: ARRAY OF CHAR;
                    cls: INTEGER);
  BEGIN
    App(buf, ", ");
    IF cls = SymTab.ClChar THEN
      App(buf, "b ")
    ELSIF cls = SymTab.ClReal THEN
      App(buf, "d ")
    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray) THEN
      App(buf, "l ")
    ELSE
      App(buf, "w ")
    END;
    App(buf, v)
  END CtorItem;

PROCEDURE RecItem (VAR s: ARRAY OF CHAR; VAR first: BOOLEAN;
                   v: ARRAY OF CHAR; cls: INTEGER);
(* Record field item with a leading separator when not first. *)
  BEGIN
    IF first THEN first := FALSE ELSE App(s, ", ") END;
    IF cls = SymTab.ClChar THEN App(s, "b ")
    ELSIF cls = SymTab.ClReal THEN App(s, "d ")
    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray) THEN
      App(s, "l ")
    ELSE
      App(s, "w ")
    END;
    App(s, v)
  END RecItem;

PROCEDURE ArrZeroBody (VAR s: ARRAY OF CHAR; t: INTEGER);
(* "l <n>, z <bytes>" — an all-zero array body (used for a record's
   unprovided array field). *)
  VAR n: CARDINAL;
    elem: SymTab.TypeIndex;
    ecls: INTEGER;
    esz: CARDINAL;
    bv: QVal;
  BEGIN
    n := SymTab.ArrayLen(t);
    elem := SymTab.ArrayElem(t);
    ecls := SymTab.ClassOf(elem);
    App(s, "l ");
    IntStr(VAL(INTEGER, n), bv);
    App(s, bv);
    IF ecls = SymTab.ClChar THEN
      App(s, ", z "); IntStr(VAL(INTEGER, n + 1), bv); App(s, bv)
    ELSIF ecls = SymTab.ClUChar THEN
      App(s, ", z "); IntStr(VAL(INTEGER, (n + 1) * 4), bv); App(s, bv)
    ELSE
      IF (ecls = SymTab.ClReal) OR (ecls = SymTab.ClPtr)
         OR (ecls = SymTab.ClProc) OR (ecls = SymTab.ClArray)
         OR (ecls = SymTab.ClLong) THEN esz := 8
      ELSE esz := 4
      END;
      IF n > 0 THEN
        App(s, ", z "); IntStr(VAL(INTEGER, n * esz), bv); App(s, bv)
      END
    END
  END ArrZeroBody;

PROCEDURE FindCtor (v: ARRAY OF CHAR): INTEGER;
  VAR k: CARDINAL;
    sv: QVal;
  BEGIN
    k := 0;
    WHILE k < ctorN DO
      Cpy(sv, "$"); App(sv, ctorNam[k]);
      IF SymTab.Equal(sv, v) THEN RETURN VAL(INTEGER, k) END;
      INC(k)
    END;
    RETURN -1
  END FindCtor;

(* default items for a nested record field, appended to s *)
PROCEDURE RecItemDefaults (VAR s: ARRAY OF CHAR; VAR first: BOOLEAN;
                           prefix: ARRAY OF CHAR; t: INTEGER);
  VAR i, n, cls, w: INTEGER;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    sub: QVal;
  BEGIN
    n := VAL(INTEGER, SymTab.FieldCount(t));
    i := 0;
    WHILE i < n DO
      SymTab.FieldName(t, i, fn);
      ft := SymTab.FieldType(t, fn);
      cls := SymTab.ClassOf(ft);
      IF first THEN first := FALSE ELSE App(s, ", ") END;
      IF cls = SymTab.ClReal THEN App(s, "d 0")
      ELSIF cls = SymTab.ClChar THEN App(s, "b 0")
      ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
      ELSIF cls = SymTab.ClSet THEN
        w := VAL(INTEGER, SymTab.SetWords(ft));
        IF w = 0 THEN w := 1 END;
        App(s, "w 0");
        WHILE w > 1 DO App(s, ", w 0"); DEC(w) END
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
        RecItemDefaults(s, first, sub, ft)
      ELSE App(s, "w 0")
      END;
      INC(i)
    END
  END RecItemDefaults;

PROCEDURE CtorBegin (t: INTEGER);
  BEGIN
    IF ctorTop > HIGH(ctorTyp) THEN RETURN END;
    ctorTyp[ctorTop] := t;
    ctorCnt[ctorTop] := 0;
    ctorBuf[ctorTop][0] := CHR(0);
    INC(ctorTop)
  END CtorBegin;

PROCEDURE CtorElemType (t: INTEGER; cnt: CARDINAL): SymTab.TypeIndex;
(* the type of the cnt-th constructor element: array element, or the
   cnt-th record field in declaration order. *)
  VAR fn: SymTab.Name;
  BEGIN
    IF SymTab.ClassOf(t) = SymTab.ClArray THEN
      RETURN SymTab.ArrayElem(t)
    END;
    SymTab.FieldName(t, cnt, fn);
    IF fn[0] = CHR(0) THEN RETURN SymTab.InvalidType END;
    RETURN SymTab.FieldType(t, fn)
  END CtorElemType;

PROCEDURE StrDesc (v: ARRAY OF CHAR; elemT: INTEGER; VAR out: QVal);
(* v is a $strN descriptor; build a CHAR-array descriptor of type
   elemT from its text (padded/NUL-terminated) and return "$ctoM". *)
  VAR k: CARDINAL;
    found: BOOLEAN;
    txt, bv, sv: QVal;
    buf: ARRAY [0 .. 4095] OF CHAR;
    n, i, L: CARDINAL;
  BEGIN
    Cpy(out, v);
    IF (ctorN > HIGH(ctorNam)) THEN RETURN END;
    found := FALSE; k := 0;
    WHILE (k < nStr) AND NOT found DO
      Cpy(sv, "$"); App(sv, strNams[k]);
      IF SymTab.Equal(sv, v) THEN
        Cpy(txt, strTexts[k]); found := TRUE
      ELSE INC(k)
      END
    END;
    IF NOT found THEN RETURN END;
    L := Len(txt);
    n := SymTab.ArrayLen(elemT);
    buf[0] := CHR(0);
    App(buf, "l ");
    IntStr(VAL(INTEGER, n), bv);
    App(buf, bv);
    i := 0;
    WHILE i < n DO
      IF (i + 1 < L - 1) AND ((i + 1) <= HIGH(txt)) THEN
        IntStr(ORD(txt[i + 1]), bv)
      ELSE Cpy(bv, "0")
      END;
      CtorItem(buf, bv, SymTab.ClChar);
      INC(i)
    END;
    App(buf, ", b 0");
    Cpy(ctorNam[ctorN], "cto"); AppNum(ctorNam[ctorN], ctorN);
    Cpy(ctorTxt[ctorN], buf);
    ctorUse[ctorN] := TRUE;
    INC(ctorN);
    Cpy(out, "$"); App(out, ctorNam[ctorN - 1])
  END StrDesc;

PROCEDURE AppCtorElem (v: ARRAY OF CHAR; cls: INTEGER);
  VAR cnt: CARDINAL;
  BEGIN
    IF ctorTop = 0 THEN RETURN END;
    cnt := ctorCnt[ctorTop - 1];
    IF cnt > HIGH(ctorEv[0]) THEN RETURN END;
    Cpy(ctorEv[ctorTop - 1][cnt], v);
    ctorEk[ctorTop - 1][cnt] := cls;
    INC(ctorCnt[ctorTop - 1])
  END AppCtorElem;

PROCEDURE CtorElem (v: ARRAY OF CHAR);
(* Record the next constructor element.  The element type is derived
   from the constructor's type and the element index.  A string literal
   filling a CHAR element expands into consecutive elements. *)
  VAR t, elemT, cls, k, si: INTEGER;
    cnt: CARDINAL;
    vv, bv: QVal;
    isStr: BOOLEAN;
  BEGIN
    IF ctorTop = 0 THEN RETURN END;
    t := ctorTyp[ctorTop - 1];
    elemT := CtorElemType(t, ctorCnt[ctorTop - 1]);
    cls := SymTab.ClassOf(elemT);
    isStr := (Len(v) > 3) AND (v[0] = "$")
             AND (v[1] = "s") AND (v[2] = "t");
    IF cls = SymTab.ClChar THEN
      IF isStr AND FindStrPos(v, cnt) THEN
        k := 1;
        WHILE k < VAL(INTEGER, Len(strTexts[cnt])) - 1 DO
          IntStr(ORD(strTexts[cnt][k]), bv);
          AppCtorElem(bv, SymTab.ClChar);
          INC(k)
        END;
        RETURN
      END;
      AppCtorElem(v, SymTab.ClChar);
      RETURN
    END;
    Cpy(vv, v);
    IF (cls = SymTab.ClArray) AND isStr
       AND (SymTab.ClassOf(SymTab.ArrayElem(elemT)) = SymTab.ClChar) THEN
      StrDesc(v, elemT, vv)
    END;
    AppCtorElem(vv, cls)
  END CtorElem;

PROCEDURE NewCtorTemp (t: INTEGER; VAR q: QVal);
  VAR nb: QVal;
  BEGIN
    NewTemp(q);
    Revive;
    IntStr(VAL(INTEGER, HeapSize(t)), nb);
    W("  "); W(q); W(" =l alloc8 "); WL(nb)
  END NewCtorTemp;

PROCEDURE InitArrHeader (addr: ARRAY OF CHAR; t: INTEGER);
(* Store an inline array's count header (and CHAR/UCHAR terminator
   slot) at addr, so a following CopyArray sees matching counts. *)
  VAR nb, ea: QVal;
  BEGIN
    IF SymTab.ClassOf(t) # SymTab.ClArray THEN RETURN END;
    IntStr(VAL(INTEGER, SymTab.ArrayLen(t)), nb);
    Revive; W("  storel "); W(nb); W(", "); WL(addr);
    IF SymTab.IsCharArray(t) THEN
      IntStr(VAL(INTEGER, 8 + SymTab.ArrayLen(t)), nb);
      NewTemp(ea); Op3L("add", ea, addr, nb);
      Revive; W("  storeb 0, "); WL(ea)
    END;
    IF SymTab.IsUCharArray(t) THEN
      IntStr(VAL(INTEGER, 8 + SymTab.ArrayLen(t) * 4), nb);
      NewTemp(ea); Op3L("add", ea, addr, nb);
      Revive; W("  storew 0, "); WL(ea)
    END
  END InitArrHeader;

PROCEDURE CtorArrStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
                         t: INTEGER; cnt: CARDINAL);
  VAR elem, ecls, n, k, ci: INTEGER;
    v: QVal;
  BEGIN
    elem := SymTab.ArrayElem(t);
    ecls := SymTab.ClassOf(elem);
    n := VAL(INTEGER, SymTab.ArrayLen(t));
    App(s, "l ");
    IntStr(n, v);
    App(s, v);
    k := 0;
    WHILE k < n DO
      IF k < VAL(INTEGER, cnt) THEN
        Cpy(v, ctorEv[lvl][k])
      ELSE Cpy(v, "0")
      END;
      CtorItem(s, v, ecls);
      INC(k)
    END;
    IF ecls = SymTab.ClChar THEN App(s, ", b 0")
    ELSIF ecls = SymTab.ClUChar THEN App(s, ", w 0")
    END
  END CtorArrStatic;

PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
                         t: INTEGER; cnt: CARDINAL);
(* Static record body: fields in declaration order; an array/record
   field given as a nested constructor is inlined (and that child
   descriptor is marked consumed). *)
  VAR i, n, cls, ci, w: INTEGER;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    v, bv: QVal;
    first: BOOLEAN;
  BEGIN
    first := TRUE;
    IF (SymTab.ClassOf(t) = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
      VtRef(t, bv);
      App(s, "l "); App(s, bv);
      first := FALSE
    END;
    n := VAL(INTEGER, SymTab.FieldCount(t));
    i := 0;
    WHILE i < n DO
      SymTab.FieldName(t, i, fn);
      ft := SymTab.FieldType(t, fn);
      cls := SymTab.ClassOf(ft);
      v[0] := CHR(0);
      IF i < VAL(INTEGER, cnt) THEN Cpy(v, ctorEv[lvl][i]) END;
      IF (v[0] # CHR(0)) AND (v[0] = "$")
         AND ((cls = SymTab.ClArray) OR (cls = SymTab.ClRecord)
              OR (cls = SymTab.ClClass)) THEN
        ci := FindCtor(v);
        IF first THEN first := FALSE ELSE App(s, ", ") END;
        IF ci >= 0 THEN
          App(s, ctorTxt[ci]);
          ctorUse[ci] := FALSE
        ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
        ELSE App(s, "w 0")
        END
      ELSIF v[0] # CHR(0) THEN
        RecItem(s, first, v, cls)
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        IF first THEN first := FALSE ELSE App(s, ", ") END;
        Cpy(bv, ctorNam[ctorN]); App(bv, "_"); App(bv, fn);
        RecItemDefaults(s, first, bv, ft)
      ELSE
        IF first THEN first := FALSE ELSE App(s, ", ") END;
        IF cls = SymTab.ClReal THEN App(s, "d 0")
        ELSIF cls = SymTab.ClChar THEN App(s, "b 0")
        ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
        ELSIF cls = SymTab.ClSet THEN
          w := VAL(INTEGER, SymTab.SetWords(ft));
          IF w = 0 THEN w := 1 END;
          App(s, "w 0");
          WHILE w > 1 DO App(s, ", w 0"); DEC(w) END
        ELSE App(s, "w 0")
        END
      END;
      INC(i)
    END;
    IF first THEN App(s, "w 0") END
  END CtorRecStatic;

PROCEDURE CtorEnd (VAR q: QVal);
  VAR t, cls, lvl, k, n, cnt, esz, off, ci: INTEGER;
    allc: BOOLEAN;
    bv, a, v: QVal;
    s: ARRAY [0 .. 4095] OF CHAR;
    ft, elem: SymTab.TypeIndex;
    nm: SymTab.Name;
  BEGIN
    IF ctorTop = 0 THEN Cpy(q, "0"); RETURN END;
    DEC(ctorTop);
    lvl := VAL(INTEGER, ctorTop);
    IF noEmit THEN Cpy(q, "0"); RETURN END;
    t := ctorTyp[ctorTop];
    cnt := VAL(INTEGER, ctorCnt[ctorTop]);
    cls := SymTab.ClassOf(t);
    IF (cls # SymTab.ClArray) AND (cls # SymTab.ClRecord)
       AND (cls # SymTab.ClClass) THEN
      Cpy(q, "0"); RETURN
    END;
    allc := TRUE; k := 0;
    WHILE k < cnt DO
      IF NOT IsBakeOp(ctorEv[lvl][k]) THEN allc := FALSE END;
      INC(k)
    END;
    IF allc AND (ctorN <= HIGH(ctorNam)) THEN
      s[0] := CHR(0);
      IF cls = SymTab.ClArray THEN
        CtorArrStatic(s, ctorTop, t, ctorCnt[ctorTop])
      ELSE
        CtorRecStatic(s, ctorTop, t, ctorCnt[ctorTop])
      END;
      Cpy(ctorNam[ctorN], "cto"); AppNum(ctorNam[ctorN], ctorN);
      Cpy(ctorTxt[ctorN], s);
      ctorUse[ctorN] := TRUE;
      INC(ctorN);
      Cpy(q, "$"); App(q, ctorNam[ctorN - 1])
    ELSE
      (* runtime construction: an all-zero descriptor filled in place *)
      NewCtorTemp(t, q);
      IF cls = SymTab.ClArray THEN
        IntStr(VAL(INTEGER, SymTab.ArrayLen(t)), bv);
        Revive; W("  storel "); W(bv); W(", "); WL(q);
        elem := SymTab.ArrayElem(t);
        esz := VAL(INTEGER, ElemSize(t));
        n := VAL(INTEGER, SymTab.ArrayLen(t));
        k := 0;
        WHILE k < n DO
          off := 8 + k * esz;
          FieldAddr(q, off, a);
          IF k < cnt THEN
            Cpy(v, ctorEv[lvl][k]);
            ElemStore(a, v, elem)
          ELSE ElemStore(a, "0", elem)
          END;
          INC(k)
        END;
        IF SymTab.ClassOf(elem) = SymTab.ClChar THEN
          off := 8 + n;
          FieldAddr(q, off, a);
          Revive; W("  storeb 0, "); WL(a)
        ELSIF SymTab.ClassOf(elem) = SymTab.ClUChar THEN
          off := 8 + n * 4;
          FieldAddr(q, off, a);
          Revive; W("  storew 0, "); WL(a)
        END
      ELSE
        (* record / class *)
        IF (cls = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
          VtRef(t, bv);
          off := SymTab.VptrOffset(t);
          FieldAddr(q, off, a);
          Revive; W("  storel "); W(bv); W(", "); WL(a)
        END;
        n := VAL(INTEGER, SymTab.FieldCount(t));
        k := 0;
        WHILE k < n DO
          SymTab.FieldName(t, k, nm);
          ft := SymTab.FieldType(t, nm);
          off := SymTab.FieldOffset(t, nm);
          FieldAddr(q, off, a);
          IF k < cnt THEN
            Cpy(v, ctorEv[lvl][k]);
            IF SymTab.ClassOf(ft) = SymTab.ClArray THEN
              InitArrHeader(a, ft);
              CopyArray(a, v, ft)
            ELSIF (SymTab.ClassOf(ft) = SymTab.ClRecord)
               OR (SymTab.ClassOf(ft) = SymTab.ClClass) THEN
              CopyRecord(a, v, ft)
            ELSIF SymTab.ClassOf(ft) = SymTab.ClSet THEN
              CopySet(a, v, SymTab.SetWords(ft), SymTab.SetWords(ft))
            ELSE ElemStore(a, v, ft)
            END
          ELSIF (SymTab.ClassOf(ft) = SymTab.ClReal)
             OR (SymTab.ClassOf(ft) = SymTab.ClChar)
             OR (SymTab.ClassOf(ft) = SymTab.ClInt)
             OR (SymTab.ClassOf(ft) = SymTab.ClBool)
             OR (SymTab.ClassOf(ft) = SymTab.ClEnum)
             OR (SymTab.ClassOf(ft) = SymTab.ClLong)
             OR (SymTab.ClassOf(ft) = SymTab.ClPtr)
             OR (SymTab.ClassOf(ft) = SymTab.ClProc) THEN
            ElemStore(a, "0", ft)
          END;
          INC(k)
        END
      END
    END
  END CtorEnd;

PROCEDURE FlushCtors;
  VAR k: CARDINAL;
  BEGIN
    IF NOT opened THEN RETURN END;
    k := 0;
    WHILE k < ctorN DO
      IF ctorUse[k] THEN
        W("data $"); W(ctorNam[k]); W(" = { "); W(ctorTxt[k]); WL(" }")
      END;
      INC(k)
    END
  END FlushCtors;

PROCEDURE PushLoop (exit: ARRAY OF CHAR);
  BEGIN
    IF loopTop <= HIGH(loopSt) THEN
      Cpy(loopSt[loopTop], exit); INC(loopTop)
    END
  END PushLoop;

PROCEDURE PopLoop;
  BEGIN
    IF loopTop > 0 THEN DEC(loopTop) END
  END PopLoop;

PROCEDURE TopLoop (VAR exit: QVal): BOOLEAN;
  BEGIN
    IF loopTop = 0 THEN RETURN FALSE END;
    Cpy(exit, loopSt[loopTop - 1]);
    RETURN TRUE
  END TopLoop;

PROCEDURE CmpL (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal);
  VAR mn : ARRAY [0 .. 7] OF CHAR;
  BEGIN
    mn[0] := CHR(0);
    IF op = SymTab.OpEq THEN Cpy(mn, "ceql")
    ELSE Cpy(mn, "cnel")
    END;
    NewTemp(q);
    Op3(mn, q, l, r, FALSE)
  END CmpL;

(* ---------------- heap (step 3.6: extern malloc/free) ---------------- *)
(* Only the object skeleton is initialized (array counts); elements
   and members stay garbage per Wirth, except nested objects which
   are allocated recursively. DISPOSE is shallow (documented). *)

PROCEDURE HeapSize (t: INTEGER): CARDINAL;
  VAR cls: INTEGER;
    n: CARDINAL;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClArray THEN
      n := SymTab.ArrayLen(t) * ElemSize(t);
      IF SymTab.IsCharArray(t) THEN n := n + 1 END;
      IF SymTab.IsUCharArray(t) THEN n := n + 4 END;
      RETURN 8 + n
    END;
    RETURN SymTab.TypeSize(t)
  END HeapSize;

PROCEDURE NewHeap (t: SymTab.TypeIndex; VAR q: QVal);
  VAR nb: QVal;
  BEGIN
    NewTemp(q);
    Revive;
    IntStr(VAL(INTEGER, HeapSize(t)), nb);
    W("  "); W(q);
    IF useStack THEN W(" =l alloc8 "); W(nb); WL("")
    ELSE W(" =l call $malloc(l "); W(nb); WL(")")
    END
  END NewHeap;

PROCEDURE FreeHeap (v: ARRAY OF CHAR);
  BEGIN
    Revive;
    W("  call $free(l "); W(v); WL(")")
  END FreeHeap;

PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
  VAR cls, ecls: INTEGER;
    n, i: CARDINAL;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    nb, ea, eb, fa, fb: QVal;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF (cls = SymTab.ClClass) AND SymTab.HasVTable(t) THEN
      (* install the class's vtable pointer *)
      VtRef(t, eb);
      IntStr(SymTab.VptrOffset(t), nb);
      NewTemp(ea);
      Op3L("add", ea, addr, nb);
      Revive;
      W("  storel "); W(eb); W(", "); WL(ea)
    END;
    IF cls = SymTab.ClArray THEN
      IntStr(VAL(INTEGER, SymTab.ArrayLen(t)), nb);
      Revive;
      W("  storel "); W(nb); W(", "); WL(addr);
      IF SymTab.IsCharArray(t) THEN
        (* NUL terminator slot at index = count *)
        IntStr(VAL(INTEGER, 8 + SymTab.ArrayLen(t)), nb);
        NewTemp(ea);
        Op3L("add", ea, addr, nb);
        Revive;
        W("  storeb 0, "); WL(ea)
      END;
      IF SymTab.IsUCharArray(t) THEN
        (* 0-codepoint terminator at index = count (4-byte element) *)
        IntStr(VAL(INTEGER, 8 + SymTab.ArrayLen(t) * 4), nb);
        NewTemp(ea);
        Op3L("add", ea, addr, nb);
        Revive;
        W("  storew 0, "); WL(ea)
      END;
      ecls := SymTab.ClassOf(SymTab.ArrayElem(t));
      IF ecls = SymTab.ClArray THEN
        n := SymTab.ArrayLen(t);
        i := 0;
        WHILE i < n DO
          IntStr(VAL(INTEGER, 8 + i * 8), nb);
          NewTemp(ea);
          Op3L("add", ea, addr, nb);
          NewHeap(SymTab.ArrayElem(t), eb);
          InitHeap(eb, SymTab.ArrayElem(t));  (* init the sub-array *)
          Revive;
          W("  storel "); W(eb); W(", "); WL(ea);
          INC(i)
        END
      END
    ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
      n := SymTab.FieldCount(t);
      i := 0;
      WHILE i < n DO
        SymTab.FieldName(t, i, fn);
        ft := SymTab.FieldType(t, fn);
        ecls := SymTab.ClassOf(ft);
        IF ecls = SymTab.ClArray THEN
          (* inline array field: initialize its header in place *)
          IntStr(SymTab.FieldOffset(t, fn), nb);
          NewTemp(fa);
          Op3L("add", fa, addr, nb);
          InitHeap(fa, ft)
        ELSIF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass) THEN
          IntStr(SymTab.FieldOffset(t, fn), nb);
          NewTemp(fa);
          Op3L("add", fa, addr, nb);
          InitHeap(fa, ft)
        END;
        INC(i)
      END
    END
  END InitHeap;

BEGIN
  opened := FALSE;
  inBody := FALSE;
  dead := FALSE;
  nTemp := 0; nLab := 0; loopTop := 0; nR := 0; nStr := 0;
  withTop := 0;
  noEmit := FALSE; inFunc := FALSE; useStack := FALSE;
  nLoc := 0; nPar := 0; nArg := 0; nn := 0; callDepth := 0;
    recvArmed := FALSE;
  funcDepth := 0; scopeTop := 0; scopeBase[0] := 0;
  outSel := 0
END QbeGen.