flan/spike/backend/jit_stubs.c
Joseph Ferano 57fe91f303 Five records become one, and every citation lands somewhere
FIX.org, NEXT.md, DISCUSS.org, docs/DISCUSS.md and the session handoff at the
root are one TODO.org now: 293 entries under seven subsystem headings, each
carrying an org keyword that says where it stands. A DONE entry is a few lines
saying what was decided and what that rules out; the reasoning that would not
compress — the embedding spike and the four reports the hand-written x86
backend was built from — moved into docs/BUILT.md instead, and its entries
point there in one line.

Every entry was checked against the tree before it got a keyword, and the
prose was wrong in both directions. Things the deleted files called open were
built: the first-evaluation stall, main being redefinable, macro parameter
lists, the type-limit constants, the array constructors, the byte fills,
inc/dec, the discard's fontification, the Emacs buffers, rt_die's _exit, the
backtrace surface, and the acceptance failure that could print and still exit
zero. Things they called done were not: the backend reports' no-plan buckets
had gone stale in the other direction, the value-dependent defvar was
superseded rather than built, and macro-expansion source locations are on an
unmerged lane, so that entry is NEXT and names the branch.

Every comment that cited one of the five by name now cites a heading that
exists, in TODO.org or in docs/BUILT.md. The session reports under
docs/handoffs/ keep naming the files they worked on, because rewriting them
would falsify what those sessions did; each carries a note saying where the
content went.
2026-09-21 21:05:48 +07:00

101 lines
4.2 KiB
C

/* 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 (*fn1)(int64_t, void *);
typedef int64_t (*fn2)(int64_t, int64_t, void *);
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]);
}
/* No float probe either, for a plainer reason: this emitter has no SSE, so
* there is nothing here that could call one. Floats are counted as work in
* docs/BUILT.md, "Layout was already owned, and that is why the drift fear
* was misplaced", rather than claimed as done.
*
* And no struct-by-value probe, and that is a finding rather than an
* omission: check.ml rejects an aggregate in a [declare] signature and the
* generated shim flattens every one, so no Flan-emitted call ever passes a
* struct to C. The aggregate problem is real but it is on the Flan-to-Flan
* side, which is measured in docs/BUILT.md, "The obstacle that was named
* first, and dissolved", and not from here. */