Six probes for whether the OCaml compiler can live in the game's process
Item 12 asks five questions and says to answer them with a spike rather than a rewrite. spike/embed/ is that spike: one script, six binaries, each one built to fail loudly at the thing it is asking about. It is 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. It drives ocamlfind and clang by hand against the flan.cmxa dune already produces. The probes, in the order they would kill the idea: the smallest possible link, a C main() reaching one OCaml function; the whole compiler linked in and doing real work; the same again with lib/dynload_stubs.c from the unmerged dlopen branch, because that is the only C the compiler itself is built from; the game keeping the main thread while caml_startup happens on a pthread beside it; the SIGSEGV disposition read on both sides of caml_startup; and an 8 MiB arena checked byte for byte across a compaction. No result is written down yet. This is the apparatus.
This commit is contained in:
parent
4ea089839c
commit
d272a5b1e5
11
spike/embed/.gitignore
vendored
Normal file
11
spike/embed/.gitignore
vendored
Normal file
@ -0,0 +1,11 @@
|
||||
# Spike artifacts. run.sh rebuilds all of them from the sources beside it.
|
||||
*.o
|
||||
*.cmi
|
||||
*.cmx
|
||||
baseline
|
||||
spike1
|
||||
spike2
|
||||
spike3
|
||||
spike4
|
||||
spike5
|
||||
spike6
|
||||
4
spike/embed/baseline.c
Normal file
4
spike/embed/baseline.c
Normal 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
148
spike/embed/dynload_stubs.c
Normal 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
21
spike/embed/gc_ml.ml
Normal 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
14
spike/embed/harness1.c
Normal 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
54
spike/embed/harness2.c
Normal 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
14
spike/embed/harness3.c
Normal 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
106
spike/embed/harness4.c
Normal 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
91
spike/embed/harness5.c
Normal 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;
|
||||
}
|
||||
61
spike/embed/harness6.c
Normal file
61
spike/embed/harness6.c
Normal 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
5
spike/embed/hello_ml.ml
Normal 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 ()))
|
||||
76
spike/embed/run.sh
Normal file
76
spike/embed/run.sh
Normal 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'
|
||||
26
spike/embed/stubs_ml.ml
Normal file
26
spike/embed/stubs_ml.ml
Normal 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
|
||||
32
spike/embed/thread_ml.ml
Normal file
32
spike/embed/thread_ml.ml
Normal 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
40
spike/embed/whole_ml.ml
Normal 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")
|
||||
Loading…
x
Reference in New Issue
Block a user