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;
  withTop : CARDINAL;
  withSt  : ARRAY [0 .. 7] OF QVal;
  noEmit : BOOLEAN;  (* TRUE while parsing nested procedures in 4.1:
                        SymTab tracks, QbeGen suppresses output *)
  inFunc : BOOLEAN;  (* TRUE inside an emitted function body *)
  useStack : BOOLEAN;(* TRUE: NewHeap allocates stack slots *)
  funcRes : CHAR;    (* current function result class *)
  nLoc : CARDINAL;   (* function-local name table entries *)
  locNames : ARRAY [0 .. 255] OF SymTab.Name;
  locTag : ARRAY [0 .. 255] OF INTEGER;  (* 0 slot, 1 data, 2 addr *)
  locRep : ARRAY [0 .. 255] OF QVal;     (* slot temp / mangled / addr *)
  locCls : ARRAY [0 .. 255] OF CHAR;
  locTyp : ARRAY [0 .. 255] OF INTEGER;
  funcDepth : CARDINAL;  (* open BeginFuncs; main body = 0 *)
  scopeTop : CARDINAL;   (* open procedure scopes *)
  scopeBase : ARRAY [0 .. 16] OF CARDINAL;
  scopeLink : ARRAY [0 .. 15] OF QVal;  (* per-scope link records *)
  slTmp : QVal;          (* current static-link param temp *)
  hdrComma : BOOLEAN;
  stkLink : ARRAY [0 .. 15] OF QVal;    (* per-call static links *)
  stkExt : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call external flag *)
  stkInd : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call indirect flag *)
  outSel : CARDINAL;  (* 0 = file, else nestBufs[outSel-1] *)
  nInit : CARDINAL;
  initNames : ARRAY [0 .. 31] OF QVal;
  sessBuf : ARRAY [0 .. 4194303] OF CHAR;  (* whole image, buffered (4 MiB:
                                              must hold the compiler's own
                                              image text when self-hosting) *)
  sessUsed : CARDINAL;
  nestBufs : ARRAY [0 .. 15] OF ARRAY [0 .. 65535] OF CHAR;
  nestUsed : ARRAY [0 .. 15] OF CARDINAL;
  (* Short-circuit AND/OR: the RHS operand's code is buffered here
     (delayTop > 0) and replayed inside the branch. *)
  delayBuf : ARRAY [0 .. 15] OF ARRAY [0 .. 8191] OF CHAR;
  delayUsed : ARRAY [0 .. 15] OF CARDINAL;
  delayTop : CARDINAL;
  (* one buffer per nesting depth: each nested function stays
     contiguous no matter how deep the parse interleaves *)
  nPar : CARDINAL;   (* recorded formal params for the header *)
  parCls : ARRAY [0 .. 63] OF CHAR;
  parTmp : ARRAY [0 .. 63] OF QVal;
  parNam : ARRAY [0 .. 63] OF SymTab.Name;
  parVar : ARRAY [0 .. 63] OF BOOLEAN;
  parTyp : ARRAY [0 .. 63] OF INTEGER;
  argBuf : ARRAY [0 .. 4095] OF CHAR;   (* accumulated call args *)
  hbuf : ARRAY [0 .. 2047] OF CHAR;     (* buffered function header *)
  nArg : CARDINAL;
  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) *)
  nVal : ARRAY [0 .. 255] OF QVal;  (* VAR-actual note keys *)
  nAddr : ARRAY [0 .. 255] OF QVal; (* VAR-actual note addresses *)
  nn : CARDINAL;

(* ---------------- 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;
    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;
    funcDepth := 0; scopeTop := 0; scopeBase[0] := 0;
    nInit := 0;
    outSel := 0;
    sessUsed := 0; sessBuf[0] := CHR(0);
    delayTop := 0;
    ustrN := 0; ustrUsed := 0;
    i := 0;
    WHILE i <= HIGH(nestBufs) DO
      nestBufs[i][0] := CHR(0); nestUsed[i] := 0; INC(i)
    END;
    WL("# QBE IR generated by the V3 step-1 backend");
    WL("")
  END OpenModule;

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

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

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

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

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

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

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

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

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

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

PROCEDURE CloseModule;
  BEGIN
    IF NOT opened THEN RETURN END;
    WL("# no code: unit lowering waits for step 4");
    FileIO.Close(out);
    opened := FALSE
  END CloseModule;

PROCEDURE EndModule (name: ARRAY OF CHAR);
  VAR i : CARDINAL;
    fname : ARRAY [0 .. 127] OF CHAR;
    ref : QVal;
  BEGIN
    IF NOT opened THEN RETURN END;
    IF NOT inBody THEN BeginBody END;
    IF SymTab.Lookup("ExitCode")
 AND (SymTab.SymKind("ExitCode") = SymTab.KindVar)
 AND SymTab.IsIntFamily(SymTab.SymType("ExitCode")) THEN
      Cpy(ref, "$"); App(ref, name); App(ref, "_ExitCode");
      W("  %ec =w loadw "); WL(ref);
      WL("  ret %ec")
    ELSE
      WL("  ret 0")
    END;
    WL("}");
    (* hoisted nested functions, then deferred data *)
    i := 0;
    WHILE i <= HIGH(nestBufs) DO
      IF nestUsed[i] > 0 THEN
        BufApp(sessBuf, sessUsed, nestBufs[i], FALSE)
      END;
      INC(i)
    END;
    FlushStrings;
    FlushUStrings;
    (* the image is named after the program module *)
    fname[0] := CHR(0);
    App(fname, "gen_ssa/");
    App(fname, name);
    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 noEmit THEN RETURN END;
    IF (scopeTop = 0) OR (nLoc > HIGH(locNames)) THEN RETURN END;
    idx := nLoc - scopeBase[scopeTop - 1];
    IF idx > 63 THEN RETURN END;
    Cpy(locNames[nLoc], name);
    locTag[nLoc] := tag;
    Cpy(locRep[nLoc], rep);
    locCls[nLoc] := cls;
    locTyp[nLoc] := typ;
    INC(nLoc);
    IF tag = 1 THEN RETURN END;
    Cpy(lk, scopeLink[scopeTop - 1]);
    IntStr(VAL(INTEGER, 8 * (idx + 1)), off);
    NewTemp(lk);
    Op3L("add", lk, scopeLink[scopeTop - 1], off);
    Revive;
    W("  storel "); W(rep); W(", "); WL(lk)
  END LocAdd;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
                       fdep: CARDINAL; isExt: BOOLEAN);
(* Pushes a call level; the static link is resolved now (caller
   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)
  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;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

PROCEDURE 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 StrLen (s: ARRAY OF CHAR; VAR q: QVal);
(* q := the number of characters before the NUL (INTEGER). *)
  BEGIN
    NewTemp(q);
    W("  "); W(q); W(" =w call $m2strlen(l "); W(s); WL(")")
  END StrLen;

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 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 8,
   else 4. t is an array (or string) descriptor. *)
  VAR cls: INTEGER;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClStr THEN RETURN 1 END;
    cls := ElemCls(t);
    IF cls = SymTab.ClChar THEN RETURN 1
    ELSIF cls = SymTab.ClReal THEN RETURN 8
    ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
       OR (cls = SymTab.ClLong) THEN RETURN 8
    ELSE RETURN 4
    END
  END ElemSize;

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

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

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

(* ---------------- records: flat blobs, pointer fields ---------------- *)
(* Scalars/sets inline, array fields as 8-byte pointers to static
   descriptors, nested records inline. Static offsets throughout. *)

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). *)
   VAR n, i: CARDINAL;
     elem: SymTab.TypeIndex;
     ecls: INTEGER;
     esz: CARDINAL;
     bv: QVal;
   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
    ELSE
      IF ecls = SymTab.ClChar THEN
        (* CHAR: n data bytes + one NUL terminator slot *)
        W(", z ");
        IntStr(VAL(INTEGER, n + 1), bv);
        W(bv)
      ELSE
        IF (ecls = SymTab.ClReal) OR (ecls = SymTab.ClPtr)
           OR (ecls = SymTab.ClProc) THEN esz := 8
        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;
   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
    END
   END ArrData;

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

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

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

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

PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
  VAR first: BOOLEAN;
  BEGIN
    IF NOT opened THEN RETURN END;
    RecStatics(name, t);
    W("data $"); W(name);
    W(" = { ");
    first := TRUE;
    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 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);
(* Deep whole-record copy: scalars/sets by load/store, arrays via
   CopyArray on dereferenced fields, nested records recurse. *)
  VAR n, i: CARDINAL;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    cls: INTEGER;
    dd, ds, di, si, v: QVal;
    off: 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);
      IntStr(SymTab.FieldOffset(t, fn), off);
      NewTemp(dd); Op3L("add", dd, dst, off);
      NewTemp(ds); Op3L("add", ds, src, off);
      IF cls = SymTab.ClArray THEN
        (* inline array field: the field address is the descriptor *)
        CopyArray(dd, ds, ft)
      ELSIF cls = SymTab.ClSet THEN
        CopySet(dd, ds, SymTab.SetWords(ft), SymTab.SetWords(ft))
      ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
        CopyRecord(dd, ds, ft)
      ELSE
        ElemLoad(ds, ft, v);
        ElemStore(dd, v, ft)
      END;
      INC(i)
    END
  END CopyRecord;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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;

PROCEDURE Remark (s: ARRAY OF CHAR);
  BEGIN
    Revive;
    W("# "); WL(s)
  END Remark;

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

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

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

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

PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
  VAR cls, ecls: INTEGER;
    n, i: CARDINAL;
    fn: SymTab.Name;
    ft: SymTab.TypeIndex;
    nb, ea, eb, fa, fb: QVal;
  BEGIN
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.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;
      ecls := SymTab.ClassOf(SymTab.ArrayElem(t));
      IF ecls = SymTab.ClArray THEN
        n := SymTab.ArrayLen(t);
        i := 0;
        WHILE i < n DO
          IntStr(VAL(INTEGER, 8 + i * 8), nb);
          NewTemp(ea);
          Op3L("add", ea, addr, nb);
          NewHeap(SymTab.ArrayElem(t), eb);
          InitHeap(eb, SymTab.ArrayElem(t));  (* init the sub-array *)
          Revive;
          W("  storel "); W(eb); W(", "); WL(ea);
          INC(i)
        END
      END
    ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
      n := SymTab.FieldCount(t);
      i := 0;
      WHILE i < n DO
        SymTab.FieldName(t, i, fn);
        ft := SymTab.FieldType(t, fn);
        ecls := SymTab.ClassOf(ft);
        IF ecls = SymTab.ClArray THEN
          (* inline array field: initialize its header in place *)
          IntStr(SymTab.FieldOffset(t, fn), nb);
          NewTemp(fa);
          Op3L("add", fa, addr, nb);
          InitHeap(fa, ft)
        ELSIF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass) THEN
          IntStr(SymTab.FieldOffset(t, fn), nb);
          NewTemp(fa);
          Op3L("add", fa, addr, nb);
          InitHeap(fa, ft)
        END;
        INC(i)
      END
    END
  END InitHeap;

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