The compiler links into the program, and the objection we feared does not exist
This commit is contained in:
commit
2b0cd9b9b4
161
DISCUSS.md
161
DISCUSS.md
@ -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.58–0.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.1–12.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
14
spike/embed/.gitignore
vendored
Normal 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
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;
|
||||
}
|
||||
110
spike/embed/harness5b.c
Normal file
110
spike/embed/harness5b.c
Normal 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
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 ()))
|
||||
66
spike/embed/merged.sh
Normal file
66
spike/embed/merged.sh
Normal 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
77
spike/embed/merged_main.c
Normal 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
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'
|
||||
23
spike/embed/sig.sh
Normal file
23
spike/embed/sig.sh
Normal 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
34
spike/embed/sig_ml.ml
Normal 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
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
|
||||
50
spike/embed/symbols.sh
Normal file
50
spike/embed/symbols.sh
Normal 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
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