The compiler links into the program, and the objection we feared does not exist

This commit is contained in:
Joseph Ferano 2026-09-12 20:37:02 +07:00
commit 2b0cd9b9b4
22 changed files with 1227 additions and 0 deletions

View File

@ -559,3 +559,164 @@ way an SBCL executable can. The dev/release split is a build flag, not an archit
**And one correction to keep:** OCaml's own wasm support is irrelevant to any of this. OCaml is the compiler's
implementation language; Flan programs reach wasm through LLVM. The two only meet if the *compiler* should run in a
browser, which is not a goal.
## 14. The embedding spike, answered: OCaml 5.2 goes into a Flan dev build, and nothing objects
Item 12's brief, run. **Feasible.** No obstacle was found that argues for porting the compiler, and the one expected to
be sharpest — signals — turned out not to exist on the platform measured.
The apparatus is `spike/embed/`: four shell scripts and sixteen small sources, deliberately not a dune target, driving
`ocamlfind` and `clang` by hand against the `flan.cmxa` dune already builds. `bash spike/embed/run.sh` reproduces
everything below; `sig.sh`, `symbols.sh` and `merged.sh` each answer a question on their own. Nothing under `spike/` is
wired into the build, and `dune test --root .` is green either side of it.
### The headline: one binary, and it compiles itself
`spike/embed/merged.sh` builds a single executable out of, in one `clang` link:
- the emitted Flan program (`test/programs/edn.flan`, `--dev`, `@main` renamed to `flan_program_main`),
- `runtime/flan_rt.c`, `runtime/flan_dev.c`, `vendor/agent/flan_agent.c`,
- and the entire OCaml compiler as one `-output-complete-obj` object.
It runs. A C `main()` holds the main thread and runs the Flan program there; `caml_startup` happens on a `pthread`
beside it, next to where `flan_agent_start` already puts its listener. The compiler inside the binary then compiles
`edn.flan` — the source the program itself was built from — and emits 336,579 bytes of LLVM IR. That single result
answers questions 1 and 2 together; the ladder of smaller probes underneath it is support, not evidence in its own
right.
Nothing is wired up. The two halves share an address space and do not speak to each other. That is the point: the
question was whether they *can*, not what they would say.
### Question 1 — does OCaml link into a native binary here?
Yes, and with less friction than expected.
- `ocamlopt -output-complete-obj` is the one to use, not `-output-obj`: it bundles the runtime, so there is no hunt for
`libasmrun`. The final link needs `-lm -lpthread -ldl` and, on 5.2, **`-lzstd`** — 5.x's marshaller is compressed,
and the missing `ZSTD_*` symbols are the first thing a naive link fails on. That is the whole of the surprise.
- **dune is not in the way, because it does not have to be involved.** dune builds `lib/flan.cmxa` as it does today;
the `-output-complete-obj` step consumes that artifact afterwards. No dune rule had to change, and `lib/dune` and
`bin/dune` are untouched. A real merge would want a dune rule to drive that step, but the spike shows the artifact
boundary is clean, which is the part that could have failed.
- **The existing C stubs come through.** `lib/dynload_stubs.c` was taken verbatim from the unmerged `9e0ae3a` dlopen
branch and compiled into the same object; from inside the embedded runtime, `flan_mem_alloc`/`poke`/`peek`
round-trip correctly and `dlopen`+`dlsym` work. `-output-complete-obj` carries a `foreign_stubs`-shaped C file
through without special handling.
- **No symbol collides** (`symbols.sh`). Flan's own C — `flan_rt.c`, `flan_dev.c`, `flan_agent.c`, `dynload_stubs.c`
defines 211 symbols; `libasmrun.a` defines 1,379; the intersection is empty, and the four Flan files do not collide
with each other either. Worth checking rather than assuming: those four are compiled into *two different processes*
today, and merging puts them in one link for the first time.
### Question 2 — threads, and who owns the main loop
**OCaml 5.2 is confirmed multicore**, and `Domain.recommended_domain_count ()` reports 16 here. A spawned domain does
real work in parallel with the main thread. The objection that would have been fatal is gone.
The macOS shape works, and it was tested as the thing that matters rather than as "can OCaml use threads":
- `caml_startup` can be called from a **C-created, non-main pthread**, while `main()` goes on to a loop it does not
leave. `harness4.c` runs a 298-frame mock game loop on the main thread that never once enters OCaml.
- **A second C thread — one the runtime never created, which is exactly the agent's listener — can call into OCaml**
after `caml_c_thread_register()`, bracketed by `caml_acquire_runtime_system`/`caml_release_runtime_system`. It
compiled the same program successfully from that thread. This is the specific capability the merged design needs
from `flan_agent.c`, and it exists.
The spike could not test macOS. Nothing here is macOS-specific — the inversion is a portable pthread arrangement — but
it is a Linux measurement.
### Question 3 — signals
**On Linux/amd64, OCaml 5.2 installs no signal handlers at all.** Not SIGSEGV, not SIGINT, not SIGFPE, not SIGPIPE,
nothing. The expected conflict does not exist.
`sig.sh` sweeps fifteen signals from inside the runtime at four moments — before `caml_startup`, at module init, from
inside a spawned domain, and after `Domain.join` — and every one is `SIG_DFL`. The reading has to be taken from inside
OCaml rather than from C after `caml_startup` returns, because OCaml 5 starts domains later; the first pass got this
wrong and read `SIG_DFL` for the wrong reason. A plain `ocamlopt` executable was built as a control and behaves
identically, so embedding changes nothing about signals.
The reason is structural, not incidental: OCaml 5 detects stack overflow with an explicit stack-limit check and calls
`caml_raise_stack_overflow` directly, rather than with a guard page and a SIGSEGV handler. `nm` on `libasmrun.a` shows
`sigaltstack` referenced but no SIGSEGV handler defined, which matches.
So **the break loop can take `SIGSEGV` outright, and it does not have to install first or last** — order does not
matter when there is nothing to displace. Measured directly: with the break loop's handler installed, deep OCaml
recursion still raises `Stack_overflow` normally, and a genuine fault at `0x10` reaches the break loop's handler with
`si_addr` correct. Chaining was implemented and compared; it is unnecessary here, but `harness5b.c` keeps it, because
it is what the merged build should do on any platform where the sweep comes back non-empty.
**The caveat, and it is the one thing in this report to re-check rather than trust:** this is `x86_64-pc-linux-gnu`
only. macOS/arm64 OCaml 5 was not testable here, and item 11 raises signals in the same breath as macOS. Re-run
`sig.sh` there before relying on it. `flan_agent.c` needs nothing from this either way — it sends with `MSG_NOSIGNAL`
throughout rather than depending on a SIGPIPE disposition.
### Question 4 — the GC and raw memory
Confirmed, and the confirmation is narrow on purpose. An 8 MiB arena was filled with a checkable pattern and 64 raw
interior pointers taken into it; OCaml then allocated 26.4 million words, took 7 major collections and a full
`Gc.compact ()`. Afterwards: the arena base is unmoved, **0 of 8,388,608 bytes altered**, 0 of 64 interior pointers
invalidated.
What that proves is that the collector traces its own roots and foreign memory is invisible to it. Arenas, `Vec`s and
`Map`s are safe because OCaml never learns they exist.
**What would break the assumption**, stated so it is not rediscovered the hard way:
1. Storing an OCaml `value` in Flan memory — an arena, a `Vec`, a global — across any allocation. The collector will
move the block and will not update that word, because it is not a root. `caml_register_global_root` (or the
generational one) is the only way that is legal, and it is a rule the merged design has to hold: **the boundary
passes pointers and scalars, never `value`s into Flan storage** — the same rule `dynload_stubs.c` already states
for its own reason.
2. A `value` held in a C local across a call that allocates, without `CAMLparam`/`CAMLlocal`. Ordinary OCaml-FFI
discipline; it applies to every stub the merge adds.
3. Long C work on the compiler thread without releasing the runtime system — which corrupts nothing but stalls
whichever domains want a stop-the-world. `llc` and `ld` are `exec`s and would want `caml_release_runtime_system`
around them.
### Question 5 — what it costs
| | bytes |
|---|---|
| `edn.flan`, release build | 71,824 |
| `edn.flan`, dev build, as built today | 114,296 |
| the same dev build with the whole compiler linked in | 4,257,624 |
| **what the compiler adds** | **~4.14 MB** |
**Startup: `caml_startup` takes 0.580.72 ms** across six runs — the runtime coming up and every module initialiser in
the compiler running. Measured with `clock_gettime` around the call itself, not `time(1)` on the process, because exec
and dynamic linking are paid today anyway.
The size reads as 37x, and that framing is misleading. **A dev session today runs two binaries, and the daemon alone is
4,815,368 bytes.** The merged dev build is *smaller than today's compiler process by itself*, and there is one of it
instead of two. Sub-millisecond startup and ~4 MB is not a cost worth designing around.
One more number, recorded because item 13's step 3 will want it and for no other reason: **a full in-process compile of
`edn.flan` — read, parse, load, typecheck, emit — is 12.112.5 ms**, warm and cold alike, with `llc` and `ld` excluded
because they are separate processes. That is where the remaining cost sits once transport is gone. It argues for
nothing; item 13 says the backend is decided at step 4 on a measurement taken at step 3, and this is not that
measurement.
### What this does not answer
- **The agent's handlers are a port, not a recompile.** `harness4.c` proves the *pattern* — a C-created listener
thread can register with the runtime and call OCaml. It does not port `flan_agent.c`'s handlers, which today answer
requests out of the program's own memory and would instead be calling into the compiler.
- **Crash isolation is gone by construction.** Not a finding; item 11 already accepts it knowingly. A bad pointer
through the FFI takes the session, and conditions still catch everything the *language* signals. Noted only so this
entry stands alone.
- **macOS, for signals and for the main-thread inversion.** See above.
- **The backend.** Untouched deliberately.
### The order the real work goes in
1. **Make the `-output-complete-obj` step a dune rule**, producing the compiler-as-object that a dev build links. This
is the only build-system work, and `lib/dune`/`bin/dune` did not need changing to prove it.
2. **Land the `dynload_stubs.c` branch** (`9e0ae3a`, currently reverted). The merged build needs the same
pointer-and-scalar boundary, and it is already written.
3. **Invert the startup**: the Flan program keeps `main()`, and `flan_agent_start` also brings up the OCaml runtime on
its side thread. `merged_main.c` is the sketch.
4. **Port the agent's handlers** from answering out of the program's memory to calling the compiler directly — this is
where the socket, the wire protocol, the 4K result cap, the seqlock, the snapshot copying, the generation stamping
and the render-thunk-per-inspection all get deleted. It is the bulk of the work and the whole of the prize.
5. **Keep `llc` + `ld` + `dlopen` exactly as they are.** Item 13's third option. Nothing here argues against it.
6. **Measure what is left.** Then, and only then, item 13 step 4.

14
spike/embed/.gitignore vendored Normal file
View File

@ -0,0 +1,14 @@
# Spike artifacts. run.sh rebuilds all of them from the sources beside it.
*.o
*.cmi
*.cmx
baseline
spike1
spike2
spike3
spike4
spike5
spike6
spike5b
spike5b_std
stubs5b.o

4
spike/embed/baseline.c Normal file
View File

@ -0,0 +1,4 @@
/* The floor: what a C binary with no OCaml in it weighs, so the delta the dev
build actually pays can be stated honestly. */
#include <stdio.h>
int main(void) { printf("baseline\n"); return 0; }

148
spike/embed/dynload_stubs.c Normal file
View File

@ -0,0 +1,148 @@
/* Loading a compiled macro into the compiler's own process.
*
* NEXT.md's expander design: there is no interpreter, so running a macro means
* compiling it and dlopening it. The reload primitive does exactly this
* already, but its host is a running Flan program written in C; here the host
* is the OCaml compiler, which has no dlopen of its own -- Dynlink loads
* OCaml, not ELF. So the boundary needs stubs, and this is all of them.
*
* Two rules shape what is here:
*
* - Nothing but pointers and scalars crosses. A Flan `string`/slice is
* {ptr,len} and a `Form` is {i32, [2 x i64]}, and LLVM's calling
* convention for an aggregate passed or returned *by value* in hand-written
* IR is not promised to be clang's C ABI for the equivalent struct. The
* unions lane verified memory layout, so memory is the agreement we have:
* every macro is reached through a thunk taking (ptr,i64,ptr,ptr) and
* writing its result through the out pointer.
*
* - The macro module is self-contained: it links the runtime in and has no
* undefined Flan symbols, so the OCaml executable needs no -rdynamic and
* nothing in it has to be exported.
*
* The peek/poke family is how the marshaller writes a Form image into memory
* the macro can read. OCaml cannot address raw memory, so the bytes are laid
* out from here one field at a time.
*/
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <dlfcn.h>
#include <stdlib.h>
#include <string.h>
#include <stdint.h>
CAMLprim value flan_dl_open(value path) {
CAMLparam1(path);
void *h = dlopen(String_val(path), RTLD_NOW | RTLD_LOCAL);
if (!h) caml_failwith(dlerror());
CAMLreturn(caml_copy_nativeint((intnat)h));
}
CAMLprim value flan_dl_sym(value handle, value name) {
CAMLparam2(handle, name);
void *p = dlsym((void *)Nativeint_val(handle), String_val(name));
if (!p) caml_failwith(dlerror());
CAMLreturn(caml_copy_nativeint((intnat)p));
}
CAMLprim value flan_dl_close(value handle) {
dlclose((void *)Nativeint_val(handle));
return Val_unit;
}
/* The one call shape a macro is reached through. See the thunk Emit writes. */
typedef void (*flan_macro_fn)(void *args, int64_t n, void *out, void *xfer);
CAMLprim value flan_macro_call(value fn, value args, value n, value out) {
CAMLparam4(fn, args, n, out);
/* The transfer channel every Flan signature carries (spec-conditions.md,
section 6). A macro that signals a condition with nothing above it to
handle it aborts inside the compiler, which is loud rather than silent;
the channel still has to be a real, zeroed slot. */
int64_t xfer[4] = { 0, 0, 0, 0 };
((flan_macro_fn)Nativeint_val(fn))((void *)Nativeint_val(args),
Int64_val(n),
(void *)Nativeint_val(out), xfer);
CAMLreturn(Val_unit);
}
CAMLprim value flan_mem_alloc(value n) {
CAMLparam1(n);
/* Zeroed, because ZII is the language's rule and an unwritten Form field
must read as the zero of its type rather than as whatever malloc had. */
void *p = calloc((size_t)Long_val(n), 1);
if (!p) caml_failwith("out of memory laying out a macro's arguments");
CAMLreturn(caml_copy_nativeint((intnat)p));
}
CAMLprim value flan_mem_free(value p) {
free((void *)Nativeint_val(p));
return Val_unit;
}
CAMLprim value flan_poke_i32(value p, value off, value x) {
int32_t v = (int32_t)Int32_val(x);
memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 4);
return Val_unit;
}
CAMLprim value flan_poke_i64(value p, value off, value x) {
int64_t v = Int64_val(x);
memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 8);
return Val_unit;
}
CAMLprim value flan_poke_f64(value p, value off, value x) {
double v = Double_val(x);
memcpy((char *)Nativeint_val(p) + Long_val(off), &v, 8);
return Val_unit;
}
CAMLprim value flan_poke_ptr(value p, value off, value q) {
void *v = (void *)Nativeint_val(q);
memcpy((char *)Nativeint_val(p) + Long_val(off), &v, sizeof v);
return Val_unit;
}
CAMLprim value flan_poke_bytes(value p, value off, value s) {
memcpy((char *)Nativeint_val(p) + Long_val(off), String_val(s),
caml_string_length(s));
return Val_unit;
}
CAMLprim value flan_peek_i32(value p, value off) {
int32_t v;
memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 4);
return caml_copy_int32(v);
}
CAMLprim value flan_peek_i64(value p, value off) {
int64_t v;
memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 8);
return caml_copy_int64(v);
}
CAMLprim value flan_peek_f64(value p, value off) {
double v;
memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), 8);
return caml_copy_double(v);
}
CAMLprim value flan_peek_ptr(value p, value off) {
void *v;
memcpy(&v, (char *)Nativeint_val(p) + Long_val(off), sizeof v);
return caml_copy_nativeint((intnat)v);
}
CAMLprim value flan_peek_bytes(value p, value off, value n) {
CAMLparam3(p, off, n);
CAMLlocal1(s);
s = caml_alloc_string((mlsize_t)Long_val(n));
memcpy((char *)Bytes_val(s), (char *)Nativeint_val(p) + Long_val(off),
(size_t)Long_val(n));
CAMLreturn(s);
}

21
spike/embed/gc_ml.ml Normal file
View File

@ -0,0 +1,21 @@
(* Step 6: the OCaml GC beside Flan's arenas.
Allocate hard, then compact -- the most disruptive thing the collector does,
since compaction is what actually moves blocks. C checks its arena after. *)
external note : nativeint -> unit = "spike_note_arena"
let () =
Callback.register "spike_churn" (fun (rounds : int) ->
let keep = ref [] in
for i = 1 to rounds do
(* Garbage, plus a little that survives, so the heap really grows. *)
for _ = 1 to 2000 do ignore (Bytes.create 512) done;
if i mod 10 = 0 then keep := Bytes.create 4096 :: !keep
done;
Gc.full_major ();
Gc.compact ();
let s = Gc.quick_stat () in
Printf.sprintf
"allocated %.0f words, %d major collections, %d compactions, heap %d words"
s.Gc.minor_words s.Gc.major_collections s.Gc.compactions s.Gc.heap_words);
ignore note

14
spike/embed/harness1.c Normal file
View File

@ -0,0 +1,14 @@
/* A C main() that owns the process and starts the OCaml runtime underneath it. */
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <stdio.h>
int main(int argc, char **argv) {
(void)argc;
caml_startup(argv);
const value *f = caml_named_value("spike_greet");
if (!f) { fprintf(stderr, "spike: greet not registered\n"); return 1; }
printf("%s\n", String_val(caml_callback(*f, Val_int(42))));
printf("spike: C main still owns the process\n");
return 0;
}

54
spike/embed/harness2.c Normal file
View File

@ -0,0 +1,54 @@
/* Step 2: the whole compiler inside a C binary, and what it costs to start.
*
* The startup number is measured around caml_startup itself, not with time(1)
* on the process -- what a merged dev build would pay is the runtime coming up
* and every module initialiser running, not exec and dynamic linking, which it
* pays today anyway. */
#include <caml/callback.h>
#include <caml/alloc.h>
#include <caml/mlvalues.h>
#include <stdio.h>
#include <time.h>
#ifndef FLANSRC
#define FLANSRC "test/programs/edn.flan"
#endif
static double ms_since(struct timespec a) {
struct timespec b;
clock_gettime(CLOCK_MONOTONIC, &b);
return (b.tv_sec - a.tv_sec) * 1e3 + (b.tv_nsec - a.tv_nsec) / 1e6;
}
static const value *need(const char *n) {
const value *f = caml_named_value(n);
if (!f) fprintf(stderr, "spike: %s not registered\n", n);
return f;
}
int main(int argc, char **argv) {
struct timespec t0;
const char *src = argc > 1 ? argv[1] : FLANSRC;
const value *f;
clock_gettime(CLOCK_MONOTONIC, &t0);
caml_startup(argv);
printf("caml_startup (runtime + every module initialiser): %.3f ms\n", ms_since(t0));
f = need("spike_footprint");
if (f) printf("linked-module footprint: %s\n", String_val(caml_callback(*f, Val_unit)));
f = need("spike_compile");
if (f) {
clock_gettime(CLOCK_MONOTONIC, &t0);
printf("%s\n", String_val(caml_callback(*f, caml_copy_string(src))));
printf("first in-process compile (read+parse+check+emit): %.3f ms\n", ms_since(t0));
clock_gettime(CLOCK_MONOTONIC, &t0);
caml_callback(*f, caml_copy_string(src));
printf("second, warm: %.3f ms\n", ms_since(t0));
}
printf("spike: C main() still owns the process\n");
return 0;
}

14
spike/embed/harness3.c Normal file
View File

@ -0,0 +1,14 @@
/* Step 3: does -output-complete-obj carry the project's C stubs through? */
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <stdio.h>
int main(int argc, char **argv) {
const value *f;
(void)argc;
caml_startup(argv);
f = caml_named_value("spike_stubs");
if (!f) { fprintf(stderr, "spike: stubs not registered\n"); return 1; }
printf("stubs reached from embedded runtime: %s\n", String_val(caml_callback(*f, Val_unit)));
return 0;
}

106
spike/embed/harness4.c Normal file
View File

@ -0,0 +1,106 @@
/* Step 4: the macOS shape, and the discriminating test of the whole spike.
*
* main() is the game: it takes the thread the window needs and runs a loop it
* never leaves until the compiler says stop. The OCaml runtime is started on a
* pthread that C spawned -- exactly where vendor/agent/flan_agent.c already
* puts its listener.
*
* Two separate claims get tested:
* a. caml_startup works on a non-main, C-created thread at all.
* b. a *different* C thread, one the runtime never created, can call into
* OCaml after caml_c_thread_register().
* (b) is the one that matters for the agent: its listener thread is spawned by
* flan_agent_start and would have to be able to reach the compiler.
*/
#include <caml/callback.h>
#include <caml/alloc.h>
#include <caml/mlvalues.h>
#include <caml/threads.h>
#include <pthread.h>
#include <stdatomic.h>
#include <stdio.h>
#include <string.h>
#include <time.h>
static char **g_argv;
static const char *g_src = "test/programs/edn.flan";
static atomic_int compiler_up = 0;
static atomic_int quit = 0;
static pthread_t main_tid;
static void nap(long ms) {
struct timespec t = { ms / 1000, (ms % 1000) * 1000000L };
nanosleep(&t, NULL);
}
static const value *need(const char *n) {
const value *f = caml_named_value(n);
if (!f) fprintf(stderr, "spike: %s not registered\n", n);
return f;
}
/* The compiler thread: starts the OCaml runtime off the main thread. */
static void *compiler_thread(void *unused) {
const value *f;
(void)unused;
printf(" [compiler thread] is main thread? %s\n",
pthread_equal(pthread_self(), main_tid) ? "YES (wrong)" : "no (correct)");
caml_startup(g_argv);
printf(" [compiler thread] caml_startup returned off the main thread\n");
f = need("spike_domains");
if (f) printf(" [compiler thread] %s\n", String_val(caml_callback(*f, Val_unit)));
f = need("spike_thread_compile");
if (f) printf(" [compiler thread] %s\n",
String_val(caml_callback(*f, caml_copy_string(g_src))));
/* Hand the runtime over so another C thread can borrow it, and prove the
main loop kept running throughout. */
atomic_store(&compiler_up, 1);
caml_release_runtime_system();
nap(300);
caml_acquire_runtime_system();
atomic_store(&quit, 1);
return NULL;
}
/* A second C thread, like the agent's listener: never created by OCaml. */
static void *listener_thread(void *unused) {
const value *f;
(void)unused;
while (!atomic_load(&compiler_up)) nap(5);
if (caml_c_thread_register() == 0) {
printf(" [listener thread] caml_c_thread_register FAILED\n");
return NULL;
}
caml_acquire_runtime_system();
f = need("spike_thread_compile");
if (f) printf(" [listener thread] %s\n",
String_val(caml_callback(*f, caml_copy_string(g_src))));
caml_release_runtime_system();
caml_c_thread_unregister();
printf(" [listener thread] registered, called OCaml, unregistered\n");
return NULL;
}
int main(int argc, char **argv) {
pthread_t comp, lst;
long frames = 0;
g_argv = argv;
if (argc > 1) g_src = argv[1];
main_tid = pthread_self();
if (pthread_create(&comp, NULL, compiler_thread, NULL) != 0) return 1;
if (pthread_create(&lst, NULL, listener_thread, NULL) != 0) return 1;
/* The game loop. This thread never calls into OCaml and never blocks on it --
it is the window's thread, and on macOS it has to be this one. */
while (!atomic_load(&quit)) { frames++; nap(1); }
pthread_join(comp, NULL);
pthread_join(lst, NULL);
printf(" [main thread] ran %ld frames without ever entering OCaml\n", frames);
printf("spike: the game kept the main thread\n");
return 0;
}

91
spike/embed/harness5.c Normal file
View File

@ -0,0 +1,91 @@
/* Step 5: who owns SIGSEGV.
*
* The OCaml runtime installs a SIGSEGV handler to turn a stack-guard-page hit
* into the Stack_overflow exception. The break loop wants SIGSEGV for the
* crash case. This is the one real collision, so it is measured in both
* directions:
*
* a. what the disposition is before caml_startup, and after it;
* b. whether a handler installed AFTER caml_startup actually receives a
* genuine fault in program memory -- i.e. whether the break loop can have
* what it wants by installing last.
*
* SIGPIPE is not probed: flan_agent.c sends with MSG_NOSIGNAL throughout and
* does not rely on a disposition.
*/
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <setjmp.h>
#include <signal.h>
#include <stdio.h>
#include <string.h>
static void describe(const char *when, int sig) {
struct sigaction old;
memset(&old, 0, sizeof old);
sigaction(sig, NULL, &old);
printf(" %-22s %-8s handler=%p flags=%#x %s%s\n", when,
sig == SIGSEGV ? "SIGSEGV" : sig == SIGINT ? "SIGINT" : "SIGFPE",
(old.sa_flags & SA_SIGINFO) ? (void *)old.sa_sigaction : (void *)old.sa_handler,
(unsigned)old.sa_flags,
(old.sa_flags & SA_ONSTACK) ? "ONSTACK " : "",
old.sa_handler == SIG_DFL ? "(SIG_DFL)"
: old.sa_handler == SIG_IGN ? "(SIG_IGN)" : "(custom)");
}
static sigjmp_buf escape;
static volatile sig_atomic_t ours_ran = 0;
static void our_segv(int sig, siginfo_t *info, void *ctx) {
(void)sig; (void)ctx;
ours_ran = 1;
/* What a break loop would do here is stop and serve; the spike just proves
the handler was reached, with the faulting address in hand. */
printf(" our SIGSEGV handler ran, fault address = %p\n", info->si_addr);
siglongjmp(escape, 1);
}
int main(int argc, char **argv) {
struct sigaction sa, ocaml_segv;
volatile int *bad = (int *)0x10;
(void)argc;
printf("before caml_startup:\n");
describe("before startup", SIGSEGV);
describe("before startup", SIGINT);
describe("before startup", SIGFPE);
caml_startup(argv);
printf("after caml_startup:\n");
describe("after startup", SIGSEGV);
describe("after startup", SIGINT);
describe("after startup", SIGFPE);
memset(&ocaml_segv, 0, sizeof ocaml_segv);
sigaction(SIGSEGV, NULL, &ocaml_segv);
/* Now install ours last, the way the break loop would. */
memset(&sa, 0, sizeof sa);
sa.sa_sigaction = our_segv;
sa.sa_flags = SA_SIGINFO | SA_ONSTACK;
sigemptyset(&sa.sa_mask);
sigaction(SIGSEGV, &sa, NULL);
printf("break loop installs last:\n");
describe("after break loop", SIGSEGV);
if (sigsetjmp(escape, 1) == 0) {
printf(" dereferencing %p ...\n", (void *)bad);
*bad = 1;
printf(" no fault -- UNEXPECTED\n");
} else {
printf(" recovered; a handler installed after caml_startup does receive "
"a real fault: %s\n", ours_ran ? "yes" : "no");
}
/* And the cost of taking it: OCaml's own handler is now displaced, so its
stack-overflow detection is gone unless ours chains to the saved one. */
printf(" OCaml's displaced SIGSEGV handler was %p -- chaining to it is what "
"keeps Stack_overflow working\n",
(void *)ocaml_segv.sa_sigaction);
return 0;
}

110
spike/embed/harness5b.c Normal file
View File

@ -0,0 +1,110 @@
/* Step 5b: the SIGSEGV question, asked properly.
*
* 5a read the disposition either side of caml_startup and found SIG_DFL both
* times, which would mean no collision at all. That is too good, and it is
* because OCaml 5 installs the handler per *domain*, on the domain's own
* thread, not once during startup. So this asks at four moments, and then asks
* the only question that decides anything: with the break loop holding SIGSEGV,
* does an OCaml stack overflow still raise Stack_overflow, or does it become a
* hard crash?
*
* Two ways of taking it are compared:
* take_segv -- install ours and discard OCaml's, the naive thing;
* chain_segv -- install ours, keep OCaml's, and forward to it.
*/
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <signal.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>
static struct sigaction ocaml_segv;
static int have_ocaml_segv = 0;
CAMLprim value spike_show_segv(value when) {
struct sigaction cur;
memset(&cur, 0, sizeof cur);
sigaction(SIGSEGV, NULL, &cur);
printf(" SIGSEGV %-46s handler=%p flags=%#x%s\n", String_val(when),
(cur.sa_flags & SA_SIGINFO) ? (void *)cur.sa_sigaction
: (void *)cur.sa_handler,
(unsigned)cur.sa_flags,
cur.sa_handler == SIG_DFL ? " (SIG_DFL)" : "");
fflush(stdout);
return Val_unit;
}
/* The break loop's handler. It does not long-jump here -- the point is only to
* see whether it is reached and whether OCaml still works around it. */
static void break_segv(int sig, siginfo_t *info, void *ctx) {
(void)sig;
if (have_ocaml_segv && ocaml_segv.sa_sigaction &&
ocaml_segv.sa_handler != SIG_DFL && ocaml_segv.sa_handler != SIG_IGN) {
/* Chained: hand the fault to OCaml, which turns a guard-page hit into
* Stack_overflow and re-raises anything else. */
ocaml_segv.sa_sigaction(sig, info, ctx);
return;
}
/* Taken outright: nothing below us. A real break loop would stop and serve;
* here we can only abort, which is the honest cost of discarding OCaml's. */
printf(" break loop caught SIGSEGV at %p with nothing to chain to\n",
info->si_addr);
fflush(stdout);
_exit(9);
}
static void install(int keep_old) {
struct sigaction sa;
memset(&sa, 0, sizeof sa);
memset(&ocaml_segv, 0, sizeof ocaml_segv);
sigaction(SIGSEGV, NULL, &ocaml_segv);
have_ocaml_segv = keep_old;
sa.sa_sigaction = break_segv;
sa.sa_flags = SA_SIGINFO | SA_ONSTACK | SA_NODEFER;
sigemptyset(&sa.sa_mask);
sigaction(SIGSEGV, &sa, NULL);
}
/* A sweep, so "the OCaml runtime installs handlers" can be stated as a list
* rather than a worry. Called from OCaml with the runtime and a domain up. */
CAMLprim value spike_sweep(value u) {
static const int sigs[] = { SIGSEGV, SIGBUS, SIGFPE, SIGILL, SIGINT, SIGTERM,
SIGPIPE, SIGCHLD, SIGUSR1, SIGUSR2, SIGABRT,
SIGALRM, SIGPROF, SIGVTALRM, SIGWINCH };
static const char *names[] = { "SEGV", "BUS", "FPE", "ILL", "INT", "TERM",
"PIPE", "CHLD", "USR1", "USR2", "ABRT",
"ALRM", "PROF", "VTALRM", "WINCH" };
struct sigaction c;
unsigned i;
(void)u;
for (i = 0; i < sizeof sigs / sizeof *sigs; i++) {
memset(&c, 0, sizeof c);
sigaction(sigs[i], NULL, &c);
if (c.sa_handler != SIG_DFL)
printf(" SIG%-8s %s\n", names[i],
c.sa_handler == SIG_IGN ? "SIG_IGN" : "custom handler");
}
printf(" (every signal not named above is SIG_DFL)\n");
fflush(stdout);
return Val_unit;
}
CAMLprim value spike_take_segv(value u) { (void)u; install(0); return Val_unit; }
CAMLprim value spike_chain_segv(value u) { (void)u; install(1); return Val_unit; }
#ifndef SPIKE_NO_MAIN
int main(int argc, char **argv) {
struct sigaction cur;
(void)argc;
memset(&cur, 0, sizeof cur);
sigaction(SIGSEGV, NULL, &cur);
printf(" SIGSEGV %-46s handler=%p%s\n", "before caml_startup",
(void *)cur.sa_handler, cur.sa_handler == SIG_DFL ? " (SIG_DFL)" : "");
/* Everything else runs from sig_ml.ml's module initialiser, so the readings
* happen on the runtime's own thread at the moments that matter. */
caml_startup(argv);
return 0;
}
#endif

61
spike/embed/harness6.c Normal file
View File

@ -0,0 +1,61 @@
/* Step 6: does OCaml's collector touch memory it does not own?
*
* Flan's arenas, Vecs and Maps are plain malloc'd memory. The claim is that
* OCaml never sees them, so a compaction cannot move or scribble on them. The
* probe: fill an arena with a checkable pattern, hold raw interior pointers
* into it across a full major collection AND a compaction, then verify every
* byte and every pointer.
*
* What this proves is narrow and worth stating narrowly: OCaml traces its own
* roots only. It does NOT license storing an OCaml `value` in this arena --
* that would need caml_register_global_root, and is the way the assumption
* actually breaks.
*/
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#define ARENA (8u << 20) /* 8 MiB, the shape of a Flan arena */
static uint8_t *arena;
static uint64_t *interior[64];
CAMLprim value spike_note_arena(value p) { (void)p; return Val_unit; }
static uint8_t pattern(size_t i) { return (uint8_t)(i * 31u + 7u); }
int main(int argc, char **argv) {
const value *f;
size_t i, bad = 0;
uint8_t *before;
(void)argc;
arena = malloc(ARENA);
if (!arena) return 1;
for (i = 0; i < ARENA; i++) arena[i] = pattern(i);
for (i = 0; i < 64; i++) interior[i] = (uint64_t *)(arena + i * 4096);
before = arena;
caml_startup(argv);
f = caml_named_value("spike_churn");
if (!f) { fprintf(stderr, "spike: churn not registered\n"); return 1; }
printf("%s\n", String_val(caml_callback(*f, Val_int(200))));
for (i = 0; i < ARENA; i++) if (arena[i] != pattern(i)) bad++;
printf("arena base %s (%p -> %p)\n", before == arena ? "unmoved" : "MOVED",
(void *)before, (void *)arena);
printf("arena bytes altered by the GC: %zu of %u\n", bad, ARENA);
bad = 0;
for (i = 0; i < 64; i++)
if (interior[i] != (uint64_t *)(arena + i * 4096)) bad++;
printf("raw interior pointers invalidated: %zu of 64\n", bad);
printf("spike: %s\n", bad == 0 ? "foreign memory is invisible to the collector"
: "FOREIGN MEMORY WAS DISTURBED");
free(arena);
return 0;
}

5
spike/embed/hello_ml.ml Normal file
View File

@ -0,0 +1,5 @@
(* Step 1: the smallest thing that proves OCaml code can be reached from a C
[main]. One function, registered by name, called back from C. *)
let () =
Callback.register "spike_greet" (fun (n : int) ->
Printf.sprintf "ocaml saw %d, unix says pid %d" n (Unix.getpid ()))

66
spike/embed/merged.sh Normal file
View File

@ -0,0 +1,66 @@
#!/usr/bin/env bash
# Step 8: the thing the whole spike is really asking about -- ONE binary that
# is both a compiled Flan program and the OCaml compiler, with clang doing the
# final link.
#
# Everything before this proved a piece. This proves the shape: the Flan
# program's own main() is renamed out of the way, a C main() takes the main
# thread and runs the program there, and caml_startup happens on a side thread
# beside it. That is exactly item 11's inversion, built for real.
#
# It is NOT the merged architecture -- nothing is wired up, the compiler and the
# program do not talk. It is a link and a size and a startup number.
set -u
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
src=${1:-test/programs/edn.flan}
cd "$root" || exit 1
out=$(mktemp -d); trap 'rm -rf "$out"' EXIT
FLAN=_build/default/bin/main.exe
OCAMLLIB=$(ocamlopt -where)
SYSLIBS="-lm -lpthread -ldl -lzstd"
echo "program: $src"
# 1. The Flan program, as it is built today, for the baseline sizes.
"$FLAN" build "$src" -o "$out/rel" || exit 1
"$FLAN" build "$src" --dev -o "$out/dev" || exit 1
# 2. The same program as an object, with its main renamed so a C main can own
# the process. Emit writes @main literally; sed is enough to move it.
"$FLAN" emit "$src" --dev > "$out/prog.ll" || exit 1
sed -i 's/define i32 @main(/define i32 @flan_program_main(/' "$out/prog.ll"
grep -q 'define i32 @flan_program_main(' "$out/prog.ll" || {
echo "could not find @main in the emitted IR -- adjust the rename"; exit 1; }
clang -c -x ir "$out/prog.ll" -o "$out/prog.o" || exit 1
# 3. The runtime the program needs, and the agent beside it.
clang -c -O2 runtime/flan_rt.c -o "$out/rt.o" || exit 1
clang -c -O2 runtime/flan_dev.c -o "$out/dev.o" || exit 1
clang -c -O2 vendor/agent/flan_agent.c -o "$out/ag.o" || exit 1
# 4. The whole OCaml compiler as one object.
ocamlfind ocamlopt -thread -package unix,threads.posix -linkpkg \
-output-complete-obj \
-I "$root/_build/default/lib/.flan.objs/byte" \
-I "$root/_build/default/lib/.flan.objs/native" \
-o "$out/compiler.o" "$root/_build/default/lib/flan.cmxa" \
"$here/thread_ml.ml" || exit 1
# 5. One link. clang, as the project already does it.
clang -I"$OCAMLLIB" "$here/merged_main.c" "$out/prog.o" "$out/rt.o" "$out/dev.o" \
"$out/ag.o" "$out/compiler.o" -o "$out/merged" $SYSLIBS || exit 1
echo
echo "sizes:"
for f in rel dev merged; do
printf ' %-30s %9d bytes\n' "$f" "$(stat -c%s "$out/$f")"
done
printf ' %-30s %9d bytes\n' "what the compiler adds to a dev build" \
"$(( $(stat -c%s "$out/merged") - $(stat -c%s "$out/dev") ))"
echo
echo "running the merged binary:"
"$out/merged" "$src"
echo "exit: $?"

77
spike/embed/merged_main.c Normal file
View File

@ -0,0 +1,77 @@
/* One process: the Flan program on the main thread, the OCaml compiler beside
* it on a domain of its own.
*
* This is the shape item 11 settles on, and the reason it is written this way
* round rather than the other: on macOS the window has to be on the main
* thread, so the game keeps main() and the compiler moves to the side --
* beside the listener vendor/agent/flan_agent.c already starts there.
*
* The program and the compiler do not talk to each other here. Wiring them up
* is the real work; this only shows they can share an address space, a link,
* and a process, with clang doing the final link. */
#include <caml/callback.h>
#include <caml/alloc.h>
#include <caml/mlvalues.h>
#include <caml/threads.h>
#include <pthread.h>
#include <stdatomic.h>
#include <stdio.h>
#include <time.h>
/* The Flan program's entry point, renamed out of main's way by merged.sh. */
extern int flan_program_main(int argc, char **argv);
static char **g_argv;
static const char *g_src;
/* The Flan program's main calls exit(), so the compiler has to be up before it
* starts -- which is the honest ordering anyway: the image comes up and serves,
* then the program runs, the way starting an SBCL image does. */
static atomic_int compiler_ready = 0;
static double ms_since(struct timespec a) {
struct timespec b;
clock_gettime(CLOCK_MONOTONIC, &b);
return (b.tv_sec - a.tv_sec) * 1e3 + (b.tv_nsec - a.tv_nsec) / 1e6;
}
static void *compiler_side(void *unused) {
struct timespec t0;
const value *f;
(void)unused;
clock_gettime(CLOCK_MONOTONIC, &t0);
caml_startup(g_argv);
printf("[compiler] up on a side thread in %.3f ms\n", ms_since(t0));
f = caml_named_value("spike_thread_compile");
if (f) {
clock_gettime(CLOCK_MONOTONIC, &t0);
printf("[compiler] %s\n", String_val(caml_callback(*f, caml_copy_string(g_src))));
printf("[compiler] compiled the running program from inside it, in %.3f ms\n",
ms_since(t0));
}
caml_release_runtime_system();
atomic_store(&compiler_ready, 1);
return NULL;
}
int main(int argc, char **argv) {
pthread_t comp;
int rc;
g_argv = argv;
g_src = argc > 1 ? argv[1] : "test/programs/edn.flan";
if (pthread_create(&comp, NULL, compiler_side, NULL) != 0) return 1;
while (!atomic_load(&compiler_ready)) {
struct timespec t = { 0, 2000000L };
nanosleep(&t, NULL);
}
/* The main thread is the program's, and it never enters OCaml. */
printf("[program] running on the main thread\n");
rc = flan_program_main(argc, argv);
printf("[program] returned %d\n", rc);
pthread_join(comp, NULL);
printf("one process: a Flan program and the OCaml compiler, same binary\n");
return 0;
}

76
spike/embed/run.sh Normal file
View File

@ -0,0 +1,76 @@
#!/usr/bin/env bash
# Spike: what it costs to link the OCaml compiler into a native Flan dev build.
#
# Deliberately NOT a dune target. The root `dune` only excludes old-ocaml/, so a
# dune file here would land in @default and make the spike part of the build.
# Instead this drives ocamlfind and clang by hand, against the flan.cmxa that
# dune already produces. Run it from anywhere: bash spike/embed/run.sh
set -u
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$here" || exit 1
OCAMLLIB=$(ocamlopt -where)
CAMLINC="-I$OCAMLLIB"
# OCaml 5.2's marshaller is compressed, so -output-complete-obj pulls in zstd.
SYSLIBS="-lm -lpthread -ldl -lzstd"
step() { printf '\n=== %s ===\n' "$1"; }
# ---------------------------------------------------------------- 1. smallest
step "1. smallest link: C main() -> caml_startup -> OCaml callback"
ocamlfind ocamlopt -package unix -linkpkg -output-complete-obj \
-o embed1.o hello_ml.ml || exit 1
clang $CAMLINC harness1.c embed1.o -o spike1 $SYSLIBS || exit 1
./spike1 || echo "spike1 FAILED"
ls -l spike1 | awk '{print "spike1 size: " $5 " bytes"}'
# ------------------------------------------------------- 2. the real compiler
step "2. link the whole flan compiler (flan.cmxa) into a C binary"
CMXA="$root/_build/default/lib/flan.cmxa"
if [ ! -f "$CMXA" ]; then
echo "no $CMXA -- run 'dune build --root .' first"; exit 1
fi
ocamlfind ocamlopt -package unix -linkpkg -output-complete-obj \
-I "$root/_build/default/lib/.flan.objs/byte" \
-I "$root/_build/default/lib/.flan.objs/native" \
-o embed2.o "$CMXA" whole_ml.ml || exit 1
clang $CAMLINC harness2.c embed2.o -o spike2 $SYSLIBS || exit 1
(cd "$root" && "$here/spike2" test/programs/edn.flan) || echo "spike2 FAILED"
ls -l spike2 | awk '{print "spike2 size: " $5 " bytes"}'
ls -l "$root/_build/default/bin/main.exe" | awk '{print "main.exe size: " $5 " bytes"}'
clang $CAMLINC baseline.c -o baseline
ls -l baseline | awk '{print "bare C baseline: " $5 " bytes"}'
# ------------------------------------------------------------- 3. with stubs
step "3. the same, with the project's own C stubs compiled in"
ocamlfind ocamlopt -package unix -linkpkg -output-complete-obj \
-I "$root/_build/default/lib/.flan.objs/byte" \
-I "$root/_build/default/lib/.flan.objs/native" \
-o embed3.o "$CMXA" stubs_ml.ml dynload_stubs.c || exit 1
clang $CAMLINC harness3.c embed3.o -o spike3 $SYSLIBS || exit 1
./spike3 || echo "spike3 FAILED"
# ------------------------------------------ 4. threads: game owns main thread
step "4. threads: C main runs the 'game loop', OCaml starts on another thread"
ocamlfind ocamlopt -thread -package unix,threads.posix -linkpkg -output-complete-obj \
-I "$root/_build/default/lib/.flan.objs/byte" \
-I "$root/_build/default/lib/.flan.objs/native" \
-o embed4.o "$CMXA" thread_ml.ml || exit 1
clang $CAMLINC harness4.c embed4.o -o spike4 $SYSLIBS || exit 1
(cd "$root" && "$here/spike4" test/programs/edn.flan) || echo "spike4 FAILED"
# ------------------------------------------------------------ 5. signals
step "5. signals: who owns SIGSEGV across caml_startup"
clang $CAMLINC harness5.c embed2.o -o spike5 $SYSLIBS || exit 1
./spike5 || echo "spike5 exited nonzero"
# ------------------------------------------------------- 6. GC vs raw memory
step "6. GC: does a compaction move or touch a C-owned arena"
ocamlfind ocamlopt -package unix -linkpkg -output-complete-obj \
-o embed6.o gc_ml.ml || exit 1
clang $CAMLINC harness6.c embed6.o -o spike6 $SYSLIBS || exit 1
./spike6 || echo "spike6 FAILED"
printf '\nspike: done\n'

23
spike/embed/sig.sh Normal file
View File

@ -0,0 +1,23 @@
#!/usr/bin/env bash
# Step 5b on its own: the SIGSEGV question, embedded and standalone side by
# side. The standalone build is the control -- if OCaml behaves the same in a
# plain ocamlopt executable, then embedding changed nothing about signals.
set -u
here=$(cd "$(dirname "$0")" && pwd)
cd "$here" || exit 1
OCAMLLIB=$(ocamlopt -where)
SYSLIBS="-lm -lpthread -ldl -lzstd"
echo "=== 5b-embedded: caml_startup called from a C main() ==="
ocamlfind ocamlopt -package unix -linkpkg -output-complete-obj \
-o embed5b.o sig_ml.ml || exit 1
clang -I"$OCAMLLIB" harness5b.c embed5b.o -o spike5b $SYSLIBS || exit 1
./spike5b; echo "exit: $?"
echo
echo "=== 5b-standalone: the same OCaml, as a plain ocamlopt executable ==="
# The control. Same stubs, but OCaml owns main().
clang -c -I"$OCAMLLIB" -DSPIKE_NO_MAIN harness5b.c -o stubs5b.o || exit 1
ocamlfind ocamlopt -package unix -linkpkg -o spike5b_std sig_ml.ml stubs5b.o \
-cclib -lzstd || exit 1
./spike5b_std; echo "exit: $?"

34
spike/embed/sig_ml.ml Normal file
View File

@ -0,0 +1,34 @@
(* Step 5b: OCaml 5.2 installs its SIGSEGV handler per-domain, not once at
startup, so "read the disposition after caml_startup" is not the whole
question. This asks it at four moments, and then asks the thing that
actually matters: does Stack_overflow still get raised once the break loop
has taken SIGSEGV? *)
external show : string -> unit = "spike_show_segv"
external take_segv : unit -> unit = "spike_take_segv"
external chain_segv : unit -> unit = "spike_chain_segv"
external sweep : unit -> unit = "spike_sweep"
let rec deep n = if n <= 0 then 0 else 1 + deep (n - 1) + (if n < 0 then deep n else 0)
let overflow_result () =
try
let n = deep 100_000_000 in
Printf.sprintf "returned %d (no overflow)" n
with Stack_overflow -> "Stack_overflow raised"
let () =
show "at module init (main domain up)";
let d = Domain.spawn (fun () -> show "inside a spawned domain") in
Domain.join d;
show "after Domain.join";
print_endline "every signal the OCaml runtime is holding:";
sweep ();
Printf.sprintf "before touching SIGSEGV: %s" (overflow_result ()) |> print_endline;
take_segv ();
show "after the break loop takes SIGSEGV outright";
Printf.sprintf "with SIGSEGV taken outright: %s" (overflow_result ())
|> print_endline;
chain_segv ();
show "after the break loop chains to OCaml's handler";
Printf.sprintf "with SIGSEGV chained: %s" (overflow_result ()) |> print_endline

26
spike/embed/stubs_ml.ml Normal file
View File

@ -0,0 +1,26 @@
(* Step 3: the project's own C stubs, in the same link as the compiler.
lib/dynload_stubs.c is taken verbatim from 9e0ae3a (the unmerged dlopen
branch) -- it is the only C the compiler itself is built from, and it is the
case that -output-complete-obj has to carry through. *)
external dl_open : string -> nativeint = "flan_dl_open"
external dl_sym : nativeint -> string -> nativeint = "flan_dl_sym"
external mem_alloc : int -> nativeint = "flan_mem_alloc"
external mem_free : nativeint -> unit = "flan_mem_free"
external poke_i64 : nativeint -> int -> int64 -> unit = "flan_poke_i64"
external peek_i64 : nativeint -> int -> int64 = "flan_peek_i64"
let () =
Callback.register "spike_stubs" (fun () ->
(* peek/poke: the raw memory the marshaller lays a Form image out in. *)
let p = mem_alloc 64 in
poke_i64 p 8 0xfeedfacedeadbeefL;
let got = peek_i64 p 8 in
mem_free p;
(* dlopen from inside the embedded runtime, on the process's own image. *)
let h = dl_open "libm.so.6" in
let s = dl_sym h "sqrt" in
Printf.sprintf "peek/poke %s; dlopen+dlsym %s"
(if got = 0xfeedfacedeadbeefL then "ok" else "WRONG")
(if s <> 0n then "ok" else "WRONG"));
ignore dl_open

50
spike/embed/symbols.sh Normal file
View File

@ -0,0 +1,50 @@
#!/usr/bin/env bash
# Step 7: the integration hazard nobody asks about until the link fails.
#
# Today runtime/flan_rt.c, runtime/flan_dev.c and vendor/agent/flan_agent.c are
# compiled into the *program*, and lib/dynload_stubs.c into the *compiler*.
# Merging the processes puts all four and the OCaml runtime in one link. This
# checks, symbol by symbol, whether anything collides.
set -u
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
out=$(mktemp -d)
trap 'rm -rf "$out"' EXIT
cd "$root" || exit 1
defs() { nm --defined-only "$@" 2>/dev/null | awk 'NF==3 {print $3}' | sort -u; }
clang -c runtime/flan_rt.c -o "$out/rt.o" || exit 1
clang -c runtime/flan_dev.c -o "$out/dev.o" || exit 1
clang -c vendor/agent/flan_agent.c -o "$out/ag.o" || exit 1
clang -c -I"$(ocamlopt -where)" "$here/dynload_stubs.c" -o "$out/dl.o" || exit 1
defs "$out/rt.o" "$out/dev.o" "$out/ag.o" "$out/dl.o" > "$out/flan.syms"
defs /home/joe/.opam/default/lib/ocaml/libasmrun.a > "$out/ml.syms" 2>/dev/null
[ -s "$out/ml.syms" ] || defs "$(ocamlopt -where)/libasmrun.a" > "$out/ml.syms"
echo "Flan's own C defines $(wc -l < "$out/flan.syms") symbols;" \
"libasmrun defines $(wc -l < "$out/ml.syms")."
echo "collisions between Flan's C and the OCaml runtime:"
if comm -12 "$out/flan.syms" "$out/ml.syms" | grep . ; then
echo " ^^ those would have to be renamed"
else
echo " none"
fi
echo "collisions among Flan's own four .c files:"
for a in rt dev ag dl; do defs "$out/$a.o" > "$out/$a.syms"; done
found=0
for a in rt dev ag dl; do
for b in rt dev ag dl; do
[ "$a" \< "$b" ] || continue
c=$(comm -12 "$out/$a.syms" "$out/$b.syms")
[ -n "$c" ] && { echo " $a vs $b:"; echo "$c" | sed 's/^/ /'; found=1; }
done
done
[ $found -eq 0 ] && echo " none"
echo "what Flan's C needs that the OCaml runtime also exports (shared libc etc):"
nm --undefined-only "$out/rt.o" "$out/ag.o" 2>/dev/null | awk 'NF==2{print $2}' \
| sort -u > "$out/need.syms"
comm -12 "$out/need.syms" "$out/ml.syms" | sed 's/^/ /' | head -20

32
spike/embed/thread_ml.ml Normal file
View File

@ -0,0 +1,32 @@
(* Step 4: the macOS shape. The game owns the main thread; the compiler and the
listener run beside it.
The question is NOT "can OCaml use threads" -- it is whether caml_startup can
be called from a pthread that C spawned, while main() goes on to run a
window loop it never returns from. That is the inversion item 11 settles on,
and it is the one that has to be measured rather than assumed. *)
let compile file =
let l = Flan.Load.program ~file (Flan.Parse.program (Flan.Reader.read_file file)) in
let p = Flan.Check.program l.Flan.Load.decls in
String.length (Flan.Emit.program ~dev:true p)
let () =
Callback.register "spike_thread_compile" (fun (file : string) ->
let tid = Thread.id (Thread.self ()) in
match compile file with
| n ->
Printf.sprintf "compiled on OCaml thread %d: %d bytes of LLVM IR" tid n
| exception e -> Printf.sprintf "FAILED: %s" (Printexc.to_string e));
Callback.register "spike_domains" (fun () ->
(* A second domain doing real work while the main thread is elsewhere --
5.2's multicore runtime, which is the objection item 12 says has gone
away. Confirmed rather than assumed. *)
let d = Domain.spawn (fun () ->
let s = ref 0 in
for i = 1 to 5_000_000 do s := !s + i done;
(Domain.self () :> int), !s)
in
let id, s = Domain.join d in
Printf.sprintf "domain %d summed to %d; recommended_domain_count = %d"
id s (Domain.recommended_domain_count ()))

40
spike/embed/whole_ml.ml Normal file
View File

@ -0,0 +1,40 @@
(* Step 2: reach enough of the compiler that the linker cannot drop it, and do
real compiler work in-process so the measurement is of a working compiler
rather than of dead code that happened to link.
The work is the driver's own path, the one bin/main.ml takes:
read -> Parse.program -> Load.program -> Check.program -> Emit.program. That
is the whole front end and the whole back end short of [llc]. Check.program
prepends the prelude itself, so the prelude is in the measurement without
being fed in twice. *)
let compile file =
let l = Flan.Load.program ~file (Flan.Parse.program (Flan.Reader.read_file file)) in
let p = Flan.Check.program l.Flan.Load.decls in
let ir = Flan.Emit.program ~dev:true p in
(List.length l.Flan.Load.decls, String.length ir)
(* Touched only so the linker keeps the modules a merged dev build would carry.
Nothing here is called for its effect. *)
let footprint () =
String.concat ","
[ Flan.Build.clang;
string_of_int (String.length Flan.Shim.header);
string_of_int (String.length Flan.Runtime_src.source);
string_of_int (String.length Flan.Runtime_src.dev_source);
string_of_int (List.length Flan.Session.externs);
string_of_int (Flan.Render.max_span);
string_of_int (String.length (Flan.Wire.ints [ 1; 2 ])) ]
let () =
Callback.register "spike_compile" (fun (file : string) ->
match compile file with
| d, n -> Printf.sprintf "%s: %d decls, %d bytes of LLVM IR" file d n
| exception e -> Printf.sprintf "FAILED: %s" (Printexc.to_string e));
Callback.register "spike_footprint" footprint;
(* Dev.start and Cimport are never run here, but naming them keeps the socket
server and the C importer in the link -- a dev build pays for them. *)
Callback.register "spike_unused" (fun () ->
ignore (Flan.Dev.start : ?debug:bool -> file:string -> sock:string -> unit -> unit);
ignore (Flan.Cimport.decl_source : Flan.Ast.decl -> string);
"ok")