M2compiler-V3/compiler/src/QbeGen.def

DEFINITION MODULE QbeGen;
(* Fresh QBE backend for m2compiler-V3, Step 1: minimal integer pipeline.

   Emits QBE SSA text to "gen_ssa/<Module>.ssa" (run the M2 driver from
   compiler/). Step-1 subset: INTEGER globals/CONSTs, integer
   expressions (+ - * DIV MOD, leading sign, parens), assignment.
   Every expression synthesizes a QBE operand in q (immediate like
   "42"/"-5" or fresh "%tN"); invalid types synthesize "0" so the
   .ssa stays assembleable.

   Test convention: a global VAR ExitCode : INTEGER makes generated
   $main return its value as the process exit code, else return 0. *)

TYPE
  QVal = ARRAY [0 .. 63] OF CHAR;

PROCEDURE OpenModule (name: ARRAY OF CHAR);
(* Opens gen_ssa/<name>.ssa, resets counters. *)

PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
(* Emits "data $name = { w 0 }". t is a SymTab.TypeIndex (reserved
   for later steps; step 1 only sees INTEGER). *)

PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
(* Emits "data $name = { w val }" for literal val, else a 0
   placeholder (caller reports 230). *)

PROCEDURE BeginBody;
(* Emits "export function w $main() {@start" (once). *)

PROCEDURE EndModule;
(* Return sequence (via ExitCode when present), close file. *)

PROCEDURE CloseModule;
(* Closes the .ssa without emitting a function (units whose
   lowering waits for step 4: definitions, implementations,
   and any unit containing nested modules). *)

PROCEDURE SetNoEmit (b: BOOLEAN);
(* Suppresses all output while TRUE (nested procedures in 4.1:
   SymTab tracks, QbeGen stays silent). *)

PROCEDURE Mangled (pname: ARRAY OF CHAR; uid: CARDINAL; VAR q: QVal);
(* q := "name_uid" (function symbols; same-named methods never
   collide; deterministic). *)

PROCEDURE BeginFunc (mangled: ARRAY OF CHAR);
(* Opens function context (locals cleared, header buffering). *)

PROCEDURE SetFuncRes (t: INTEGER);
(* Sets the buffered header's result class. *)

PROCEDURE FuncParam (name: ARRAY OF CHAR; isVar: BOOLEAN;
                     t: INTEGER): BOOLEAN;
(* Records one formal (FALSE past 64 → 233). Header class 'l'
   for all composites; entry copies restore value semantics. *)

PROCEDURE EndFuncHeader;
(* Emits the header + body label + entry copies (params to slots). *)

PROCEDURE AbortFunc;
(* Discards function context without emitting (DefUnit headings,
   FORWARD, methods, nested-in-4.1). *)

PROCEDURE EndFunc (resT: INTEGER);
(* Default return by result class, close, leave function context. *)

PROCEDURE EmitRet (q: ARRAY OF CHAR; hasVal: BOOLEAN);
(* Emits "ret q" (or dummy "ret 0"); always a terminator. *)

PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
                       fdep: CARDINAL);
(* Starts accumulating a call's actuals; resolves the static link
   from the caller's context and the callee's lexical depth. *)

PROCEDURE CallArg (q: ARRAY OF CHAR; cls: CHAR): BOOLEAN;
(* Appends one typed actual (FALSE when full → 233). *)

PROCEDURE CallEnd (wantRes: BOOLEAN; VAR q: QVal);
(* Emits the call (result temp in q when wanted). *)

PROCEDURE InitStack (addr: ARRAY OF CHAR; t: INTEGER);
(* Like InitHeap but nested objects go to stack slots. *)

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

PROCEDURE LocFull (): BOOLEAN;
(* TRUE past 64 locals in the current scope (→ 233). *)

PROCEDURE NewTemp (VAR t: QVal);
(* Fresh "%tN" operand (deterministic counter: fixpoint-safe). *)

PROCEDURE NewLabel (VAR l: QVal);
(* Fresh "@LN" label (deterministic counter). *)

PROCEDURE EmitLabel (l: ARRAY OF CHAR);
PROCEDURE Jmp (l: ARRAY OF CHAR);
PROCEDURE Jnz (c, t, f: ARRAY OF CHAR);
(* "jnz c, @t, @f". *)

PROCEDURE Cmp (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal;
              isReal: BOOLEAN);
(* Integer comparison selected by a SymTab.OpEq..OpGe code
   (ceqw/cnew/csltw/cslew/csgtw/csgew); q := fresh w holding 0/1.
   isReal reserved; step 2 passes FALSE. *)

PROCEDURE CmpL (op: INTEGER; l, r: ARRAY OF CHAR; VAR q: QVal);
(* Address comparison (ceql/cnel, =/# only); q := fresh w. *)

PROCEDURE NewHeap (t: INTEGER; VAR q: QVal);
(* q := malloc(HeapSize(t)) via extern call (object skeleton). *)

PROCEDURE FreeHeap (v: ARRAY OF CHAR);
(* call $free(l v). Shallow (nested objects leak — documented). *)

PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: INTEGER);
(* Stores static counts and allocates nested objects recursively;
   elements/members otherwise garbage per Wirth. *)

PROCEDURE NotQ (a: ARRAY OF CHAR; VAR q: QVal);
(* q := fresh w holding "NOT a" (xor 1, a). *)

PROCEDURE PushLoop (exit: ARRAY OF CHAR);
PROCEDURE PopLoop;
PROCEDURE TopLoop (VAR exit: QVal): BOOLEAN;
(* Innermost LOOP exit label; FALSE when outside any LOOP. *)

PROCEDURE LoadVar (name: ARRAY OF CHAR; isReal: BOOLEAN; VAR q: QVal);
(* q := fresh temp holding $name (isReal reserved; step 1: FALSE). *)

PROCEDURE LoadPtr (name: ARRAY OF CHAR; VAR q: QVal);
(* q := fresh l temp holding the pointer $name. *)

PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
(* "storew q, $name" (isReal reserved; step 1: FALSE). *)

PROCEDURE StorePtr (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
(* "storel q, $name". *)

PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
               isReal: BOOLEAN);
(* "res =w mn l, r" with mn = add/sub/mul/div/rem. *)

PROCEDURE NegQ (a: ARRAY OF CHAR; VAR q: QVal; isReal: BOOLEAN);
(* q := fresh temp holding "-a". a and q must differ. *)

PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
(* q := fresh double holding "swtof a" (INTEGER -> REAL widening). *)

PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);

PROCEDURE NoteAddr (val: ARRAY OF CHAR; addr: ARRAY OF CHAR);
(* Records a value-temp → address mapping for VAR actuals. *)

PROCEDURE AddrOfVal (val: ARRAY OF CHAR; VAR addr: QVal): BOOLEAN;
(* Retrieves the recorded address (FALSE → actual is not an
   addressable designator → 233). *)
PROCEDURE AddrOf (name: ARRAY OF CHAR; VAR q: QVal);
(* q := "$name" descriptor-address operand. *)
PROCEDURE IntStr (v: INTEGER; VAR s: QVal);
PROCEDURE NormInt (s: ARRAY OF CHAR; VAR d: QVal);
(* "0xFF" -> "255"; plain decimals copied through. *)

PROCEDURE NormLit (s: ARRAY OF CHAR; VAR d: QVal; VAR isCh: BOOLEAN);
(* Full V3 integer literal normalization:
      "12"                -> "12"            (decimal)
      "60B"/"60b"         -> "48"            (octal, suffix stripped)
      "0FFH"/"0ffh"       -> "255"           (hex)
      "0x1F"/"0X20"       -> "31"/"32"       (hex)
      "0C"/"03C"/"012C"   -> "0"/"3"/"12"    (hex, isCh := TRUE)
   isCh is TRUE for the character-constant C/c suffix only. *)

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

PROCEDURE CharVal (s: ARRAY OF CHAR): INTEGER;
(* ORD of a 1-character literal such as 'a'. *)

PROCEDURE NegFold (a: ARRAY OF CHAR; VAR q: QVal);
(* Folds unary minus into a literal ("5" -> "-5"). Safe for same var. *)

PROCEDURE IsImm (s: ARRAY OF CHAR): BOOLEAN;
(* TRUE for literal operands (not %temporaries). *)

PROCEDURE Remark (s: ARRAY OF CHAR);
(* Emits a "# s" comment line. *)

(* ---------------- arrays (step 3.1: length-prefixed layout) ---------------- *)
(* Every array value: LONGCARD count + packed elements. Indexes and
   counts are LONGCARD (l) inside emitted code; immediates pass
   through, w-temps widen via extsw. *)

PROCEDURE DeclArr (name: ARRAY OF CHAR; t: INTEGER);
(* Recursive data emission for fixed arrays (`data $name = { l n,
   ... }`, nested levels as `$name_i`). CHAR→b, int-family/bool/
   enum→w, REAL→d, nested/pointer→l, all zero. *)

PROCEDURE DeclStr (text: ARRAY OF CHAR; VAR q: QVal);
(* Emits `data $strN = { l len, b ... }` for a quoted literal and
   returns its address operand. Deterministic counter. *)

PROCEDURE WidenIndex (idx: ARRAY OF CHAR; VAR q: QVal);
(* Immediates copy through; w-temps widen via extsw to l. *)

PROCEDURE OpenHi (base: ARRAY OF CHAR; VAR q: QVal);
(* q := loadl(base) - 1 in l (open-array upper bound). *)

PROCEDURE CheckRange (idx, lo, hi: ARRAY OF CHAR);
(* Trap unless lo <= idx <= hi (l-domain operands). *)

PROCEDURE ElemAddr (base, idx, lo: ARRAY OF CHAR; elemT: INTEGER;
                    VAR q: QVal);
(* q := base + 8 + (idx - lo) * elemSizeOf(elemT's array) in l.
   elemT is the array descriptor (open or fixed). *)

PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
(* Element access by element-type index (CHAR→loadub … nested→loadl). *)

PROCEDURE Op3L (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR);
(* "=l mn l, r" (address/count arithmetic). *)

PROCEDURE CopyArray (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                      t: INTEGER);
(* Whole-array copy with runtime count check + blit, recursive for
   nested levels via a runtime loop. Counts mismatch traps. *)

PROCEDURE Trap;
(* call $abort(); hlt. Interim trap until runtime/syslib/Trap;
   sets the dead flag (terminator). *)

(* ---------------- sets (step 3.3: multi-word masks, no header) ---------------- *)
(* Set values are memory addresses (globals or alloc8 temps holding
   W words). All counts static; bit positions runtime-checked. *)

PROCEDURE DeclSet (name: ARRAY OF CHAR; t: INTEGER);
(* `data $name = { w 0, ... }` with SetWords(t) words (fallback
   single word when unsuitable — grammar already 230'd it). *)

PROCEDURE NewSetTemp (words: CARDINAL; VAR q: QVal);
(* Fresh alloc8 stack slot for a set value; q is its address. *)

PROCEDURE SetZero (addr: ARRAY OF CHAR; words: CARDINAL);
(* Zeroes W words at addr. *)

PROCEDURE SetBit (addr: ARRAY OF CHAR; val: ARRAY OF CHAR;
                   lo: INTEGER; span: CARDINAL);
(* ORs one element in: bit = val - lo, trapped outside [0, span). *)

PROCEDURE SetRange (addr: ARRAY OF CHAR; a: ARRAY OF CHAR;
                     b: ARRAY OF CHAR; lo: INTEGER; span: CARDINAL);
(* ORs every value in [a..b] (empty when inverted): ends trapped
   in span, then a w-domain counter loop over SetBit. *)

PROCEDURE SetBinOp (sel: INTEGER; l: ARRAY OF CHAR; r: ARRAY OF CHAR;
                    lw, rw: CARDINAL; VAR q: QVal);
(* sel 0 union / 1 intersection / 2 difference / 3 symdiff over
   possibly different spans (overlap via op, extras copied or
   zeroed); result has max words, q is its address. *)

PROCEDURE CmpSet (op: INTEGER; l: ARRAY OF CHAR; r: ARRAY OF CHAR;
                  lw, rw: CARDINAL; VAR q: QVal);
(* =/# over min words plus zero-checks on the larger side's extras;
   q is fresh w 0/1. op is a SymTab.OpEq/Neq code. *)

PROCEDURE CopySet (dst: ARRAY OF CHAR; src: ARRAY OF CHAR;
                    dw, sw: CARDINAL);
(* Copies min words via memcpy, zero-fills dst extras. *)

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. *)

(* ---------------- records (step 3.4: flat blobs, pointer fields) ---------------- *)
(* Records are flat: scalars/sets inline, array fields as 8-byte
   pointers to static descriptors, nested records inline. Field
   offsets are static (SymTab.FieldOffset). *)

PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
(* `data $name = { ... }` flat emission with per-field statics. *)

PROCEDURE FieldAddr (base: ARRAY OF CHAR; off: INTEGER; VAR q: QVal);
(* q := base + off in l, fresh temp. *)

PROCEDURE PushWith (base: ARRAY OF CHAR);
PROCEDURE PopWith;
PROCEDURE TopWith (VAR base: QVal): BOOLEAN;
(* Innermost WITH base address; FALSE outside any WITH. *)

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. *)

END QbeGen.