One function goes from Tast to machine code and answers correctly

x86.ml is an instruction selector for the part of Tast that fits in one
integer register: literals, slots, let, if, arithmetic, comparison, and a
call. Everything else raises with the node that defeated it, because an
honest refusal is the measurement and a silently wrong answer would waste
the exercise.

The frontend is the real one -- Reader, Parse, Load, Check -- so what is
lowered is the same Tast.fn the LLVM backend gets. Seven arithmetic results
are compared against what the language says they should be; the disassembly
proves nothing and is not the evidence.

Nothing is wired into the build. No dune file under spike/, driven by hand
with ocamlfind and clang as spike/embed already does.

spike/backend/driver.ml

@@ -0,0 +1,124 @@
+(* The spike's harness: run the real frontend, lower the functions it produced
+   with [X86], put the bytes in executable memory, call them, and compare with
+   what the language says they should answer.
+
+   The comparison is the whole point. Reading the bytes proves nothing -- a
+   disassembly that looks right and a program that returns the wrong number is
+   the normal outcome of hand-encoding, which is why the oracle here is the
+   arithmetic and not objdump. [oracle.sh] disassembles the same buffer, and
+   that is a debugging aid, not the evidence. *)
+
+external jit_alloc : int -> nativeint = "spike_jit_alloc"
+external jit_write : nativeint -> string -> unit = "spike_jit_write"
+external jit_protect : nativeint -> int -> unit = "spike_jit_protect"
+external call1 : nativeint -> int64 -> int64 = "spike_call1"
+external call2 : nativeint -> int64 -> int64 -> int64 = "spike_call2"
+external sym : string -> nativeint = "spike_sym"
+
+let failures = ref 0
+let checks = ref 0
+
+let check name got want =
+  incr checks;
+  if got = want then Printf.printf "  ok    %-28s = %Ld\n" name got
+  else begin
+    incr failures;
+    Printf.printf "  FAIL  %-28s = %Ld, want %Ld\n" name got want
+  end
+
+(* One page per function, so that a function that runs off its own end lands in
+   an unmapped page and segfaults at the fault rather than in the middle of the
+   next function. This is the crudest possible version of the code-object
+   question the whole exercise is really about. *)
+let page = 4096
+
+let install (code : string) : nativeint =
+  if String.length code > page then failwith "function exceeds one page";
+  let p = jit_alloc page in
+  jit_write p code;
+  jit_protect p page;
+  p
+
+let run src =
+  let decls =
+    Flan.Load.program ~file:src (Flan.Parse.program_all (Flan.Reader.read_file src))
+  in
+  let prog = Flan.Check.program_all decls.Flan.Load.decls in
+  Printf.printf "frontend: %d fns, %d globals, %d structs, %d externs\n"
+    (List.length prog.Flan.Tast.fns) (List.length prog.Flan.Tast.globals)
+    (List.length prog.Flan.Tast.structs) (List.length prog.Flan.Tast.externs);
+
+  (* Two passes, because [spike-calls] calls functions whose addresses are not
+     known until they are installed. Pass one installs every function at a
+     fixed page; pass two emits the real code into it. A real backend does this
+     with relocations; the spike does it by emitting twice, which is the same
+     answer with none of the machinery. *)
+  let addrs : (string, nativeint) Hashtbl.t = Hashtbl.create 16 in
+  let unsupported = ref [] in
+  let lowerable =
+    List.filter
+      (fun (fd : Flan.Tast.fn) ->
+         try
+           ignore (X86.fn ~resolve:(fun _ -> 0L) fd);
+           true
+         with X86.Unsupported m ->
+           unsupported := (fd.Flan.Tast.name, m) :: !unsupported;
+           false)
+      prog.Flan.Tast.fns
+  in
+  List.iter
+    (fun (fd : Flan.Tast.fn) ->
+       Hashtbl.replace addrs fd.Flan.Tast.name (jit_alloc page))
+    lowerable;
+  let resolve name =
+    match Hashtbl.find_opt addrs name with
+    | Some p -> Int64.of_nativeint p
+    | None ->
+      (* Not a Flan function: a runtime entry point, looked up the way a dev
+         build already reaches the host's symbols -- through the dynamic symbol
+         table, which --dev links with -rdynamic. *)
+      Int64.of_nativeint (sym name)
+  in
+  let bytes = Hashtbl.create 16 in
+  List.iter
+    (fun (fd : Flan.Tast.fn) ->
+       let code = X86.fn ~resolve fd in
+       Hashtbl.replace bytes fd.Flan.Tast.name code;
+       let p = Hashtbl.find addrs fd.Flan.Tast.name in
+       jit_write p code;
+       jit_protect p page)
+    lowerable;
+
+  Printf.printf "lowered: %d of %d functions\n"
+    (List.length lowerable) (List.length prog.Flan.Tast.fns);
+  List.iter (fun (n, m) -> Printf.printf "  skipped %-20s %s\n" n m)
+    (List.rev !unsupported);
+  Hashtbl.iter (fun n c -> Printf.printf "  %-20s %4d bytes at %nx\n"
+                   n (String.length c) (Hashtbl.find addrs n)) bytes;
+
+  (* Dumped so oracle.sh can disassemble exactly the bytes that ran. *)
+  (try
+     let oc = open_out_bin (Filename.concat (Filename.dirname Sys.argv.(0)) "spike-add.bin") in
+     output_string oc (Hashtbl.find bytes "spike-add");
+     close_out oc
+   with Not_found -> ());
+
+  print_endline "results:";
+  let at n = Hashtbl.find addrs n in
+  check "spike-add 3 4" (call2 (at "spike-add") 3L 4L) 7L;
+  check "spike-add -5 2" (call2 (at "spike-add") (-5L) 2L) (-3L);
+  check "spike-arith 10 4" (call2 (at "spike-arith") 10L 4L) 19L;
+  check "spike-let 6" (call1 (at "spike-let") 6L) 1332L;
+  check "spike-if 1 2" (call2 (at "spike-if") 1L 2L) 1L;
+  check "spike-if 9 2" (call2 (at "spike-if") 9L 2L) 7L;
+  check "spike-calls 5" (call1 (at "spike-calls") 5L) 656L;
+
+  Printf.printf "\n%d checks, %d failures\n" !checks !failures;
+  exit (if !failures = 0 then 0 else 1)
+
+(* The frontend's diagnostics printed rather than swallowed: a spike that says
+   [Fatal error: exception Errors(_)] costs an hour. *)
+let () =
+  try run Sys.argv.(1) with
+  | Flan.Loc.Error d -> prerr_endline (Flan.Loc.report d); exit 2
+  | Flan.Loc.Errors ds -> prerr_endline (Flan.Loc.report_all ds); exit 2

spike/backend/jit_stubs.c

@@ -0,0 +1,105 @@
+/* The three things OCaml cannot do for itself: get executable memory, put
+ * bytes in it, and jump to them. Everything interesting is in x86.ml; this
+ * file is deliberately dumb.
+ *
+ * Shaped after lib/dynload_stubs.c's rule, which spike/embed took verbatim for
+ * the same reason: the boundary passes pointers and scalars, never an OCaml
+ * [value] into foreign storage. Nothing here keeps anything.
+ *
+ * RW then mprotect to R+X, never RWX in one mmap: a hardened kernel may refuse
+ * a writable-executable anonymous mapping outright, and a policy denial that
+ * comes back as a null pointer reads exactly like an encoding bug. */
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+
+#include <sys/mman.h>
+#include <string.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <dlfcn.h>
+
+value spike_jit_alloc(value vlen) {
+  size_t len = (size_t)Long_val(vlen);
+  void *p = mmap(NULL, len, PROT_READ | PROT_WRITE,
+                 MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+  if (p == MAP_FAILED) caml_failwith("spike_jit_alloc: mmap failed");
+  return caml_copy_nativeint((intnat)p);
+}
+
+value spike_jit_write(value vp, value vbytes) {
+  char *p = (char *)Nativeint_val(vp);
+  memcpy(p, String_val(vbytes), caml_string_length(vbytes));
+  return Val_unit;
+}
+
+value spike_jit_protect(value vp, value vlen) {
+  void *p = (void *)Nativeint_val(vp);
+  if (mprotect(p, (size_t)Long_val(vlen), PROT_READ | PROT_EXEC) != 0)
+    caml_failwith("spike_jit_protect: mprotect failed");
+  return Val_unit;
+}
+
+/* Every Flan function's emitted signature is its parameters followed by the
+ * transfer channel (emit.ml, [signature]), so the trampolines below all pass a
+ * trailing pointer. Nothing in the spike transfers, so it is NULL. */
+typedef int64_t (*fn0)(void *);
+typedef int64_t (*fn1)(int64_t, void *);
+typedef int64_t (*fn2)(int64_t, int64_t, void *);
+
+value spike_call0(value vp) {
+  return caml_copy_int64(((fn0)Nativeint_val(vp))(NULL));
+}
+value spike_call1(value vp, value a) {
+  return caml_copy_int64(((fn1)Nativeint_val(vp))(Int64_val(a), NULL));
+}
+value spike_call2(value vp, value a, value b) {
+  return caml_copy_int64(((fn2)Nativeint_val(vp))(Int64_val(a), Int64_val(b), NULL));
+}
+
+value spike_sym(value vname) {
+  void *h = dlsym(RTLD_DEFAULT, String_val(vname));
+  if (h == NULL) caml_failwith("spike_sym: not found");
+  return caml_copy_nativeint((intnat)h);
+}
+
+/* ── The C side of the ABI probes ──────────────────────────────────── */
+
+/* Eight integers: six in registers, two on the stack, which is the case a
+ * register-only convention silently gets wrong. The answer is positional so a
+ * swapped pair cannot pass. */
+int64_t spike_probe8(int64_t a, int64_t b, int64_t c, int64_t d,
+                     int64_t e, int64_t f, int64_t g, int64_t h) {
+  return a * 1 + b * 10 + c * 100 + d * 1000 + e * 10000 + f * 100000
+       + g * 1000000 + h * 10000000;
+}
+
+/* The alignment check, and it has to be done with an aligned load rather than
+ * by reading rsp, because that is how raylib finds out: the SysV ABI promises
+ * rsp % 16 == 0 at the call instruction, so on entry rsp+8 is aligned, and a
+ * callee that spills an __m128 to its frame faults when it is not. -O2 is what
+ * turns this into an actual movaps; without it the bug hides. */
+__attribute__((noinline))
+int64_t spike_probe_align(int64_t x) {
+  volatile double v[2] __attribute__((aligned(16))) = { 1.0, 2.0 };
+  /* Reading rsp as well, so a failure says which of the two it was. */
+  uintptr_t sp;
+  __asm__ volatile ("mov %%rsp, %0" : "=r"(sp));
+  if ((sp % 16) != 8) return -1;   /* entry rsp is call-site rsp minus 8 */
+  return x + (int64_t)(v[0] + v[1]);
+}
+
+/* A double in xmm0 alongside integers, and al = number of vector registers
+ * used is *not* required here because this is not variadic -- which is itself
+ * the thing to record. */
+double spike_probe_f(int64_t a, double x, int64_t b, double y) {
+  return (double)a + x * 2.0 + (double)b * 100.0 + y * 200.0;
+}
+
+/* A small struct by value. BUILT.md's "Why the FFI goes through a C shim"
+ * says Flan never emits one of these -- the shim flattens it. This is here to
+ * measure what the shim is saving us from, not because the backend needs it. */
+typedef struct { float x, y; } spike_vec2;
+float spike_probe_struct(spike_vec2 v, float s) { return v.x * s + v.y; }

spike/backend/probe.flan

@@ -0,0 +1,24 @@
+;; The spike's input. Ordinary Flan, run through the ordinary frontend --
+;; Reader, Parse, Load, Check -- so that what the emitter below lowers is the
+;; same Tast.fn the LLVM backend gets and not a literal someone typed to make
+;; the exercise come out.
+
+(defn spike-add [a i64  b i64] i64
+  (+ a b))
+
+(defn spike-arith [a i64  b i64] i64
+  (- (* a 3) (+ b 7)))
+
+(defn spike-let [a i64] i64
+  (let [x (* a a)
+        y (+ x 1)]
+    (* x y)))
+
+(defn spike-if [a i64  b i64] i64
+  (if (< a b) (- b a) (- a b)))
+
+(defn spike-calls [a i64] i64
+  (spike-add (spike-arith a 2) (spike-let a)))
+
+(defn main [] i32
+  0)

spike/backend/run.sh

@@ -0,0 +1,38 @@
+#!/usr/bin/env bash
+# The spike, end to end: the real frontend produces a Tast, x86.ml turns it
+# into bytes, the bytes go into an mmap, and the mmap gets called.
+#
+# Driven by hand with ocamlfind and clang against the flan.cmxa dune already
+# builds, exactly as spike/embed does and for the same reason: nothing under
+# spike/ is wired into the build, so there is no dune file here and `dune test`
+# cannot see any of it.
+set -u
+here=$(cd "$(dirname "$0")" && pwd)
+root=$(cd "$here/../.." && pwd)
+cd "$root" || exit 1
+
+dune build --root . lib/flan.cmxa 2>&1 | head -20
+
+out=$(mktemp -d); trap 'rm -rf "$out"' EXIT
+
+# The C stubs. -O2 on purpose: spike_probe_align's aligned load only becomes a
+# real movaps with optimisation on, and an alignment bug that only shows up in
+# a release build is the one this is looking for.
+clang -O2 -c -I"$(ocamlopt -where)" "$here/jit_stubs.c" -o "$out/jit_stubs.o" || exit 1
+
+ocamlfind ocamlopt -thread -package unix,threads.posix -linkpkg \
+  -I "$root/_build/default/lib/.flan.objs/byte" \
+  -I "$root/_build/default/lib/.flan.objs/native" \
+  -I "$out" -I "$here" \
+  -o "$out/spike" \
+  "$root/_build/default/lib/flan.cmxa" \
+  -cclib -rdynamic -ccopt -L"$root/_build/default/lib" \
+  "$out/jit_stubs.o" \
+  "$here/x86.ml" "$here/driver.ml" 2>&1 | head -40
+
+test -x "$out/spike" || { echo "build failed"; exit 1; }
+
+"$out/spike" "$here/probe.flan"
+rc=$?
+echo "exit: $rc"
+exit $rc

spike/backend/x86.ml

@@ -0,0 +1,363 @@
+(* A spike: Tast -> x86-64 machine code, in memory, called. Not a backend.
+   The point is to find out what breaks, so the subset is deliberately tiny
+   and every case it cannot do raises with the node that defeated it -- an
+   honest [Unsupported] is the measurement, and a silently wrong answer is
+   the one outcome that would waste the exercise.
+
+   Register allocation is the trivial one the brief allows: every slot is a
+   stack slot at [rbp - 8*(i+1)], every value is computed into rax, and a
+   binary operator pushes its left operand. Two registers are enough for
+   everything below and nothing is kept live across a statement. That is what
+   makes an instruction selector tractable in an afternoon; it is also why the
+   code it produces is four times the size of clang -O0's.
+
+   Conventions, all of them SysV's, because raylib is called from this code:
+     - integer arguments in rdi rsi rdx rcx r8 r9, then right-to-left on the
+       stack; integer result in rax.
+     - rsp % 16 == 0 at the [call] instruction. raylib spills xmm registers
+       with movaps and faults far from the cause when this is wrong.
+     - rbx rbp r12-r15 are callee-saved. This emitter touches none of them
+       except rbp, which it saves.
+     - every Flan function takes the transfer channel as a trailing ptr
+       (emit.ml, [signature]), so a Flan function of n parameters is an n+1
+       argument C function. *)
+
+exception Unsupported of string
+
+let unsupported fmt = Printf.ksprintf (fun s -> raise (Unsupported s)) fmt
+
+(* ── Bytes ───────────────────────────────────────────────────────────── *)
+
+type buf = { mutable bytes : Buffer.t }
+
+let create () = { bytes = Buffer.create 256 }
+let len b = Buffer.length b.bytes
+let contents b = Buffer.contents b.bytes
+let u8 b n = Buffer.add_char b.bytes (Char.chr (n land 0xff))
+
+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
+
+(* ── Registers and modrm ─────────────────────────────────────────────── *)
+
+(* The encoding order, not the ABI order: this numbering *is* the three bits
+   the modrm byte wants, which is why rsp is 4 and rbp is 5 rather than
+   anything more memorable. *)
+let rax = 0 and rcx = 1 and rdx = 2 and _rbx = 3
+let rsp = 4 and rbp = 5 and rsi = 6 and rdi = 7
+let r8 = 8 and r9 = 9
+
+(* REX.W is always set: everything here is 64-bit. R extends the reg field and
+   B the r/m field, which is the whole of what r8-r15 need. *)
+let rex b ~r ~m = u8 b (0x48 lor (if r >= 8 then 4 else 0) lor (if m >= 8 then 1 else 0))
+let modrm b ~md ~r ~m = u8 b ((md lsl 6) lor ((r land 7) lsl 3) lor (m land 7))
+
+(* reg, reg *)
+let rr b op ~r ~m = rex b ~r ~m; u8 b op; modrm b ~md:3 ~r ~m
+
+(* reg, [rbp + disp32]. Always disp32 rather than the shorter disp8 form: a
+   frame can outgrow 128 bytes and a one-byte displacement that silently wraps
+   is exactly the bug this spike would not find. *)
+let rm_rbp b op ~r ~disp =
+  rex b ~r ~m:rbp; u8 b op; modrm b ~md:2 ~r ~m:rbp; i32 b disp
+
+let mov_rr b ~dst ~src = rr b 0x89 ~r:src ~m:dst          (* mov dst, src *)
+let mov_load b ~dst ~disp = rm_rbp b 0x8b ~r:dst ~disp    (* mov dst, [rbp+d] *)
+let mov_store b ~src ~disp = rm_rbp b 0x89 ~r:src ~disp   (* mov [rbp+d], src *)
+
+let movabs b ~dst (n : int64) =
+  rex b ~r:0 ~m:dst; u8 b (0xb8 lor (dst land 7)); u64 b n
+
+let push b r = if r >= 8 then u8 b 0x41; u8 b (0x50 lor (r land 7))
+let pop b r = if r >= 8 then u8 b 0x41; u8 b (0x58 lor (r land 7))
+
+let add_rr b ~dst ~src = rr b 0x01 ~r:src ~m:dst
+let sub_rr b ~dst ~src = rr b 0x29 ~r:src ~m:dst
+let and_rr b ~dst ~src = rr b 0x21 ~r:src ~m:dst
+let or_rr  b ~dst ~src = rr b 0x09 ~r:src ~m:dst
+let xor_rr b ~dst ~src = rr b 0x31 ~r:src ~m:dst
+let imul_rr b ~dst ~src =                                  (* 0f af /r *)
+  rex b ~r:dst ~m:src; u8 b 0x0f; u8 b 0xaf; modrm b ~md:3 ~r:dst ~m:src
+let cmp_rr b ~a ~bb = rr b 0x39 ~r:bb ~m:a                 (* cmp a, b *)
+
+let add_imm32 b ~dst n = rex b ~r:0 ~m:dst; u8 b 0x81; modrm b ~md:3 ~r:0 ~m:dst; i32 b n
+let sub_imm32 b ~dst n = rex b ~r:0 ~m:dst; u8 b 0x81; modrm b ~md:3 ~r:5 ~m:dst; i32 b n
+
+let call_r b r = if r >= 8 then u8 b 0x41; u8 b 0xff; modrm b ~md:3 ~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
+
+(* setcc al, then movzx rax, al -- a compare's result is a bool, which is one
+   byte in Flan's layout (i1 in LLVM, and the ABI zero-extends it). *)
+let setcc b cc = u8 b 0x0f; u8 b (0x90 lor cc); modrm b ~md:3 ~r:0 ~m:rax
+let movzx_al b = u8 b 0x48; u8 b 0x0f; u8 b 0xb6; modrm b ~md:3 ~r:rax ~m:rax
+
+(* jcc rel32 and jmp rel32, patched once the target is known. *)
+let jcc b cc = u8 b 0x0f; u8 b (0x80 lor cc); let at = len b in u32 b 0; at
+let jmp b = u8 b 0xe9; let at = len b in u32 b 0; at
+
+let patch b ~at ~target =
+  let rel = target - (at + 4) in
+  let s = Buffer.contents b.bytes in
+  let s = Bytes.of_string s in
+  for i = 0 to 3 do
+    Bytes.set s (at + i) (Char.chr ((rel asr (i * 8)) land 0xff))
+  done;
+  let nb = Buffer.create (Bytes.length s) in
+  Buffer.add_bytes nb s;
+  b.bytes <- nb
+
+(* ── Lowering ────────────────────────────────────────────────────────── *)
+
+type fnctx = {
+  b : buf;
+  nslots : int;
+  (* A symbol the code calls, resolved to an absolute address by the driver
+     before emission. movabs + call r is what a JIT does anyway: a rel32 call
+     cannot reach an arbitrary mmap, and the 2-byte indirect call is cheaper
+     than the relocation machinery a real backend would grow here. *)
+  resolve : string -> int64;
+}
+
+let slot_disp i = -8 * (i + 1)
+
+(* Every type this spike handles is one 8-byte integer register. Everything
+   else is the real backend's problem and is enumerated in the verdict rather
+   than guessed at here. *)
+let word_ty (t : Flan.Types.t) =
+  match t with
+  | Flan.Types.Int _ | Flan.Types.Bool | Flan.Types.Ptr _ -> true
+  | _ -> false
+
+let check_word what (t : Flan.Types.t) =
+  if not (word_ty t) then
+    unsupported "%s of type %s: not a single integer register" what
+      (Flan.Types.to_string t)
+
+let cc_of signed (p : Flan.Tast.prim) =
+  match p, signed with
+  | Flan.Tast.Eq, _ -> 0x4 | Flan.Tast.Ne, _ -> 0x5
+  | Flan.Tast.Lt, true -> 0xc | Flan.Tast.Lt, false -> 0x2
+  | Flan.Tast.Le, true -> 0xe | Flan.Tast.Le, false -> 0x6
+  | Flan.Tast.Gt, true -> 0xf | Flan.Tast.Gt, false -> 0x7
+  | Flan.Tast.Ge, true -> 0xd | Flan.Tast.Ge, false -> 0x3
+  | _ -> assert false
+
+let arg_regs = [| rdi; rsi; rdx; rcx; r8; r9 |]
+
+(* Value into rax. Everything is a subexpression of something that will
+   immediately consume rax, so nothing is kept live and no allocator is
+   needed. *)
+let rec value f (e : Flan.Tast.expr) : unit =
+  let b = f.b in
+  match e.Flan.Tast.e with
+  | Flan.Tast.Int (n, _) -> movabs b ~dst:rax n
+  | Flan.Tast.Bool v -> movabs b ~dst:rax (if v then 1L else 0L)
+  | Flan.Tast.Local i ->
+    check_word "local" e.Flan.Tast.ty;
+    if i >= f.nslots then unsupported "slot %d out of range" i;
+    mov_load b ~dst:rax ~disp:(slot_disp i)
+  | Flan.Tast.Do body -> block f body
+  | Flan.Tast.Let (binds, body) ->
+    List.iter
+      (fun (i, e) ->
+         value f e;
+         check_word "binding" e.Flan.Tast.ty;
+         mov_store b ~src:rax ~disp:(slot_disp i))
+      binds;
+    block f body
+  | Flan.Tast.Set (Flan.Tast.Plocal i, rhs) ->
+    value f rhs;
+    check_word "assignment" rhs.Flan.Tast.ty;
+    mov_store b ~src:rax ~disp:(slot_disp i)
+  | Flan.Tast.If (c, t, e') -> emit_if f c t e'
+  | Flan.Tast.Return (Some x) ->
+    value f x;
+    leave b; ret b
+  | Flan.Tast.Return None -> leave b; ret b
+  | Flan.Tast.Prim (p, args) -> prim f e p args
+  | Flan.Tast.Call (name, args) -> call f (f.resolve name) args ~xfer:true
+  | Flan.Tast.Unit -> ()
+  | k -> unsupported "expression: %s" (node_name k)
+
+and block f body =
+  match body with
+  | [] -> ()
+  | [ last ] -> value f last
+  | x :: rest -> value f x; block f rest
+
+and prim f e (p : Flan.Tast.prim) args =
+  let b = f.b in
+  match p, args with
+  | (Flan.Tast.Add | Flan.Tast.Sub | Flan.Tast.Mul
+    | Flan.Tast.BitAnd | Flan.Tast.BitOr | Flan.Tast.BitXor), [ x; y ] ->
+    check_word "arithmetic" x.Flan.Tast.ty;
+    binop f x y;
+    (* left in rax, right in rcx *)
+    (match p with
+     | Flan.Tast.Add -> add_rr b ~dst:rax ~src:rcx
+     | Flan.Tast.Sub -> sub_rr b ~dst:rax ~src:rcx
+     | Flan.Tast.Mul -> imul_rr b ~dst:rax ~src:rcx
+     | Flan.Tast.BitAnd -> and_rr b ~dst:rax ~src:rcx
+     | Flan.Tast.BitOr -> or_rr b ~dst:rax ~src:rcx
+     | _ -> xor_rr b ~dst:rax ~src:rcx)
+  | (Flan.Tast.Eq | Flan.Tast.Ne | Flan.Tast.Lt | Flan.Tast.Le
+    | Flan.Tast.Gt | Flan.Tast.Ge), [ x; y ] ->
+    let signed =
+      match x.Flan.Tast.ty with
+      | Flan.Types.Int k -> Flan.Types.signed k
+      | Flan.Types.Bool -> false
+      | t -> unsupported "comparison on %s" (Flan.Types.to_string t)
+    in
+    binop f x y;
+    cmp_rr b ~a:rax ~bb:rcx;
+    setcc b (cc_of signed p);
+    movzx_al b
+  | Flan.Tast.Rt sym, args -> call f (f.resolve sym) args ~xfer:false
+  | _ -> unsupported "primitive in %s" (Flan.Types.to_string e.Flan.Tast.ty)
+
+(* Left into rax, right into rcx, with the left spilled across the right's
+   evaluation. Left-to-right, which emit.ml's [map_lr] is explicit about being
+   required rather than a preference -- a call in either operand has effects.
+   The push/pop pair keeps rsp 16-aligned in pairs, which matters only because
+   [call] below re-derives alignment from a counter rather than tracking rsp. *)
+and binop f x y =
+  let b = f.b in
+  value f x;
+  push b rax;
+  value f y;
+  mov_rr b ~dst:rcx ~src:rax;
+  pop b rax
+
+and emit_if f c t e =
+  let b = f.b in
+  value f c;
+  (* cmp rax, 0: 48 83 f8 00 -- written out because the helper above takes
+     registers only and a zero-compare is the one immediate form worth having. *)
+  u8 b 0x48; u8 b 0x83; modrm b ~md:3 ~r:7 ~m:rax; u8 b 0x00;
+  let to_else = jcc b 0x4 in     (* je *)
+  value f t;
+  let to_end = jmp b in
+  patch b ~at:to_else ~target:(len b);
+  value f e;
+  patch b ~at:to_end ~target:(len b)
+
+(* A call, and this is the part that has to be exactly right.
+
+   [xfer] appends the transfer channel, which every Flan function's signature
+   carries and a C entry point does not. The spike passes NULL: nothing here
+   signals, and a real backend would pass the caller's own channel pointer.
+
+   Alignment: rsp is 16-aligned at function entry minus the 8 the [call]
+   pushed, so after [push rbp] it is aligned again, and the frame is rounded to
+   a multiple of 16. Every push here is paired with a pop before the next call
+   can happen, so rsp is aligned at every call site by construction. Stack
+   arguments are pushed in pairs to keep it that way -- an odd count gets a
+   dummy push, which is what clang's [sub rsp, 8] is doing when you see it. *)
+and call f (addr : int64) args ~xfer =
+  let b = f.b in
+  let n = List.length args + (if xfer then 1 else 0) in
+  if n > 6 then begin
+    (* The stack half. Evaluate every stacked argument first, right to left,
+       leaving them pushed, then fill the registers -- otherwise evaluating a
+       stacked argument would clobber a register already loaded. *)
+    let stacked = List.filteri (fun i _ -> i >= 6) args in
+    let nstack = List.length stacked + (if xfer then 1 else 0) in
+    if nstack land 1 = 1 then sub_imm32 b ~dst:rsp 8;
+    if xfer then (movabs b ~dst:rax 0L; push b rax);
+    List.iter (fun a -> value f a; push b rax) (List.rev stacked)
+  end;
+  (* The register half, and it needs a spill: rdi..r9 are argument registers
+     and rax is where every value lands, so an earlier argument would be
+     clobbered by a later one's evaluation. Push each, then pop them into
+     their registers in reverse. *)
+  let inreg = List.filteri (fun i _ -> i < 6) args in
+  List.iter (fun a -> value f a; push b rax) inreg;
+  let nreg = List.length inreg in
+  List.iteri (fun i _ -> pop b arg_regs.(nreg - 1 - i)) inreg;
+  if xfer && n <= 6 then movabs b ~dst:arg_regs.(nreg) 0L;
+  (* al = number of vector registers used. Required only for a variadic
+     callee, and set unconditionally because it is free and a wrong al on a
+     printf-shaped raylib entry point (TraceLog is one) is a crash that looks
+     like anything else. It must be set *after* the argument registers, since
+     al is rax's low byte. *)
+  u8 b 0xb0; u8 b 0x00;          (* mov al, 0 *)
+  (* r11 always, never r9: r11 is the scratch register SysV reserves and is the
+     one 64-bit register guaranteed not to be carrying an argument. Picking the
+     target conditionally is how a call with six arguments gets quietly wrong. *)
+  u8 b 0x49; u8 b 0xbb; u64 b addr;   (* movabs r11, addr *)
+  call_r b 11;
+  if n > 6 then begin
+    let nstack = List.length args - 6 + (if xfer then 1 else 0) in
+    let pop_bytes = 8 * (nstack + (nstack land 1)) in
+    add_imm32 b ~dst:rsp pop_bytes
+  end
+
+and node_name (k : Flan.Tast.expr_kind) =
+  match k with
+  | Flan.Tast.Int _ -> "Int" | Flan.Tast.Float _ -> "Float"
+  | Flan.Tast.Bool _ -> "Bool" | Flan.Tast.Str _ -> "Str"
+  | Flan.Tast.Unit -> "Unit" | Flan.Tast.Zero _ -> "Zero"
+  | Flan.Tast.Uninit _ -> "Uninit" | Flan.Tast.Local _ -> "Local"
+  | Flan.Tast.Global _ -> "Global" | Flan.Tast.Prim _ -> "Prim"
+  | Flan.Tast.Call _ -> "Call" | Flan.Tast.FnAddr _ -> "FnAddr"
+  | Flan.Tast.CallPtr _ -> "CallPtr" | Flan.Tast.Do _ -> "Do"
+  | Flan.Tast.Let _ -> "Let" | Flan.Tast.If _ -> "If"
+  | Flan.Tast.While _ -> "While" | Flan.Tast.Return _ -> "Return"
+  | Flan.Tast.Break _ -> "Break" | Flan.Tast.Continue _ -> "Continue"
+  | Flan.Tast.Set _ -> "Set" | Flan.Tast.Field _ -> "Field"
+  | Flan.Tast.Addr _ -> "Addr" | Flan.Tast.Deref _ -> "Deref"
+  | Flan.Tast.Make _ -> "Make" | Flan.Tast.MakeCase _ -> "MakeCase"
+  | Flan.Tast.CaseField _ -> "CaseField" | Flan.Tast.Arr _ -> "Arr"
+  | Flan.Tast.Some_ _ -> "Some" | Flan.Tast.None_ -> "None"
+  | Flan.Tast.Match _ -> "Match" | Flan.Tast.UnwrapSome _ -> "UnwrapSome"
+  | Flan.Tast.Signal _ -> "Signal" | Flan.Tast.Handled _ -> "Handled"
+  | Flan.Tast.RestartCase _ -> "RestartCase"
+  | Flan.Tast.WithAlloc _ -> "WithAlloc"
+  | Flan.Tast.InvokeRestart _ -> "InvokeRestart"
+
+(* ── A whole function ────────────────────────────────────────────────── *)
+
+let fn ~resolve (fd : Flan.Tast.fn) : string =
+  let b = create () in
+  let nslots = Array.length fd.Flan.Tast.slots in
+  let f = { b; nslots; resolve } in
+  push b rbp;
+  mov_rr b ~dst:rbp ~src:rsp;
+  (* Round the frame to 16 so that rsp is aligned at every call site. One
+     extra word for the transfer channel's slot, which is not a Flan slot and
+     has no index -- the spike never reads it, but a real backend must, and
+     leaving no room for it is the kind of thing that is cheap now and
+     expensive later. *)
+  let frame = (nslots + 1) * 8 in
+  let frame = (frame + 15) land lnot 15 in
+  if frame > 0 then sub_imm32 b ~dst:rsp frame;
+  (* Parameters arrive in registers and are stored into their slots at once,
+     which is also emit.ml's rule: slots 0..n-1 are the parameters, in order. *)
+  let np = List.length fd.Flan.Tast.params in
+  if np > 6 then unsupported "more than six parameters";
+  List.iteri
+    (fun i ty ->
+       check_word "parameter" ty;
+       mov_store b ~src:arg_regs.(i) ~disp:(slot_disp i))
+    fd.Flan.Tast.params;
+  (* The transfer channel is the last argument and goes just past the slots. *)
+  if np < 6 then mov_store b ~src:arg_regs.(np) ~disp:(slot_disp nslots);
+  block f fd.Flan.Tast.body;
+  leave b; ret b;
+  (* Anything that falls off the end of a Never-returning body lands here and
+     traps rather than running into the next function. LLVM's [unreachable] is
+     undefined behaviour; ud2 is a defined SIGILL, and the difference is one of
+     the audit's findings. *)
+  ud2 b;
+  contents b