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;
  (* compile-time set constants: pooled static masks (Lower's PoolSet) *)
  setN : CARDINAL;
  setNam : ARRAY [0 .. 255] OF QVal;               (* "setN" (no $) *)
  setW : ARRAY [0 .. 255] OF CARDINAL;             (* words per entry *)
  setMask : ARRAY [0 .. 255] OF ARRAY [0 .. 15] OF CARDINAL;
  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 *)
  excHas : ARRAY [0 .. 16] OF BOOLEAN;
  excBodyL, excHandlerL, excAfterL : ARRAY [0 .. 16] OF QVal;
  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;
  nFini : CARDINAL;
  finiNames : ARRAY [0 .. 31] OF QVal;
  sessBuf : ARRAY [0 .. 8388607] OF CHAR;  (* whole image, buffered (8 MiB:
                                              must hold the compiler's own
                                              image text when self-hosting) *)
  sessUsed : CARDINAL;
  nestBufs : ARRAY [0 .. 15] OF ARRAY [0 .. 131071] 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;
  (* 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_nFini, sav_sessUsed, sav_delayTop,
  sav_ustrN, sav_ustrUsed, sav_ctorN, sav_ctorTop, sav_funcDepth,
  sav_scopeTop, sav_callDepth, sav_outSel, sav_withTop,
  sav_setN : 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_nFini := nFini;
    sav_sessUsed := sessUsed; sav_delayTop := delayTop;
    sav_ustrN := ustrN; sav_ustrUsed := ustrUsed;
    sav_ctorN := ctorN; sav_ctorTop := ctorTop;
    sav_setN := setN;
    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; nFini := sav_nFini;
    sessUsed := sav_sessUsed; delayTop := sav_delayTop;
    ustrN := sav_ustrN; ustrUsed := sav_ustrUsed;
    ctorN := sav_ctorN; ctorTop := sav_ctorTop;
    setN := sav_setN;
    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 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;




(* ---------------- 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;
    setN := 0;
    nLoc := 0; nPar := 0; nArg := 0; nn := 0; callDepth := 0;
    recvArmed := FALSE;
    funcDepth := 0; scopeTop := 0; scopeBase[0] := 0;
    nInit := 0; nFini := 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 DataLineB (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
(* A one-byte global (BYTE/SBYTE). *)
  BEGIN
    IF NOT opened THEN RETURN END;
    W("data $"); W(name);
    W(" = { b ");
    W(init);
    WL(" }")
  END DataLineB;

PROCEDURE DataLineH (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
(* A 16-bit global (WORD16/INTEGER16). *)
  BEGIN
    IF NOT opened THEN RETURN END;
    W("data $"); W(name);
    W(" = { h ");
    W(init);
    WL(" }")
  END DataLineH;

PROCEDURE DataLinePacked (name: ARRAY OF CHAR; t: INTEGER);
(* A PACKEDSET global: 1/2/4 bytes, zero-initialised. *)
  VAR nb: CARDINAL;
  BEGIN
    IF NOT opened THEN RETURN END;
    nb := SymTab.SetBytes(t);
    W("data $"); W(name);
    W(" = { ");
    IF nb = 1 THEN W("b 0")
    ELSIF nb = 2 THEN W("h 0")
    ELSE W("w 0")
    END;
    WL(" }")
  END DataLinePacked;

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.IsByteType(t) THEN DataLineB(g, "0")
    ELSIF SymTab.IsWord16Type(t) THEN DataLineH(g, "0")
    ELSIF SymTab.ClassOf(t) = SymTab.ClArray THEN DeclArr(g, t)
    ELSIF SymTab.IsPackedSet(t) THEN DataLinePacked(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;
    excHas[0] := FALSE;
    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 BeginFini (mod: ARRAY OF CHAR);
(* Module FINALLY body as `<mod>_fini`; main calls it at termination. *)
  VAR sym : QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    excHas[0] := FALSE;
    Cpy(sym, mod);
    App(sym, "_fini");
    WL("");
    W("export function w $"); W(sym); WL("() {");
    WL("@start");
    IF nFini <= HIGH(finiNames) THEN
      Cpy(finiNames[nFini], sym); INC(nFini)
    END
  END BeginFini;

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

PROCEDURE BeginBody;
  VAR i : CARDINAL;
    t : QVal;
  BEGIN
    IF NOT opened OR inBody THEN RETURN END;
    WL("");
    WL("export function w $main() {");
    WL("@start");
    excHas[0] := FALSE;
    WL("  call $m2_exc_init()");
    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 FlushSets;
(* Pooled set constants.  Declared before EndModule, which calls it. *)
  VAR k, i: CARDINAL;
    w: CARDINAL;
    sv: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    k := 0;
    WHILE k < setN DO
      W("data $"); W(setNam[k]); W(" = { ");
      w := setW[k];
      IF w = 0 THEN w := 1 END;
      i := 0;
      WHILE i < w DO
        IF i > 0 THEN W(", ") END;
        IntStr(VAL(INTEGER, setMask[k][i]), sv);
        W("w "); W(sv);
        INC(i)
      END;
      WL(" }");
      INC(k)
    END
  END FlushSets;

PROCEDURE FiniExists (name: ARRAY OF CHAR): BOOLEAN;
  VAR i: CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nFini DO
      IF SymTab.Equal(finiNames[i], name) THEN RETURN TRUE END;
      INC(i)
    END;
    RETURN FALSE
  END FiniExists;

PROCEDURE EmitFiniCalls (prog: ARRAY OF CHAR);
(* Program finalizer first, then imported/local finalizers in reverse
   initialization order. *)
  VAR i: CARDINAL; p: QVal;
  BEGIN
    Cpy(p, prog); App(p, "_fini");
    IF FiniExists(p) THEN
      W("  call $"); W(p); WL("()")
    END;
    i := nFini;
    WHILE i > 0 DO
      DEC(i);
      IF NOT SymTab.Equal(finiNames[i], p) THEN
        W("  call $"); W(finiNames[i]); WL("()")
      END
    END
  END EmitFiniCalls;

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;
    EmitFiniCalls(name);
    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;
    FlushSets;
    EmitVTables;
    (* 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
      IF NOT SymTab.ProcBaseByUid(uid, base) THEN Cpy(base, pname) END
    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 SymTab.IsPackedSet(t) THEN
      W(" =l alloc4 4"); WL("");
      IF SymTab.SetBytes(t) = 1 THEN W("  storeb 0, "); WL(slot)
      ELSIF SymTab.SetBytes(t) = 2 THEN W("  storeh 0, "); WL(slot)
      ELSE W("  storew 0, "); WL(slot)
      END
    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)
    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
      W(" =l alloc4 4"); WL("");
      W("  storeb 0, "); WL(slot)
    ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
      W(" =l alloc4 4"); WL("");
      W("  storeh 0, "); WL(slot)
    ELSE
      W(" =l alloc4 4"); WL("");
      W("  storew 0, "); WL(slot)
    END
  END AllocLocal;

PROCEDURE OpenScalarDesc (val: ARRAY OF CHAR; t, ft: INTEGER; VAR desc: QVal);
(* gm2 compatibility: wrap a scalar actual as an `ARRAY OF BYTE`
   descriptor in the frame.  Layout is the usual [count][data]; the
   count is ObjectSize(actual), so HIGH matches gm2's SIZE-1, and the
   payload is a copy of the value (writes do not reach the actual). *)
  VAR cnt, off, nb: QVal;
    cls: INTEGER;
    sz, esz: CARDINAL;
  BEGIN
    sz := SymTab.ObjectSize(t);
    esz := SymTab.ObjectSize(SymTab.ArrayElem(ft));
    IF esz = 0 THEN esz := 1 END;
    NewTemp(desc); Revive;
    W("  "); W(desc); W(" =l alloc8 ");
    IntStr(VAL(INTEGER, 8 + sz * esz), nb); WL(nb);
    NewTemp(cnt); IntStr(VAL(INTEGER, sz), cnt);
    W("  storel "); W(cnt); W(", "); W(desc); WL("");
    NewTemp(off); Op3L("add", off, desc, "8");
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClReal THEN
      W("  stored "); W(val); W(", "); W(off); WL("")
    ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong) OR (sz > 4) THEN
      W("  storel "); W(val); W(", "); W(off); WL("")
    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
      W("  storeb "); W(val); W(", "); W(off); WL("")
    ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
      W("  storeh "); W(val); W(", "); W(off); WL("")
    ELSE
      W("  storew "); W(val); W(", "); W(off); WL("")
    END
  END OpenScalarDesc;

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);
    IF funcDepth <= HIGH(excHas) THEN excHas[funcDepth] := FALSE END;
    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
          CopySetVal(slot, parTyp[i], parTmp[i], 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)
        ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
          Revive;
          W("  storeb "); W(parTmp[i]); W(", "); WL(slot)
        ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
          Revive;
          W("  storeh "); 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 <= HIGH(excHas) THEN excHas[funcDepth] := FALSE END;
    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 resT # SymTab.InvalidType THEN
      (* A function that reaches its end without RETURN raises the
         language functionException instead of silently returning 0. *)
      TrapCode(4)
    ELSIF rc = "d" THEN WL("  ret d_0.0")
    ELSIF rc = "l" THEN WL("  ret 0")
    ELSE WL("  ret 0")
    END;
    WL("}");
    ScopeEnd;
    IF funcDepth <= HIGH(excHas) THEN excHas[funcDepth] := FALSE END;
    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 (funcDepth <= HIGH(excHas)) AND excHas[funcDepth] THEN
      WL("  call $m2_exc_leave()")
    END;
    IF hasVal THEN W("  ret "); WL(q)
    ELSE WL("  ret 0")
    END;
    dead := TRUE
  END EmitRet;

PROCEDURE ExcBegin;
(* M2: emit the handler prologue for the current function/module body.
   The QBE frame owns a 512-byte sigjmp_buf; the runtime handler stores
   that address.  Dispatch: 0 = body, 2 = RETRY/body, 1 = handler. *)
  VAR env, r, z, chk: QVal;
  BEGIN
    IF funcDepth > HIGH(excHas) THEN RETURN END;
    Revive;
    NewTemp(env);
    W("  "); W(env); WL(" =l alloc8 512");
    W("  call $m2_exc_push(l "); W(env); WL(")");
    NewTemp(r);
    W("  "); W(r); W(" =w call $__sigsetjmp(l "); W(env);
    W(", w 1)"); WL("");
    NewLabel(excBodyL[funcDepth]);
    NewLabel(excHandlerL[funcDepth]);
    NewLabel(excAfterL[funcDepth]);
    NewLabel(chk);
    NewTemp(z);
    Op3("ceqw", z, r, "0", FALSE);
    Jnz(z, excBodyL[funcDepth], chk);
    EmitLabel(chk);
    NewTemp(z);
    Op3("ceqw", z, r, "2", FALSE);
    Jnz(z, excBodyL[funcDepth], excHandlerL[funcDepth]);
    EmitLabel(excBodyL[funcDepth]);
    excHas[funcDepth] := TRUE
  END ExcBegin;

PROCEDURE ExcBodyDone;
  BEGIN
    IF funcDepth > HIGH(excHas) THEN RETURN END;
    Revive;
    WL("  call $m2_exc_leave()");
    Jmp(excAfterL[funcDepth])
  END ExcBodyDone;

PROCEDURE ExcHandlerBegin;
  BEGIN
    IF funcDepth > HIGH(excHas) THEN RETURN END;
    EmitLabel(excHandlerL[funcDepth])
  END ExcHandlerBegin;

PROCEDURE ExcEnd;
  BEGIN
    IF funcDepth > HIGH(excHas) THEN RETURN END;
    Revive;
    WL("  call $m2_exc_leave()");
    EmitLabel(excAfterL[funcDepth])
  END ExcEnd;

PROCEDURE ExcRetry;
  BEGIN
    IF dead THEN RETURN END;
    WL("  call $m2_exc_retry()");
    dead := TRUE
  END ExcRetry;

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 ")
    ELSIF SymTab.IsByteType(locTyp[idx]) THEN
      IF SymTab.IsSignedByte(locTyp[idx]) THEN W(" =w loadsb ")
      ELSE W(" =w loadub ")
      END
    ELSIF SymTab.IsWord16Type(locTyp[idx]) THEN
      IF SymTab.IsSignedWord16(locTyp[idx]) THEN W(" =w loadsh ")
      ELSE W(" =w loaduh ")
      END
    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 ")
    ELSIF SymTab.IsByteType(locTyp[idx]) THEN W("  storeb ")
    ELSIF SymTab.IsWord16Type(locTyp[idx]) THEN W("  storeh ")
    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 $")
      ELSIF SymTab.IsByteType(locTyp[flat]) THEN
        IF SymTab.IsSignedByte(locTyp[flat]) THEN W(" =w loadsb $")
        ELSE W(" =w loadub $")
        END
      ELSIF SymTab.IsWord16Type(locTyp[flat]) THEN
        IF SymTab.IsSignedWord16(locTyp[flat]) THEN W(" =w loadsh $")
        ELSE W(" =w loaduh $")
        END
      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 ")
      ELSIF SymTab.IsByteType(locTyp[flat]) THEN W("  storeb ")
      ELSIF SymTab.IsWord16Type(locTyp[flat]) THEN W("  storeh ")
      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;
    cv : QVal;
  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;
    (* an immediate CONST (incl. an enumeration literal) is its value *)
    IF k = SymTab.KindConst THEN
      IF SymTab.GetSymVal(name, cv) AND IsImm(cv) THEN
        Cpy(q, cv); RETURN TRUE
      END
    END;
    IF (k = SymTab.KindVar) OR (k = SymTab.KindParam)
       OR (k = SymTab.KindConst) THEN
      IF SymTab.IsSmallInt(t) THEN
        LoadShortVar(name, SymTab.IsSignedSmallInt(t),
          SymTab.SmallIntBytes(t), q); RETURN TRUE
      ELSIF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
         OR (cls = SymTab.ClChar) OR (cls = SymTab.ClEnum)
         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 LoadShortVar (name: ARRAY OF CHAR; signed: BOOLEAN;
                        bytes: CARDINAL; 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 bytes = 1 THEN
      IF signed THEN W(" =w loadsb ") ELSE W(" =w loadub ") END
    ELSE
      IF signed THEN W(" =w loadsh ") ELSE W(" =w loaduh ") END
    END;
    WL(ref)
  END LoadShortVar;

PROCEDURE StoreShortVar (name: ARRAY OF CHAR; bytes: CARDINAL;
                         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, FALSE)
      ELSE UpStore(idx, levels, q, FALSE)
      END;
      RETURN
    END;
    Revive;
    SymRef(name, ref);
    IF bytes = 1 THEN W("  storeb ") ELSE W("  storeh ") END;
    W(q); W(", "); WL(ref)
  END StoreShortVar;

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) OR (cls = SymTab.ClByte)
       OR (cls = SymTab.ClSByte) THEN RETURN 1
    ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN RETURN 2
    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 TrapCode (code: CARDINAL);
  VAR q: QVal;
  BEGIN
    Revive;
    IntStr(VAL(INTEGER, code), q);
    W("  call $m2_exc_raise_lang(w "); W(q); WL(")");
    WL("  hlt");
    dead := TRUE
  END TrapCode;

PROCEDURE Trap;
  BEGIN
    TrapCode(12)   (* sysException *)
  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 HasArrayField (t: SymTab.TypeIndex): BOOLEAN;
(* TRUE when record type t (recursively) has any ARRAY field.  Such
   record arrays need per-element expansion so each inline array field's
   descriptor length word is initialised; a compact zero blob would
   leave the count 0 and trap when the field is passed as an open array.
   Records with no array field still stay a compact blob. *)
  VAR i: CARDINAL; fn: SymTab.Name; ft: 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 RETURN TRUE
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        IF HasArrayField(ft) THEN RETURN TRUE END
      END;
      INC(i)
    END;
    RETURN FALSE
  END HasArrayField;

PROCEDURE HasMultiArrayField (t: SymTab.TypeIndex): BOOLEAN;
(* TRUE when a record/class contains a rank-2/3 array field, directly
   or in a nested record.  Such record constructors need the runtime
   path so the flat field payload is handled by a view. *)
  VAR i: CARDINAL; fn: SymTab.Name; ft: 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) AND SymTab.IsMultiArray(ft) THEN
        RETURN TRUE
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        IF HasMultiArrayField(ft) THEN RETURN TRUE END
      END;
      INC(i)
    END;
    RETURN FALSE
  END HasMultiArrayField;

PROCEDURE RecArrayExpanded (n: CARDINAL; t: INTEGER): BOOLEAN;
(* TRUE when a record-/class-array's per-element expansion fits the image
   budget.  Larger tables keep the compact zero blob and are instead
   initialised at run time (RecArrayNeedsInit/InitRecArray).  The budget
   keeps the compiler's own huge tables (AST.arena: 262144 records) from
   inflating the 4 MiB image. *)
  BEGIN
    RETURN VAL(INTEGER, n) * VAL(INTEGER, SymTab.TypeSize(t)) <= 131072
  END RecArrayExpanded;

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) OR (cls = SymTab.ClByte)
            OR (cls = SymTab.ClSByte) THEN Sep; W("b 0")
         ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
           Sep; W("h 0")
         ELSIF cls = SymTab.ClArray THEN
           Sep;
           IF SymTab.IsMultiArray(ft) THEN
             W("z "); IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(ft)), rsub);
             W(rsub)
           ELSE
             Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
             ArrBodyItems(rsub, ft)
           END
         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 HasArrayField(elem)
        AND RecArrayExpanded(n, elem) THEN
      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.ClByte) OR (ecls = SymTab.ClSByte) THEN esz := 1
        ELSIF (ecls = SymTab.ClWord16) OR (ecls = SymTab.ClSWord16) THEN esz := 2
        ELSIF (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) AND NOT SymTab.IsMultiArray(ft) 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 HasArrayField(elem)
        AND RecArrayExpanded(SymTab.ArrayLen(t), 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) AND NOT SymTab.IsMultiArray(ft) 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) OR (cls = SymTab.ClByte)
         OR (cls = SymTab.ClSByte) THEN Sep; W("b 0")
      ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
        Sep; W("h 0")
      ELSIF cls = SymTab.ClArray THEN
        Sep;
        IF SymTab.IsMultiArray(ft) THEN
          W("z "); IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(ft)), sub);
          W(sub)
        ELSE
          Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
          ArrBodyItems(sub, ft)
        END
      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)
      ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
         OR (cls = SymTab.ClProc) THEN
        (* 8-byte fields: match the layout's pointer/long size (a `w 0`
           here would shrink the global and clobber the next symbol) *)
        Sep; W("l 0")
      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 PoolSet (mask: ARRAY OF CARDINAL; words: CARDINAL; VAR q: QVal);
  VAR k: CARDINAL;
  BEGIN
    IF NOT opened OR noEmit THEN Cpy(q, "0"); RETURN END;
    IF setN > HIGH(setW) THEN Cpy(q, "0"); RETURN END;
    k := 0;
    WHILE (k < words) AND (k <= HIGH(mask)) AND (k <= 15) DO
      setMask[setN][k] := mask[k]; INC(k)
    END;
    WHILE k <= 15 DO setMask[setN][k] := 0; INC(k) END;
    setW[setN] := words;
    Cpy(setNam[setN], "set"); AppNum(setNam[setN], setN);
    Cpy(q, "$"); App(q, setNam[setN]);
    INC(setN)
  END PoolSet;

PROCEDURE PoolSetNamed (name: ARRAY OF CHAR; mask: ARRAY OF CARDINAL;
                        words: CARDINAL; VAR q: QVal);
(* Like PoolSet but registers the descriptor as `data $<name>` — used for
   a module-level set CONST, whose global name (<unit>_<const>) is what a
   client's qualified reference emits. *)
  VAR k: CARDINAL;
  BEGIN
    IF NOT opened OR noEmit THEN Cpy(q, "0"); RETURN END;
    IF setN > HIGH(setW) THEN Cpy(q, "0"); RETURN END;
    k := 0;
    WHILE (k < words) AND (k <= HIGH(mask)) AND (k <= 15) DO
      setMask[setN][k] := mask[k]; INC(k)
    END;
    WHILE k <= 15 DO setMask[setN][k] := 0; INC(k) END;
    setW[setN] := words;
    Cpy(setNam[setN], name);
    Cpy(q, "$"); App(q, name);
    INC(setN)
  END PoolSetNamed;

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, sj, 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);
    (* a dropped bit must still address a *valid* word: clamp the index
       to 0 when out of range, so the load below cannot fault (the store
       is already masked to a no-op by ok via mm3) *)
    NewTemp(sj);   Op3("mul", sj, j, ok, FALSE);
    NewTemp(wj);   Op3("shr", wj, sj, "5", FALSE);
    NewTemp(bj);   Op3("and", bj, sj, "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 LoadPacked (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
  VAR nb: CARDINAL;
  BEGIN
    nb := SymTab.SetBytes(t);
    NewTemp(q);
    Revive;
    W("  "); W(q);
    IF nb = 1 THEN W(" =w loadub ")
    ELSIF nb = 2 THEN W(" =w loaduh ")
    ELSE W(" =w loadw ")
    END;
    WL(addr)
  END LoadPacked;

PROCEDURE StorePacked (addr: ARRAY OF CHAR; t: INTEGER;
                       v: ARRAY OF CHAR);
  VAR nb: CARDINAL;
  BEGIN
    nb := SymTab.SetBytes(t);
    Revive;
    IF nb = 1 THEN W("  storeb ")
    ELSIF nb = 2 THEN W("  storeh ")
    ELSE W("  storew ")
    END;
    W(v); W(", "); WL(addr)
  END StorePacked;

PROCEDURE CopySetVal (dst: ARRAY OF CHAR; dt: INTEGER;
                      src: ARRAY OF CHAR; et: INTEGER);
  VAR q: QVal;
  BEGIN
    IF SymTab.IsPackedSet(dt) THEN
      IF SymTab.IsPackedSet(et) THEN LoadPacked(src, et, q)
      ELSE LoadW(src, q)
      END;
      StorePacked(dst, dt, q)
    ELSIF SymTab.IsPackedSet(et) THEN
      SetZero(dst, SymTab.SetWords(dt));
      LoadPacked(src, et, q);
      StoreW(dst, q)
    ELSE CopySet(dst, src, SymTab.SetWords(dt), SymTab.SetWords(et))
    END
  END CopySetVal;

PROCEDURE PackedSetBit (addr: ARRAY OF CHAR; t: INTEGER;
                        val: ARRAY OF CHAR; lo: INTEGER; span: CARDINAL);
  VAR off, offL, hiS, loS, m, old, nv: 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(m);
    Op3("shl", m, "1", off, FALSE);
    LoadPacked(addr, t, old);
    NewTemp(nv);
    Op3("or", nv, old, m, FALSE);
    StorePacked(addr, t, nv)
  END PackedSetBit;

PROCEDURE PackedSetClearBit (addr: ARRAY OF CHAR; t: INTEGER;
                             val: ARRAY OF CHAR; lo: INTEGER;
                             span: CARDINAL);
  VAR off, offL, hiS, loS, m, nm, old, nv: 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(m);
    Op3("shl", m, "1", off, FALSE);
    NewTemp(nm);
    Op3("xor", nm, m, "-1", FALSE);
    LoadPacked(addr, t, old);
    NewTemp(nv);
    Op3("and", nv, old, nm, FALSE);
    StorePacked(addr, t, nv)
  END PackedSetClearBit;

PROCEDURE PackedInSet (x: ARRAY OF CHAR; s: ARRAY OF CHAR;
                       lo: INTEGER; span: CARDINAL; t: INTEGER;
                       VAR q: QVal);
  VAR off, offL, hiS, loS, word, sh, bit: QVal;
  BEGIN
    NewTemp(off);
    IntStr(lo, loS);
    Op3("sub", off, x, loS, FALSE);
    WidenIndex(off, offL);
    IntStr(VAL(INTEGER, span) - 1, hiS);
    CheckRange(offL, "0", hiS);
    LoadPacked(s, t, word);
    NewTemp(sh);
    Op3("shr", sh, word, off, FALSE);
    NewTemp(bit);
    Op3("and", bit, sh, "1", FALSE);
    Cmp(SymTab.OpNeq1, bit, "0", q, FALSE)
  END PackedInSet;

PROCEDURE PackedCmpSet (op: INTEGER; l: ARRAY OF CHAR; lt: INTEGER;
                        r: ARRAY OF CHAR; rt: INTEGER; VAR q: QVal);
  VAR q1, q2: QVal;
  BEGIN
    IF SymTab.IsPackedSet(lt) THEN LoadPacked(l, lt, q1)
    ELSE LoadW(l, q1)
    END;
    IF SymTab.IsPackedSet(rt) THEN LoadPacked(r, rt, q2)
    ELSE LoadW(r, q2)
    END;
    Cmp(op, q1, q2, q, FALSE)
  END PackedCmpSet;

PROCEDURE PackedSetBinOp (sel: INTEGER; l: ARRAY OF CHAR; lt: INTEGER;
                          r: ARRAY OF CHAR; rt: INTEGER; VAR q: QVal);
  VAR tl, tr, w: QVal;
  BEGIN
    NewSetTemp(1, tl); NewSetTemp(1, tr);
    IF SymTab.IsPackedSet(lt) THEN LoadPacked(l, lt, w)
    ELSE LoadW(l, w)
    END;
    StoreW(tl, w);
    IF SymTab.IsPackedSet(rt) THEN LoadPacked(r, rt, w)
    ELSE LoadW(r, w)
    END;
    StoreW(tr, w);
    SetBinOp(sel, tl, tr, 1, 1, q)
  END PackedSetBinOp;

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 CheckCode (idx, lo, hi: ARRAY OF CHAR; code: CARDINAL);
(* 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);
    TrapCode(code);
    EmitLabel(lok)
  END CheckCode;

PROCEDURE CheckRange (idx, lo, hi: ARRAY OF CHAR);
  BEGIN
    CheckCode(idx, lo, hi, 1)   (* rangeException *)
  END CheckRange;

PROCEDURE CheckIndex (idx, lo, hi: ARRAY OF CHAR);
  BEGIN
    CheckCode(idx, lo, hi, 0)   (* indexException *)
  END CheckIndex;

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 ViewField (view: ARRAY OF CHAR; off: CARDINAL; VAR q: QVal);
(* q := loadl(view + off), off one of 0,8,16,24,32. *)
  VAR a, s: QVal;
  BEGIN
    NewTemp(a);
    IntStr(VAL(INTEGER, off), s);
    Op3L("add", a, view, s);
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l loadl "); WL(a)
  END ViewField;

PROCEDURE ViewIndex (view, idx, lo: ARRAY OF CHAR;
                     nextIsArray: BOOLEAN; VAR q: QVal);
  VAR t1, stride, off, base, addr, nv, next, tmp: QVal;
  BEGIN
    NewTemp(t1);
    Op3L("sub", t1, idx, lo);
    ViewField(view, 16, stride);
    NewTemp(off);
    Op3L("mul", off, t1, stride);
    ViewField(view, 24, base);
    NewTemp(addr);
    Op3L("add", addr, base, off);
    IF NOT nextIsArray THEN
      CopyOp(addr, q)
    ELSE
      ViewField(view, 32, next);
      NewTemp(nv);
      Revive;
      W("  "); W(nv); WL(" =l alloc8 40");
      (* copy count, elemBytes, stride and next from the template *)
      ViewField(next, 0, tmp);
      Revive; W("  storel "); W(tmp); W(", "); WL(nv);
      IntStr(8, off);
      NewTemp(t1); Op3L("add", t1, nv, off);
      ViewField(next, 8, tmp);
      Revive; W("  storel "); W(tmp); W(", "); WL(t1);
      IntStr(16, off);
      NewTemp(t1); Op3L("add", t1, nv, off);
      ViewField(next, 16, tmp);
      Revive; W("  storel "); W(tmp); W(", "); WL(t1);
      IntStr(32, off);
      NewTemp(t1); Op3L("add", t1, nv, off);
      ViewField(next, 32, tmp);
      Revive; W("  storel "); W(tmp); W(", "); WL(t1);
      IntStr(24, off);
      NewTemp(t1); Op3L("add", t1, nv, off);
      Revive; W("  storel "); W(addr); W(", "); WL(t1);
      CopyOp(nv, q)
    END
  END ViewIndex;

PROCEDURE MakeFieldView (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
  VAR rank, k, count, stride: CARDINAL;
    cur: SymTab.TypeIndex;
    v, a, nb, off: QVal;
  BEGIN
    rank := SymTab.ArrayDepth(t);
    IF rank <= 1 THEN CopyOp(addr, q); RETURN END;
    IntStr(VAL(INTEGER, rank * 40), nb);
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l alloc8 "); WL(nb);
    cur := t; k := 0;
    WHILE k < rank DO
      IntStr(VAL(INTEGER, k * 40), off);
      NewTemp(v); Op3L("add", v, q, off);
      count := SymTab.ArrayLen(cur);
      stride := SymTab.ArrayStride(t, k);
      IntStr(VAL(INTEGER, count), nb);
      Revive; W("  storel "); W(nb); W(", "); WL(v);
      IntStr(VAL(INTEGER, stride), nb);
      NewTemp(a); Op3L("add", a, v, "8");
      Revive; W("  storel "); W(nb); W(", "); WL(a);
      NewTemp(a); Op3L("add", a, v, "16");
      Revive; W("  storel "); W(nb); W(", "); WL(a);
      IF k = 0 THEN
        NewTemp(a); Op3L("add", a, v, "24");
        Revive; W("  storel "); W(addr); W(", "); WL(a)
      ELSE
        NewTemp(a); Op3L("add", a, v, "24");
        Revive; W("  storel 0, "); WL(a)
      END;
      IF k + 1 < rank THEN
        NewTemp(a); Op3L("add", a, v, "32");
        IntStr(VAL(INTEGER, (k + 1) * 40), off);
        NewTemp(nb); Op3L("add", nb, q, off);
        Revive; W("  storel "); W(nb); W(", "); WL(a)
      ELSE
        NewTemp(a); Op3L("add", a, v, "32");
        Revive; W("  storel 0, "); WL(a)
      END;
      cur := SymTab.ArrayElem(cur);
      INC(k)
    END
  END MakeFieldView;

PROCEDURE ViewToOpen1D (view: ARRAY OF CHAR; ft: INTEGER;
                        VAR q, base, nbytes: QVal);
  VAR count, elem, total, n, desc, p, p2, eoff: QVal;
    cls, extra: INTEGER;
  BEGIN
    ViewField(view, 0, count);
    ViewField(view, 8, elem);
    NewTemp(total);
    Op3L("mul", total, count, elem);
    cls := SymTab.ClassOf(SymTab.ArrayElem(ft));
    IF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
      CopyOp(total, count)
    END;
    extra := 0;
    IF cls = SymTab.ClChar THEN extra := 1
    ELSIF cls = SymTab.ClUChar THEN extra := 4
    END;
    NewTemp(n);
    Op3L("add", n, total, "8");
    IF extra > 0 THEN
      IntStr(VAL(INTEGER, extra), eoff);
      NewTemp(p); Op3L("add", p, n, eoff); CopyOp(p, n)
    END;
    NewTemp(desc);
    W("  "); W(desc); W(" =l call $malloc(l "); W(n); WL(")");
    Revive;
    W("  storel "); W(count); W(", "); WL(desc);
    ViewField(view, 24, base);
    CopyOp(total, nbytes);
    NewTemp(p);
    Op3L("add", p, desc, "8");
    Revive;
    W("  "); W(n); W(" =l call $memcpy(l ");
    W(p); W(", l "); W(base); W(", l "); W(total); WL(")");
    IF extra > 0 THEN
      NewTemp(p); Op3L("add", p, desc, "8");
      NewTemp(p2); Op3L("add", p2, p, total);
      Revive;
      IF extra = 1 THEN W("  storeb 0, "); WL(p2)
      ELSE W("  storew 0, "); WL(p2) END
    END;
    CopyOp(desc, q)
  END ViewToOpen1D;

PROCEDURE ViewCopyBack (desc, base, nbytes: ARRAY OF CHAR);
  VAR p, r: QVal;
  BEGIN
    NewTemp(p);
    Op3L("add", p, desc, "8");
    NewTemp(r);
    W("  "); W(r); W(" =l call $memcpy(l ");
    W(base); W(", l "); W(p); W(", l "); W(nbytes); WL(")")
  END ViewCopyBack;

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

PROCEDURE ViewBase (view: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    ViewField(view, 24, q)
  END ViewBase;

PROCEDURE ViewSize (view: ARRAY OF CHAR; VAR q: QVal);
  VAR cnt, esz, r: QVal;
  BEGIN
    ViewField(view, 0, cnt);
    ViewField(view, 8, esz);
    NewTemp(r);
    Op3L("mul", r, cnt, esz);
    CopyOp(r, q)
  END ViewSize;

PROCEDURE DescData (desc: ARRAY OF CHAR; VAR q: QVal);
  BEGIN
    NewTemp(q);
    Op3L("add", q, desc, "8")
  END DescData;

PROCEDURE OpenSize (desc: ARRAY OF CHAR; ft: INTEGER; VAR q: QVal);
  VAR cnt, esz, r: QVal;
  BEGIN
    NewTemp(q);
    Revive;
    W("  "); W(q); W(" =l loadl "); WL(desc);
    IntStr(VAL(INTEGER, SymTab.ArrayLeafBytes(ft)), esz);
    NewTemp(r);
    Op3L("mul", r, q, esz);
    CopyOp(r, q)
  END OpenSize;

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 ")
    ELSIF cls = SymTab.ClSet THEN
      IF SymTab.IsPackedSet(t) AND (SymTab.SetBytes(t) = 1) THEN
        W(" =w loadub ")
      ELSIF SymTab.IsPackedSet(t) AND (SymTab.SetBytes(t) = 2) THEN
        W(" =w loaduh ")
      ELSE W(" =w loadw ")
      END
    ELSIF cls = SymTab.ClByte THEN W(" =w loadub ")
    ELSIF cls = SymTab.ClSByte THEN W(" =w loadsb ")
    ELSIF cls = SymTab.ClWord16 THEN W(" =w loaduh ")
    ELSIF cls = SymTab.ClSWord16 THEN W(" =w loadsh ")
    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 ")
    ELSIF cls = SymTab.ClSet THEN
      IF SymTab.IsPackedSet(t) AND (SymTab.SetBytes(t) = 1) THEN
        W("  storeb ")
      ELSIF SymTab.IsPackedSet(t) AND (SymTab.SetBytes(t) = 2) THEN
        W("  storeh ")
      ELSE W("  storew ")
      END
    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN W("  storeb ")
    ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN W("  storeh ")
    ELSE W("  storew ")
    END;
    W(v); W(", "); WL(addr)
  END ElemStore;

PROCEDURE CopyOldNestedToView (dst, src: ARRAY OF CHAR;
                               t: INTEGER; rank: CARDINAL);
(* Adapt an old nested-descriptor constructor (e.g. names{"Thu","Fri"})
   into a flat multi-dimensional view payload.  Only static constructor
   sources use this path. *)
  VAR count, base, esz, row, a, off, off2, child, i, c: QVal;
    ltop, lbody, lend: QVal;
  BEGIN
    IF rank <= 1 THEN
      ViewField(dst, 24, base);
      ViewField(dst, 0, count);
      ViewField(dst, 8, esz);
      NewTemp(a);
      Op3L("mul", a, count, esz);
      NewTemp(off); Op3L("add", off, src, "8");
      NewTemp(c);
      W("  "); W(c); W(" =l call $memcpy(l ");
      W(base); W(", l "); W(off); W(", l "); W(a); WL(")")
    ELSE
      ViewField(dst, 0, count);
      NewTemp(i);
      W("  "); W(i); W(" =l copy 0"); WL("");
      NewLabel(ltop); NewLabel(lbody); NewLabel(lend);
      EmitLabel(ltop);
      NewTemp(c); Op3("csltl", c, i, count, FALSE);
      Jnz(c, lbody, lend);
      EmitLabel(lbody);
      ViewIndex(dst, i, "0", TRUE, row);
      NewTemp(off); Op3L("mul", off, i, "8");
      NewTemp(a); Op3L("add", a, src, "8");
      NewTemp(off2); Op3L("add", off2, a, off);
      NewTemp(child); W("  "); W(child); W(" =l loadl "); WL(off2);
      CopyOldNestedToView(row, child, SymTab.ArrayElem(t), rank - 1);
      Op3L("add", i, i, "1");
      Jmp(ltop);
      EmitLabel(lend)
    END
  END CopyOldNestedToView;

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
    IF SymTab.IsMultiArray(t) THEN
      IF (src[0] = "$") AND (src[1] = "c") AND (src[2] = "t")
         AND (src[3] = "o") THEN
        CopyOldNestedToView(dst, src, t, SymTab.ArrayDepth(t))
      ELSE
        (* src/dst are ArrayView pointers; copy the flat payload only. *)
        ViewField(dst, 24, da);
        ViewField(src, 24, sa);
        ViewField(dst, 0, n);
        ViewField(dst, 8, sb);
        NewTemp(qr);
        Op3L("mul", qr, n, sb);
        NewTemp(n);
        W("  "); W(n); W(" =l call $memcpy(l ");
        W(da); W(", l "); W(sa); W(", l "); W(qr); WL(")")
      END;
      RETURN
    END;
    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 CopyArrayEx (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                       t: INTEGER; dstIsView, srcIsView: BOOLEAN);
  VAR db, dc, de, sb, sc, se, total, srcData, dstData, r: QVal;
  BEGIN
    IF SymTab.IsMultiArray(t) THEN
      CopyArray(dst, src, t); RETURN
    END;
    IF dstIsView THEN
      ViewField(dst, 24, db);
      ViewField(dst, 0, dc);
      ViewField(dst, 8, de);
      NewTemp(total); Op3L("mul", total, dc, de);
      IF srcIsView THEN
        ViewField(src, 24, sb)
      ELSE
        NewTemp(srcData); Op3L("add", srcData, src, "8"); CopyOp(srcData, sb)
      END;
      NewTemp(r);
      W("  "); W(r); W(" =l call $memcpy(l ");
      W(db); W(", l "); W(sb); W(", l "); W(total); WL(")")
    ELSIF srcIsView THEN
      ViewField(src, 24, sb);
      ViewField(src, 0, sc);
      ViewField(src, 8, se);
      NewTemp(total); Op3L("mul", total, sc, se);
      NewTemp(dstData); Op3L("add", dstData, dst, "8");
      NewTemp(r);
      W("  "); W(r); W(" =l call $memcpy(l ");
      W(dstData); W(", l "); W(sb); W(", l "); W(total); WL(")")
    ELSE
      CopyArray(dst, src, t)
    END
  END CopyArrayEx;

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 StrLitLen (v: ARRAY OF CHAR; VAR n: INTEGER): BOOLEAN;
  VAR k: CARDINAL;
  BEGIN
    n := 0;
    IF NOT FindStrPos(v, k) THEN RETURN FALSE END;
    n := VAL(INTEGER, SymTab.StrLen(strTexts[k]) - 2);
    RETURN TRUE
  END StrLitLen;

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 DeclMultiArr (name: ARRAY OF CHAR; t: INTEGER);
(* Static fixed multi-dimensional array: a chain of view descriptors
   plus one contiguous payload block.  One-dimensional arrays still use
   ArrData. *)
  VAR rank, k, count, stride, payload: CARDINAL;
    cur: SymTab.TypeIndex;
    lab, base, nxt, bv, sv, pv: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    rank := SymTab.ArrayDepth(t);
    IF rank < 2 THEN ArrData(name, t); RETURN END;
    payload := SymTab.ArrayPayloadSize(t);
    cur := t;
    k := 0;
    WHILE k < rank DO
      count := SymTab.ArrayLen(cur);
      stride := SymTab.ArrayStride(t, k);
      Cpy(lab, name);
      IF k > 0 THEN
        App(lab, "_t"); IntStr(VAL(INTEGER, k), bv); App(lab, bv)
      END;
      IF k = 0 THEN
        Cpy(base, "$"); App(base, name); App(base, "_data")
      ELSE
        Cpy(base, "0")
      END;
      IF k + 1 < rank THEN
        Cpy(nxt, "$"); App(nxt, name); App(nxt, "_t");
        IntStr(VAL(INTEGER, k + 1), bv); App(nxt, bv)
      ELSE
        Cpy(nxt, "0")
      END;
      W("data $"); W(lab); W(" = { l ");
      IntStr(VAL(INTEGER, count), bv); W(bv);
      W(", l "); IntStr(VAL(INTEGER, stride), sv); W(sv);
      W(", l "); W(sv);
      W(", l "); W(base);
      W(", l "); W(nxt); WL(" }");
      cur := SymTab.ArrayElem(cur);
      INC(k)
    END;
    W("data $"); W(name); W("_data = { z ");
    IntStr(VAL(INTEGER, payload), pv); W(pv); WL(" }")
  END DeclMultiArr;

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;
    IF SymTab.IsMultiArray(t) THEN DeclMultiArr(name, t)
    ELSE ArrData(name, t)
    END
  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) OR (cls = SymTab.ClByte)
       OR (cls = SymTab.ClSByte) THEN
      App(buf, "b ")
    ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
      App(buf, "h ")
    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;
      IF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass) THEN
        ci := FindCtor(v);
        IF ci >= 0 THEN
          App(s, ", "); App(s, ctorTxt[ci]);
          ctorUse[ci] := FALSE
        ELSE
          AppFlatZero(s, SymTab.TypeSize(elem))
        END
      ELSE
        CtorItem(s, v, ecls)
      END;
      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 NextCtorTok (txt: ARRAY OF CHAR; VAR pos: CARDINAL;
                       VAR kind: CHAR; VAR val: QVal): BOOLEAN;
  VAR L, j: CARDINAL;
  BEGIN
    val[0] := CHR(0); kind := CHR(0);
    L := Len(txt);
    WHILE (pos < L) AND ((txt[pos] = " ") OR (txt[pos] = ",")) DO
      INC(pos)
    END;
    IF (pos >= L) OR (txt[pos] = "}") THEN RETURN FALSE END;
    kind := txt[pos]; INC(pos);
    WHILE (pos < L) AND (txt[pos] = " ") DO INC(pos) END;
    j := 0;
    WHILE (pos < L) AND (txt[pos] # ",") AND (txt[pos] # " ")
          AND (txt[pos] # "}") DO
      IF j <= HIGH(val) THEN val[j] := txt[pos] END;
      INC(j); INC(pos)
    END;
    IF j <= HIGH(val) THEN val[j] := CHR(0) END;
    RETURN TRUE
  END NextCtorTok;

PROCEDURE AppFlat (VAR out: ARRAY OF CHAR; kind: CHAR; val: ARRAY OF CHAR);
  VAR n: CARDINAL;
  BEGIN
    IF out[0] # CHR(0) THEN App(out, ", ") END;
    IF kind # CHR(0) THEN
      n := Len(out);
      out[n] := kind;
      out[n + 1] := CHR(0);
      App(out, " ")
    END;
    App(out, val)
  END AppFlat;

PROCEDURE AppFlatZero (VAR out: ARRAY OF CHAR; n: CARDINAL);
  VAR bv: QVal;
  BEGIN
    IF n = 0 THEN RETURN END;
    IF out[0] # CHR(0) THEN App(out, ", ") END;
    App(out, "z ");
    IntStr(VAL(INTEGER, n), bv); App(out, bv)
  END AppFlatZero;

PROCEDURE AppZeroItem (VAR out: ARRAY OF CHAR; n: CARDINAL);
  VAR bv: QVal;
  BEGIN
    IF n = 0 THEN RETURN END;
    App(out, "z ");
    IntStr(VAL(INTEGER, n), bv); App(out, bv)
  END AppZeroItem;

PROCEDURE FlattenArrayText (txt: ARRAY OF CHAR; t: INTEGER;
                            VAR out: ARRAY OF CHAR);
  VAR pos: CARDINAL; kind: CHAR; val: QVal; n, i, elemN, ci: INTEGER;
    elem: SymTab.TypeIndex;
  BEGIN
    pos := 0;
    IF (NOT NextCtorTok(txt, pos, kind, val)) OR (kind # "l")
       OR (NOT ParseInt(val, n)) OR (n < 0) THEN
      AppFlatZero(out, SymTab.ArrayPayloadSize(t)); RETURN
    END;
    elem := SymTab.ArrayElem(t);
    elemN := VAL(INTEGER, SymTab.ArrayPayloadSize(elem));
    i := 0;
    WHILE i < n DO
      IF NOT NextCtorTok(txt, pos, kind, val) THEN
        AppFlatZero(out, VAL(CARDINAL, elemN))
      ELSIF SymTab.ClassOf(elem) = SymTab.ClArray THEN
        ci := FindCtor(val);
        IF (kind = "l") AND (val[0] = "$") AND (ci >= 0) THEN
          FlattenArrayText(ctorTxt[ci], elem, out)
        ELSE
          AppFlatZero(out, VAL(CARDINAL, elemN))
        END
      ELSE
        AppFlat(out, kind, val)
      END;
      INC(i)
    END
  END FlattenArrayText;

PROCEDURE FlattenCtorText (v: ARRAY OF CHAR; t: INTEGER;
                           VAR out: ARRAY OF CHAR);
  VAR ci: INTEGER;
  BEGIN
    ci := FindCtor(v);
    IF ci < 0 THEN
      AppFlatZero(out, SymTab.ArrayPayloadSize(t))
    ELSE
      FlattenArrayText(ctorTxt[ci], t, out)
    END
  END FlattenCtorText;

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;
    flat: ARRAY [0 .. 4095] OF CHAR;
    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 (cls = SymTab.ClArray)
         AND SymTab.IsMultiArray(ft) THEN
        flat[0] := CHR(0);
        IF (v[0] = "$") AND (v[1] = "c") THEN
          FlattenCtorText(v, ft, flat)
        END;
        IF first THEN first := FALSE ELSE App(s, ", ") END;
        IF flat[0] # CHR(0) THEN App(s, flat)
        ELSE AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
        END
      ELSIF (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
          IF SymTab.IsMultiArray(ft) THEN
            AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
          ELSE ArrZeroBody(s, ft)
          END
        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
          IF SymTab.IsMultiArray(ft) THEN
            AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
          ELSE ArrZeroBody(s, ft)
          END
        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 ClearBytes (addr: ARRAY OF CHAR; n: CARDINAL);
  VAR nb, a: QVal;
  BEGIN
    IF n = 0 THEN RETURN END;
    IntStr(VAL(INTEGER, n), nb);
    NewTemp(a);
    W("  "); W(a); W(" =l call $memset(l "); W(addr);
    W(", w 0, l "); W(nb); WL(")")
  END ClearBytes;

PROCEDURE ClearMultiField (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
  VAR nb, a: QVal;
  BEGIN
    IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(t)), nb);
    NewTemp(a);
    W("  "); W(a); W(" =l call $memset(l "); W(addr);
    W(", w 0, l "); W(nb); WL(")")
  END ClearMultiField;

PROCEDURE CtorEnd (VAR q: QVal);
  VAR t, cls, lvl, k, n, cnt, esz, off, ci: INTEGER;
    allc: BOOLEAN;
    bv, a, v, qview: 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 (SymTab.ClassOf(elem) = SymTab.ClRecord)
             OR (SymTab.ClassOf(elem) = SymTab.ClClass) THEN
            IF k < cnt THEN
              Cpy(v, ctorEv[lvl][k]);
              CopyRecord(a, v, elem)
            ELSE
              ClearBytes(a, SymTab.TypeSize(elem))
            END
          ELSIF 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
              IF SymTab.IsMultiArray(ft) THEN
                MakeFieldView(a, ft, qview);
                CopyArray(qview, v, ft)
              ELSE
                InitArrHeader(a, ft);
                CopyArray(a, v, ft)
              END
            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.ClArray)
             AND SymTab.IsMultiArray(ft) THEN
            ClearMultiField(a, ft)
          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) AND SymTab.IsMultiArray(t) THEN
      RETURN SymTab.ArrayDepth(t) * 40 + SymTab.ArrayPayloadSize(t)
    ELSIF 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 InitMultiHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
(* Initialise the per-level view chain and zero the flat payload. *)
  VAR rank, k, count, stride, payload: CARDINAL;
    cur: SymTab.TypeIndex;
    v, a, nb, off, pay: QVal;
  BEGIN
    rank := SymTab.ArrayDepth(t);
    payload := SymTab.ArrayPayloadSize(t);
    cur := t;
    k := 0;
    WHILE k < rank DO
      IntStr(VAL(INTEGER, k * 40), off);
      NewTemp(v); Op3L("add", v, addr, off);
      count := SymTab.ArrayLen(cur);
      IntStr(VAL(INTEGER, count), nb);
      Revive; W("  storel "); W(nb); W(", "); WL(v);
      stride := SymTab.ArrayStride(t, k);
      IntStr(VAL(INTEGER, stride), nb);
      NewTemp(a); Op3L("add", a, v, "8");
      Revive; W("  storel "); W(nb); W(", "); WL(a);
      NewTemp(a); Op3L("add", a, v, "16");
      Revive; W("  storel "); W(nb); W(", "); WL(a);
      IF k = 0 THEN
        IntStr(VAL(INTEGER, rank * 40), off);
        NewTemp(pay); Op3L("add", pay, addr, off);
        NewTemp(a); Op3L("add", a, v, "24");
        Revive; W("  storel "); W(pay); W(", "); WL(a)
      ELSE
        NewTemp(a); Op3L("add", a, v, "24");
        Revive; W("  storel 0, "); WL(a)
      END;
      IF k + 1 < rank THEN
        IntStr(VAL(INTEGER, (k + 1) * 40), off);
        NewTemp(a); Op3L("add", a, addr, off);
        NewTemp(nb); Op3L("add", nb, v, "32");
        Revive; W("  storel "); W(a); W(", "); WL(nb)
      ELSE
        NewTemp(a); Op3L("add", a, v, "32");
        Revive; W("  storel 0, "); WL(a)
      END;
      cur := SymTab.ArrayElem(cur);
      INC(k)
    END;
    IntStr(VAL(INTEGER, rank * 40), off);
    NewTemp(pay); Op3L("add", pay, addr, off);
    IntStr(VAL(INTEGER, payload), nb);
    NewTemp(a); W("  "); W(a); W(" =l call $memset(l ");
    W(pay); W(", w 0, l "); W(nb); WL(")")
  END InitMultiHeap;

PROCEDURE InitMultiField (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
  BEGIN
    ClearMultiField(addr, t)
  END InitMultiField;

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) AND SymTab.IsMultiArray(t) THEN
      InitMultiHeap(addr, t)
    ELSIF 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
          IntStr(SymTab.FieldOffset(t, fn), nb);
          NewTemp(fa);
          Op3L("add", fa, addr, nb);
          IF SymTab.IsMultiArray(ft) THEN
            InitMultiField(fa, ft)
          ELSE
            InitHeap(fa, ft)
          END
        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;

PROCEDURE InFunction (): BOOLEAN;
(* TRUE while a function body is open (module-level test). *)
  BEGIN
    RETURN inFunc
  END InFunction;

PROCEDURE RecArrayNeedsInit (n: CARDINAL; t: INTEGER): BOOLEAN;
(* TRUE for an array of records/classes that (recursively) has array
   fields and is too large to expand inline: its inline length words
   must be initialised at run time (InitRecArray). *)
  VAR elem: INTEGER;
  BEGIN
    IF SymTab.ClassOf(t) # SymTab.ClArray THEN RETURN FALSE END;
    elem := SymTab.ArrayElem(t);
    IF (SymTab.ClassOf(elem) # SymTab.ClRecord)
       AND (SymTab.ClassOf(elem) # SymTab.ClClass) THEN RETURN FALSE END;
    IF NOT HasArrayField(elem) THEN RETURN FALSE END;
    RETURN NOT RecArrayExpanded(n, elem)
  END RecArrayNeedsInit;

PROCEDURE DeclRecTemplate (varName: ARRAY OF CHAR; rec: INTEGER);
(* "data $<mod>_<varName>_tmpl = { <one record with counts set> }" plus
   any nested sub-descriptors; InitRecArray copies it over each element
   of the compact array-of-record blob. *)
  VAR g: QVal; first: BOOLEAN;
  BEGIN
    IF NOT opened THEN RETURN END;
    Cpy(g, curModName); App(g, "_"); App(g, varName); App(g, "_tmpl");
    RecStatics(g, rec);
    W("data $"); W(g); W(" = { ");
    first := TRUE;
    RecItems(rec, g, first);
    WL(" }")
  END DeclRecTemplate;

PROCEDURE InitRecArray (varName: ARRAY OF CHAR; arrT: INTEGER);
(* value-initialise $<mod>_<varName>'s element length words: copy the
   template record over each element (element i is at base + 8 +
   i*stride). *)
  VAR base, tmpl, slot, i, il, off, tb, p, c, one, two, nStr, stStr: QVal;
      elem: INTEGER; lTop, lBody, lDone: QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    elem := SymTab.ArrayElem(arrT);
    Cpy(base, "$"); App(base, curModName); App(base, "_"); App(base, varName);
    Cpy(tmpl, base); App(tmpl, "_tmpl");
    IntStr(VAL(INTEGER, SymTab.ArrayLen(arrT)), nStr);
    IntStr(VAL(INTEGER, SymTab.TypeSize(elem)), stStr);
    Slot4(slot);
    StoreW(slot, "0");
    NewLabel(lTop); NewLabel(lBody); NewLabel(lDone);
    EmitLabel(lTop);
    LoadW(slot, i);
    NewTemp(c); Op3("csltw", c, i, nStr, FALSE);
    Jnz(c, lBody, lDone);
    EmitLabel(lBody);
    LoadW(slot, i);
    WidenIndex(i, il);
    NewTemp(off); Op3L("mul", off, il, stStr);
    NewTemp(tb); Op3L("add", tb, base, "8");
    NewTemp(p); Op3L("add", p, tb, off);
    CopyRecord(p, tmpl, elem);
    LoadW(slot, i);
    NewTemp(one); CopyOp("1", one);
    NewTemp(two); Op3("add", two, i, one, FALSE);
    StoreW(slot, two);
    Jmp(lTop);
    EmitLabel(lDone)
  END InitRecArray;

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.