(** Tast -> x86-64, by hand. The dev backend; LLVM stays the release one.

    Grown out of [spike/backend/x86.ml], which proved the shape. What is new
    here is everything the spike enumerated and did not do: aggregates, floats,
    globals, string literals, the transfer channel, and a whole program rather
    than one function.

    {1 The internal calling convention}

    The spike's report (DISCUSS.md item 15) called the internal convention the
    sharpest obstacle, because LLVM's answer for a first-class struct is an
    implementation detail discoverable only by disassembly — a 24-byte struct
    comes back in [rax]:[rdx]:[rcx], and [rcx] is a register SysV never uses
    for a return value.

    That obstacle does not exist here, and the reason is worth stating because
    it is the whole licence for this module: {b a dev build is compiled
    entirely by this backend and a release build entirely by LLVM, and the two
    never meet in one process.} A dev build's [.ll] is not emitted at all when
    this backend runs. So the convention is ours to pick, and we pick the
    simplest one that exists:

    - {b Scalars} — integers, [bool], pointers, enums, handles, allocators,
      function pointers — go in SysV's integer registers [rdi rsi rdx rcx r8
      r9], then right-to-left on the stack. [bool] is one byte, zero-extended.
    - {b Floats} go in [xmm0]-[xmm7], then on the stack.
    - {b Every aggregate goes by pointer.} An argument is a pointer to a copy
      the caller made; a return is a hidden [sret] pointer in the {e first}
      integer register, with everything else shifted along, and the same
      pointer comes back in [rax]. Nothing is classified, nothing is split
      across register classes, and there is no eightbyte rule.
    - {b The transfer channel} is the last argument of all, a pointer, in the
      integer sequence — [emit.ml]'s [signature] rule, unchanged.

    {b Where this must match SysV exactly, it does}, and that is the C
    boundary: [flan_rt.c], [flan_dev.c], the generated FFI shim. [check.ml]
    rejects an aggregate in a [declare] signature and the shim flattens every
    struct, so a string or slice crosses as [ptr]+[len] and no Flan-emitted
    call ever hands C an aggregate. There is therefore no aggregate classifier
    in this file, and per item 15 there does not need to be one.

    {1 The frame, and why the spike's worst bug cannot happen here}

    The spike found its one real bug in a call written inside a binary
    operator: the evaluator spilled the left operand with [push], so [rsp] was
    8 out at the call and a C callee doing an aligned spill returned garbage.
    It fixed that with a depth counter.

    This module does not have a depth counter, because it does not push.
    {b Every intermediate value is a frame temporary}, bump-allocated below
    [rbp] with a high-water mark, and the outgoing-argument area is reserved
    once in the prologue. [rsp] is written exactly twice — in the prologue and
    by [leave] — so [rsp % 16 == 0] at every call site is a property of one
    rounded [sub] rather than an invariant every case has to maintain. The bug
    class is removed rather than guarded against.

    That costs instructions and no correctness. A debug build does not
    optimise; this is the trade the brief asks for.

    {1 Layout}

    [Emit.lay] / [lay_fields] / [payload_lay], reused rather than rewritten.
    They are acceptance-tested against LLVM's own [getelementptr], so there is
    one layout calculator in this compiler and this backend is a caller of it.

    {1 The container}

    Output is an assembly file: [.byte] blobs for the instructions, with the
    few fields that need a relocation written as assembler expressions
    ([call sym], [.long lbl - . - 4]). Byte offsets stay exactly known, which
    is what the introspection this backend exists for will need; what we give
    up is writing ELF ourselves, which is several hundred lines that produce
    no Flan progress and in which a bug looks exactly like an encoding bug.
    Reversible: the encoder below hands out bytes, and who packages them is a
    separate question. *)

exception Unsupported of string

let unsupported fmt = Printf.ksprintf (fun s -> raise (Unsupported s)) fmt

(* ── The byte buffer ─────────────────────────────────────────────────── *)

(* Raw bytes accumulate in [pend] and are flushed as one [.byte] directive;
   anything the assembler has to resolve goes out as a directive with a known
   size, so [n] is the exact offset of the next byte either way. *)
type buf = { out : Buffer.t; mutable pend : int list; mutable n : int }

let create () = { out = Buffer.create 4096; pend = []; n = 0 }

let flush b =
  if b.pend <> [] then begin
    Buffer.add_string b.out "\t.byte ";
    Buffer.add_string b.out
      (String.concat "," (List.rev_map (Printf.sprintf "0x%02x") b.pend));
    Buffer.add_char b.out '\n';
    b.pend <- []
  end

let u8 b x =
  b.pend <- (x land 0xff) :: b.pend;
  b.n <- b.n + 1

let u32 b n = for i = 0 to 3 do u8 b ((n asr (i * 8)) land 0xff) done

let i32 b (n : int) =
  if n < -0x80000000 || n > 0x7fffffff then unsupported "displacement %d" n;
  u32 b n

let u64 b (n : int64) =
  for i = 0 to 7 do
    u8 b
      (Int64.to_int (Int64.logand (Int64.shift_right_logical n (i * 8)) 0xffL))
  done

let dir b s size =
  flush b;
  Buffer.add_string b.out ("\t" ^ s ^ "\n");
  b.n <- b.n + size

let text b s = flush b; Buffer.add_string b.out s
let lbl b l = flush b; Buffer.add_string b.out (l ^ ":\n")

(* ── Registers ───────────────────────────────────────────────────────── *)

(* The encoding numbering, not the ABI's: these three bits are what modrm
   wants, which is why rsp is 4 and rbp is 5. *)
let rax = 0 and rcx = 1 and rdx = 2
let rsp = 4 and rbp = 5 and rsi = 6 and rdi = 7
let r8 = 8 and r9 = 9 and r11 = 11

let xmm0 = 0

let int_args = [| rdi; rsi; rdx; rcx; r8; r9 |]
let n_int_args = 6
let n_sse_args = 8

(* REX. [force] is for the 8-bit forms, where without a REX byte registers 4-7
   name ah/ch/dh/bh rather than spl/bpl/sil/dil — a store of a bool from rsi
   would otherwise write the wrong half of rdx. *)
let rex ?(force = false) b ~w ~r ~x ~m =
  let v =
    (if w then 8 else 0)
    lor (if r >= 8 then 4 else 0)
    lor (if x >= 8 then 2 else 0)
    lor (if m >= 8 then 1 else 0)
  in
  if v <> 0 || force then u8 b (0x40 lor v)

let modrm_r b ~r ~m = u8 b (0xc0 lor ((r land 7) lsl 3) lor (m land 7))

(* [base + disp32], always disp32: a frame outgrows 128 bytes and a disp8 that
   silently wraps is precisely the bug this would not find. r12 and rsp need a
   SIB byte because 4 in the r/m field means "SIB follows". *)
let modrm_m b ~r ~base ~disp =
  u8 b (0x80 lor ((r land 7) lsl 3) lor (base land 7));
  if base land 7 = 4 then u8 b 0x24;
  i32 b disp

(* [rip + disp32], where the displacement is a relocation the assembler fills
   in. modrm mod=00 r/m=101 is the rip-relative form. *)
let modrm_rip b ~r ~sym ~addend =
  u8 b (((r land 7) lsl 3) lor 5);
  dir b
    (Printf.sprintf ".long %s%s - . - 4" sym
       (if addend = 0 then "" else Printf.sprintf "+%d" addend))
    4

(* ── Instructions ────────────────────────────────────────────────────── *)

type mem = Frame of int | Reg of int * int | Sym of string * int

let mem_op b ~r ~op ~(w : bool) ~(pfx : int list) ~(mm : mem) =
  let base = match mm with Frame _ -> rbp | Reg (g, _) -> g | Sym _ -> 0 in
  List.iter (u8 b) pfx;
  (match mm with
   | Sym _ -> rex b ~w ~r ~x:0 ~m:0
   | _ -> rex b ~w ~r ~x:0 ~m:base);
  List.iter (u8 b) op;
  match mm with
  | Frame d -> modrm_m b ~r ~base:rbp ~disp:d
  | Reg (g, d) -> modrm_m b ~r ~base:g ~disp:d
  | Sym (s, a) -> modrm_rip b ~r ~sym:s ~addend:a

let mov_rr b ~dst ~src = rex b ~w:true ~r:src ~x:0 ~m:dst; u8 b 0x89; modrm_r b ~r:src ~m:dst

let movabs b ~dst (n : int64) =
  rex b ~w:true ~r:0 ~x:0 ~m:dst;
  u8 b (0xb8 lor (dst land 7));
  u64 b n

let lea b ~dst ~(mm : mem) = mem_op b ~r:dst ~op:[ 0x8d ] ~w:true ~pfx:[] ~mm

(* An integer load of [size] bytes, widened to the full 64-bit register the
   way the operand's own signedness says. Everything downstream then works in
   64 bits and narrows only at a store, which is what makes one set of
   arithmetic encodings cover eight integer types. *)
let load_int b ~dst ~mm ~size ~signed =
  match size, signed with
  | 8, _ -> mem_op b ~r:dst ~op:[ 0x8b ] ~w:true ~pfx:[] ~mm
  | 4, false -> mem_op b ~r:dst ~op:[ 0x8b ] ~w:false ~pfx:[] ~mm
  | 4, true -> mem_op b ~r:dst ~op:[ 0x63 ] ~w:true ~pfx:[] ~mm
  | 2, false -> mem_op b ~r:dst ~op:[ 0x0f; 0xb7 ] ~w:true ~pfx:[] ~mm
  | 2, true -> mem_op b ~r:dst ~op:[ 0x0f; 0xbf ] ~w:true ~pfx:[] ~mm
  | 1, false -> mem_op b ~r:dst ~op:[ 0x0f; 0xb6 ] ~w:true ~pfx:[] ~mm
  | 1, true -> mem_op b ~r:dst ~op:[ 0x0f; 0xbe ] ~w:true ~pfx:[] ~mm
  | n, _ -> unsupported "integer load of %d bytes" n

let store_int b ~src ~mm ~size =
  match size with
  | 8 -> mem_op b ~r:src ~op:[ 0x89 ] ~w:true ~pfx:[] ~mm
  | 4 -> mem_op b ~r:src ~op:[ 0x89 ] ~w:false ~pfx:[] ~mm
  | 2 -> mem_op b ~r:src ~op:[ 0x89 ] ~w:false ~pfx:[ 0x66 ] ~mm
  | 1 ->
    (* The one place a REX byte is needed for its own sake. *)
    let base = match mm with Frame _ -> rbp | Reg (g, _) -> g | Sym _ -> 0 in
    rex ~force:(src >= 4) b ~w:false ~r:src ~x:0 ~m:base;
    u8 b 0x88;
    (match mm with
     | Frame d -> modrm_m b ~r:src ~base:rbp ~disp:d
     | Reg (g, d) -> modrm_m b ~r:src ~base:g ~disp:d
     | Sym (s, a) -> modrm_rip b ~r:src ~sym:s ~addend:a)
  | n -> unsupported "integer store of %d bytes" n

let alu_rr b ~op ~dst ~src =
  rex b ~w:true ~r:src ~x:0 ~m:dst; u8 b op; modrm_r b ~r:src ~m:dst

let add_rr b ~dst ~src = alu_rr b ~op:0x01 ~dst ~src
let sub_rr b ~dst ~src = alu_rr b ~op:0x29 ~dst ~src
let and_rr b ~dst ~src = alu_rr b ~op:0x21 ~dst ~src
let or_rr b ~dst ~src = alu_rr b ~op:0x09 ~dst ~src
let xor_rr b ~dst ~src = alu_rr b ~op:0x31 ~dst ~src
let cmp_rr b ~a ~c = alu_rr b ~op:0x39 ~dst:a ~src:c

let imul_rr b ~dst ~src =
  rex b ~w:true ~r:dst ~x:0 ~m:src; u8 b 0x0f; u8 b 0xaf; modrm_r b ~r:dst ~m:src

let grp1_imm b ~ext ~dst n =
  rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0x81; modrm_r b ~r:ext ~m:dst; i32 b n

let add_imm b ~dst n = grp1_imm b ~ext:0 ~dst n
let sub_imm b ~dst n = grp1_imm b ~ext:5 ~dst n
let cmp_imm b ~dst n = grp1_imm b ~ext:7 ~dst n

let neg_r b ~dst = rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0xf7; modrm_r b ~r:3 ~m:dst
let not_r b ~dst = rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0xf7; modrm_r b ~r:2 ~m:dst
let test_rr b ~a ~c = rex b ~w:true ~r:c ~x:0 ~m:a; u8 b 0x85; modrm_r b ~r:c ~m:a

(* cqo then idiv, or xor rdx,rdx then div: the sign of the operands decides
   which pair, and getting that wrong is a wrong answer rather than a fault. *)
let cqo b = u8 b 0x48; u8 b 0x99
let idiv_r b ~src = rex b ~w:true ~r:0 ~x:0 ~m:src; u8 b 0xf7; modrm_r b ~r:7 ~m:src
let div_r b ~src = rex b ~w:true ~r:0 ~x:0 ~m:src; u8 b 0xf7; modrm_r b ~r:6 ~m:src

(* Shifts by cl. The count is masked to the operand width by the hardware,
   which is the rule the language already defines (item 15's audit). *)
let shift_cl b ~ext ~dst = rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0xd3; modrm_r b ~r:ext ~m:dst
let shl_cl b ~dst = shift_cl b ~ext:4 ~dst
let shr_cl b ~dst = shift_cl b ~ext:5 ~dst
let sar_cl b ~dst = shift_cl b ~ext:7 ~dst

let setcc b ~cc ~dst =
  rex ~force:(dst >= 4) b ~w:false ~r:0 ~x:0 ~m:dst;
  u8 b 0x0f; u8 b (0x90 lor cc); modrm_r b ~r:0 ~m:dst

let movzx8 b ~dst ~src =
  rex b ~w:true ~r:dst ~x:0 ~m:src; u8 b 0x0f; u8 b 0xb6; modrm_r b ~r:dst ~m:src

let jmp_lbl b l = u8 b 0xe9; dir b (Printf.sprintf ".long %s - . - 4" l) 4
let jcc_lbl b ~cc l = u8 b 0x0f; u8 b (0x80 lor cc); dir b (Printf.sprintf ".long %s - . - 4" l) 4

let call_sym b s = flush b; dir b (Printf.sprintf "call %s" s) 5
let call_r b r = if r >= 8 then u8 b 0x41; u8 b 0xff; modrm_r b ~r:2 ~m:r
let leave b = u8 b 0xc9
let ret b = u8 b 0xc3
let ud2 b = u8 b 0x0f; u8 b 0x0b
let push_r b r = if r >= 8 then u8 b 0x41; u8 b (0x50 lor (r land 7))

(* rep movsb: rdi, rsi, rcx. Nothing is ever live in a register across a
   statement here, so the crudest block copy in the instruction set is also
   the correct one, and a struct assignment *is* the copy spec-memory.md
   requires. *)
let rep_movsb b = u8 b 0xf3; u8 b 0xa4
let rep_stosb b = u8 b 0xf3; u8 b 0xaa

(* ── SSE ─────────────────────────────────────────────────────────────── *)

let sse_rm b ~pfx ~op ~r ~mm = mem_op b ~r ~op:[ 0x0f; op ] ~w:false ~pfx:[ pfx ] ~mm
let sse_rr b ~pfx ~op ~r ~m =
  u8 b pfx; rex b ~w:false ~r ~x:0 ~m; u8 b 0x0f; u8 b op; modrm_r b ~r ~m

let movsd_load b ~dst ~mm = sse_rm b ~pfx:0xf2 ~op:0x10 ~r:dst ~mm
let movsd_store b ~src ~mm = sse_rm b ~pfx:0xf2 ~op:0x11 ~r:src ~mm
let movss_load b ~dst ~mm = sse_rm b ~pfx:0xf3 ~op:0x10 ~r:dst ~mm
let movss_store b ~src ~mm = sse_rm b ~pfx:0xf3 ~op:0x11 ~r:src ~mm

let fload b ~dst ~mm ~f64 = if f64 then movsd_load b ~dst ~mm else movss_load b ~dst ~mm
let fstore b ~src ~mm ~f64 = if f64 then movsd_store b ~src ~mm else movss_store b ~src ~mm

let farith b ~op ~f64 ~dst ~src = sse_rr b ~pfx:(if f64 then 0xf2 else 0xf3) ~op ~r:dst ~m:src
let ucomis b ~f64 ~a ~c =
  if f64 then u8 b 0x66;
  rex b ~w:false ~r:a ~x:0 ~m:c; u8 b 0x0f; u8 b 0x2e; modrm_r b ~r:a ~m:c

(* Conversions. REX.W selects the 64-bit integer side in each direction. *)
let cvtsi2f b ~f64 ~dst ~src =
  u8 b (if f64 then 0xf2 else 0xf3);
  rex b ~w:true ~r:dst ~x:0 ~m:src; u8 b 0x0f; u8 b 0x2a; modrm_r b ~r:dst ~m:src

let cvttf2si b ~f64 ~dst ~src =
  u8 b (if f64 then 0xf2 else 0xf3);
  rex b ~w:true ~r:dst ~x:0 ~m:src; u8 b 0x0f; u8 b 0x2c; modrm_r b ~r:dst ~m:src

let cvtsd2ss b ~dst ~src = sse_rr b ~pfx:0xf2 ~op:0x5a ~r:dst ~m:src
let cvtss2sd b ~dst ~src = sse_rr b ~pfx:0xf3 ~op:0x5a ~r:dst ~m:src
let xorps b ~dst = rex b ~w:false ~r:dst ~x:0 ~m:dst; u8 b 0x0f; u8 b 0x57; modrm_r b ~r:dst ~m:dst

(* ── Types ───────────────────────────────────────────────────────────── *)

(* [Emit.m] carries the struct and union tables [Emit.lay] reads. Built here
   rather than imported so that this module adds no line to [emit.ml]: the
   record has no signature hiding it and every field it needs is inert. *)
let layout_ctx (p : Tast.program) : Emit.m =
  let structs = Hashtbl.create 16 and unions = Hashtbl.create 16 in
  List.iter (fun (s : Tast.structure) -> Hashtbl.replace structs s.Tast.sname s)
    p.Tast.structs;
  List.iter (fun (u : Tast.union) -> Hashtbl.replace unions u.Tast.uname u)
    p.Tast.unions;
  { Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; unions;
    globals = Hashtbl.create 1; externs = Hashtbl.create 1; checks = false;
    dev = false; known = (fun _ -> true); dbg = None; sanitize = false;
    nstr = 0; nfi = 0 }

let sizeof md t = fst (Emit.lay md t)
let alignof md t = snd (Emit.lay md t)

(* The one classification this backend makes, and it has two answers rather
   than SysV's eight. *)
let is_agg (t : Types.t) =
  match t with
  | Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _ | Types.Enum _
  | Types.Alloc | Types.Handle _ | Types.Fn _ -> false
  | Types.Unit | Types.Never -> false
  | Types.String | Types.Slice _ | Types.Array _ | Types.Map _ | Types.Vec _
  | Types.Pool _ | Types.Option _ | Types.Named _ -> true
  | Types.Var v -> unsupported "type variable %s" v

let is_void (t : Types.t) = match t with Types.Unit | Types.Never -> true | _ -> false
let is_float (t : Types.t) = match t with Types.Float _ -> true | _ -> false
let f64_of (t : Types.t) = match t with Types.Float Types.F32 -> false | _ -> true

(* Signedness for a load and for a comparison. A pointer, a handle and an enum
   are each unsigned machine words; [bool] is a zero-extended byte. *)
let signed_of (t : Types.t) =
  match t with
  | Types.Int k -> Types.signed k
  | Types.Enum _ -> true
  | _ -> false

(* ── Mangling ────────────────────────────────────────────────────────── *)

(* The same names [emit.ml] gives, so a build made here links against the same
   runtime and a disassembly reads with the same symbols. A Flan name can hold
   characters an assembler will not take bare, so every symbol is quoted. *)
let asm_sym s = "\"" ^ s ^ "\""
let fsym n = asm_sym ("flan." ^ n)
let gsym n = asm_sym ("flan." ^ n)

(* ── Function context ────────────────────────────────────────────────── *)

type fnctx = {
  b : buf;
  md : Emit.m;
  fnname : string;
  fret : Types.t;
  slots : int array;              (* rbp-relative offset of each Tast slot *)
  xfer_off : int;                 (* the incoming transfer channel pointer *)
  sret_off : int;                 (* where the hidden return pointer was put *)
  retval : int;                   (* the scalar return value's temporary *)
  mutable frame : int;            (* bytes currently allocated below rbp *)
  mutable maxframe : int;
  mutable outgoing : int;         (* bytes the widest call needs for stack args *)
  mutable nlbl : int;
  (* One entry per [While] we are inside, innermost first: the label a [break]
     jumps to and the label a [continue] jumps to, which is the latch and not
     the head. *)
  mutable loops : (string * string) list;
  (* The innermost landing pad a transfer found after a call should jump to.
     Empty means the function's own transfer exit. *)
  mutable pads : string list;
  (* Collected while lowering: string literals and float constants both need a
     labelled constant in .rodata, and both are discovered mid-expression. *)
  rodata : Buffer.t;
  mutable nconst : int;
  externs : (string, string) Hashtbl.t;
  fns : (string, unit) Hashtbl.t;
}

let new_label f tag = f.nlbl <- f.nlbl + 1; Printf.sprintf ".L%s%d" tag f.nlbl

(* Bump-allocate a frame temporary and answer its rbp-relative offset. The
   offset is negative, so the running total is rounded *up* to the alignment;
   rbp is 16-aligned, so that is the alignment the value actually gets. *)
let alloc f size align =
  let a = if align <= 1 then 1 else align in
  f.frame <- f.frame + (if size <= 0 then 1 else size);
  f.frame <- (f.frame + a - 1) / a * a;
  if f.frame > f.maxframe then f.maxframe <- f.frame;
  -f.frame

let tmp f (t : Types.t) = alloc f (max 1 (sizeof f.md t)) (alignof f.md t)
let ptmp f = alloc f 8 8

(* Temporaries are reclaimed at the end of the expression that made them; the
   destination is allocated by the caller and therefore outlives the reset. *)
let scoped f g =
  let save = f.frame in
  let r = g () in
  f.frame <- save;
  r

(* ── Moving values ───────────────────────────────────────────────────── *)

(* Scalar in [reg] <- [rbp+off], and back. A bool is a byte; everything else
   is its own width, widened on load. *)
let load_scalar f ~reg ~off (t : Types.t) =
  if is_float t then fload f.b ~dst:reg ~mm:(Frame off) ~f64:(f64_of t)
  else
    let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
    load_int f.b ~dst:reg ~mm:(Frame off) ~size ~signed:(signed_of t)

let store_scalar f ~reg ~off (t : Types.t) =
  if is_float t then fstore f.b ~src:reg ~mm:(Frame off) ~f64:(f64_of t)
  else
    let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
    store_int f.b ~src:reg ~mm:(Frame off) ~size

(* Through a pointer rather than a frame offset: the same two, with the
   address already in a register. *)
let load_scalar_at f ~reg ~base ~disp (t : Types.t) =
  if is_float t then fload f.b ~dst:reg ~mm:(Reg (base, disp)) ~f64:(f64_of t)
  else
    let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
    load_int f.b ~dst:reg ~mm:(Reg (base, disp)) ~size ~signed:(signed_of t)

let store_scalar_at f ~reg ~base ~disp (t : Types.t) =
  if is_float t then fstore f.b ~src:reg ~mm:(Reg (base, disp)) ~f64:(f64_of t)
  else
    let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
    store_int f.b ~src:reg ~mm:(Reg (base, disp)) ~size

(* n bytes from the address in rsi to the address in rdi. *)
let blockcopy f n =
  if n > 0 then begin
    movabs f.b ~dst:rcx (Int64.of_int n);
    rep_movsb f.b
  end

let copy_frames f ~dst ~src n =
  if n > 0 then begin
    lea f.b ~dst:rdi ~mm:(Frame dst);
    lea f.b ~dst:rsi ~mm:(Frame src);
    blockcopy f n
  end

let zero_frame f ~dst n =
  if n > 0 then begin
    lea f.b ~dst:rdi ~mm:(Frame dst);
    xor_rr f.b ~dst:rax ~src:rax;
    movabs f.b ~dst:rcx (Int64.of_int n);
    rep_stosb f.b
  end

(* ── Constants in .rodata ────────────────────────────────────────────── *)

let rodata_label f =
  f.nconst <- f.nconst + 1;
  Printf.sprintf ".Lc%s%d" (String.concat "" (String.split_on_char '.' "k")) f.nconst

let escape_bytes s =
  String.concat ","
    (List.map (fun c -> Printf.sprintf "0x%02x" (Char.code c))
       (List.init (String.length s) (String.get s)))

let string_const f s =
  let l = rodata_label f in
  Buffer.add_string f.rodata (Printf.sprintf "\t.align 1\n%s:\n" l);
  if String.length s > 0 then
    Buffer.add_string f.rodata (Printf.sprintf "\t.byte %s\n" (escape_bytes s));
  (* A trailing NUL nobody reads through the length, so that a pointer handed
     to C by a shim is still a C string if anything ever treats it as one. *)
  Buffer.add_string f.rodata "\t.byte 0x00\n";
  l

let float_const f (x : float) ~f64 =
  let l = rodata_label f in
  if f64 then
    Buffer.add_string f.rodata
      (Printf.sprintf "\t.align 8\n%s:\n\t.quad 0x%Lx\n" l (Int64.bits_of_float x))
  else
    Buffer.add_string f.rodata
      (Printf.sprintf "\t.align 4\n%s:\n\t.long 0x%lx\n" l (Int32.bits_of_float x));
  l