JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'worktree-agent-aaf84e55296df121c' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-14 10:52:13 +07:00
commit e7bb643d9d
8 changed files with 963 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
bin/main.ml
View File

@ -23,6 +23,14 @@ let with_errors path f =
prerr_endline ("x86: " ^ m);
ignore path;
exit 3
(* A refusal with no location: a combination of flags this command does not
offer, or a build step that failed. Every [failwith] this binary can reach
is one of those, and a sentence is what a user can act on where an
uncaught OCaml exception and its backtrace are not. *)
| Failure m ->
prerr_endline ("flan: " ^ m);
ignore path;
exit 1
let summarise (d : Flan.Ast.decl) =
let open Flan.Ast in
@ -485,6 +493,15 @@ let () =
each redefinition module to still be firing after C-c C-c. It implies
-O0 on both, so it is asked for rather than assumed. *)
let debug = List.mem debug_flag rest in
(* One flag for both halves of the session, which is what makes it safe at
all: the host and every module this daemon sends are compiled by the
same backend, because there is one place that says which. The two
conventions agree on every scalar and disagree on every aggregate, so a
crossed pair is correct until the first redefined function takes or
returns a struct — and [flan.abi.x86] refuses that pair at [dlopen] if
this is ever got wrong. Off by default: LLVM stays the default path
here exactly as it is for [flan build]. *)
let x86 = List.mem x86_flag rest in
let merged = not (List.mem two_process_flag rest) in
let rest = List.filter (fun a -> not (is_flag a)) rest in
let sock =
@ -493,10 +510,12 @@ let () =
| [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock"
| _ ->
prerr_endline
"usage: flan dev <program.flan> [-s socket] [--debug] [--two-process]";
"usage: flan dev <program.flan> [-s socket] [--debug] [--x86] \
[--two-process]";
exit 2
in
with_errors path (fun () -> Flan.Dev.start ~debug ~merged ~file:path ~sock ())
with_errors path (fun () ->
Flan.Dev.start ~debug ~merged ~x86 ~file:path ~sock ())
(* One redefinition, built the way an editor will ask for it: a session over
the program the process was built from, and a file of the forms that
@ -505,6 +524,12 @@ let () =
given only a list of function names could. *)
| _ :: "reload" :: prog :: forms :: rest ->
let debug = List.mem debug_flag rest in
(* The same flag, for the same reason, and it had to arrive with [flan
dev]'s: a command that could build a module for a host the other backend
compiled is how the crossed pair was reachable from the CLI at all.
Building an --x86 host with [flan build --x86 --dev] and then reloading
into it now has a spelling that produces a module it can load. *)
let x86 = List.mem x86_flag rest in
let rest = List.filter (fun a -> not (is_flag a)) rest in
let out =
match rest with
@ -512,17 +537,25 @@ let () =
| [] -> Filename.remove_extension (Filename.basename forms) ^ ".so"
| _ ->
prerr_endline
"usage: flan reload <program.flan> <forms.flan> [-o out.so] [--debug]";
"usage: flan reload <program.flan> <forms.flan> [-o out.so] \
[--debug] [--x86]";
exit 2
in
with_errors forms (fun () ->
let t, _ = Flan.Session.create ~debug ~file:prog () in
let t, _ = Flan.Session.create ~debug ~x86 ~file:prog () in
let src = In_channel.with_open_bin forms In_channel.input_all in
let c = Flan.Session.eval ~origin:forms t src in
let opts = { Flan.Build.default with dev = true; debug } in
let timing = Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out () in
Printf.eprintf "%s %s llc %.1fms ld %.1fms\n" out
(String.concat " " c.Flan.Session.fns) timing.Flan.Build.llc_ms
let opts = { Flan.Build.default with dev = true; debug; x86 } in
let timing =
if c.Flan.Session.x86 then
Flan.Build.shared_x86 ~opts ~asm:c.Flan.Session.ir ~out ()
else Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out ()
in
(* [as] where the other path has [llc], which is the number the whole
backend exists to move. Named for what ran. *)
Printf.eprintf "%s %s %s %.1fms ld %.1fms\n" out
(String.concat " " c.Flan.Session.fns)
(if x86 then "as " else "llc") timing.Flan.Build.llc_ms
timing.Flan.Build.link_ms)
(* [run] builds and execs. A .wasm is not executable, and picking a runtime
for it is a decision this command has no business making, so a cross
@ -555,6 +588,6 @@ let () =
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
[--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\
\ flan run <file.flan> [args...]\n\
\ flan reload <program.flan> <forms.flan> [-o out.so]\n\
\ flan dev <program.flan> [-s socket]";
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
\ flan dev <program.flan> [-s socket] [--x86]";
exit 2

253
docs/handoffs/HANDOFF-x86-devloop.md Normal file
View File

@ -0,0 +1,253 @@
# Handoff — the x86 backend, wired to the dev loop
Branch `dev-loop`, worktree `agent-aaf84e55296df121c`, from `f459352`. Items 1, 2 and 3 of
`HANDOFF-x86-redef.md`'s "What remains": the new-name path, the transient thunk, and the wiring that lets
`flan dev` choose the backend for a host and its modules together.
**All three landed, and the numbers say the lane was worth it.** A `C-c C-c` round trip through a real daemon
is **62–66ms on LLVM and 27–30ms on `--x86`** on this machine; `C-x C-e` is **60ms and 24ms**. The build inside
those is **53ms and 17–18ms**. Details and caveats in §Measured.
There is one finding that is not good news and it is in §The merged daemon: `flan dev --x86` refuses the
*merged* daemon and needs `--two-process`, because the compiler's macro module is a third way the two backends
can meet in one process and `flan.abi.x86` does not guard it.
## What was built
| file | what |
|---|---|
| `lib/x86.ml` — `loc`'s new `Lslot`, `fnctx.slot` | a name the host was never built with: the address lives in a module-local slot the installer fills by string. `Lgot`'s shape with `Sym` where it has `Got` |
| `lib/x86.ml` — `redefinition`'s installer | `flan_dev_cell` / `flan_dev_global` lookups, an init image per new global, the `consts` republish, and a real frame so those calls are made on an aligned stack |
| `lib/x86.ml` — `flan_reload_call`, `flan_reload_transient` | what an expression evaluation compiles to, and the claim the agent unloads on |
| `lib/x86.ml` — `string_const` | now bumps `Emit.m.nstr`, which is the third transient condition |
| `lib/session.ml` — `t.x86`, `change.x86`, `redefinition` | the backend choice, as a session setting, made in one place |
| `lib/dev.ml` — `build_module`, `module_ext`, `Dev.start ?x86` | the daemon picking builder and extension off the change, and the two refusals |
| `lib/dev.ml` — `rename_program_main_asm`, `merged_executable`'s fork | an `--x86` merged host, which builds and is currently refused (see below) |
| `bin/main.ml` | `flan dev --x86`, `flan reload --x86`, and a bare `Failure` printed as a sentence |
| `test/programs/reload-v6.flan` | a run-time-new global with a value of its own |
| `test/test_reload.ml` | the x86 section runs all four modules against the LLVM transcript; the refusal it asserted is gone |
| `test/test_dev.ml` | an `--x86` daemon driven through `C-c C-c`, `C-x C-e`, a literal, a new `defvar` and a new `defn`; plus the merged refusal |
## 1. The new-name path
A function or a `defvar` the running process has no symbol for. ELF cannot grow one, so the address is asked
for by string at install time and parked in a slot this module defines — `flan.cellp.<n>` for a function's
cell, `flan.gp.<n>` for a global's storage, spelled as `Emit.cellptr` and `Emit.globalptr` spell them so the
two sides read against each other.
The reference side is **one new `loc` case and nothing else**. `Lslot` loads the slot and answers
`Reg (scratch, d)`, which is exactly what `Lgot` already did with `Got` where this has `Sym`. Every site that
reaches a cell already double-loads, so no call site, no place expression and no `sym_loc` caller had to learn
a third case. `fnctx.slot` is a *second* predicate rather than a widened `ext` because the two answer different
questions: `ext` says "the host's, reach it through the GOT", `slot` says "nobody's yet, reach it through a
slot I filled". It defaults to `fun _ -> None`, so the whole-program path emits byte-identical output and
`survey.sh` goes on being a structural check on all of this.
Three things that would each have cost a session:
- **`flan_reload_install` had to become a function with a frame.** It was a run of loads and stores plus `ret`,
which was fine while it called nothing. The moment it calls `flan_dev_cell`, rsp is 8-mod-16 at the call and
glibc's `movaps` inside `strcmp` faults — a failure that reads as a backend bug and is an ABI bug. Its shape
is now `emit_globals_init`'s, down to owning the null transfer cell no caller hands it.
- **A new global's declared value has to travel with it.** `flan_dev_global` copies it onto the allocation the
first time the name is interned and ignores it after, which is where "a reload must not reset the program's
state" lives. `emit.ml` folds that value into an LLVM constant and this file has no folder, so the image is a
module-local `.bss` buffer written by the initialiser *lowered as ordinary code* — which is the bargain
`emit_globals_data`'s comment already makes for a whole program, and it needs no second evaluator that could
disagree with the first about what a struct literal means.
- **Order inside the installer is load-bearing and is not checkable from outside.** Every lookup resolves
before any body is published; publishing first exposes a function whose slots are still null to every call
site in the host. `emit.ml` says the same and `test_reload.ml` checks it *there* by grepping the IR text.
There is no text to grep on this side, so the guarantee is the loop order and the comment above it.
`reload-v6.flan` is new and is the reason the fixture set was not enough. v3's `extra` is declared zero, which
`calloc` also gives, so a run-time-new global whose image never arrived would still have passed. v6's `tuning`
is 42 and the host prints 88.
Republishing a `defconst` came free once the rest was there — one store of the new constant into the host's
global, which is what `emit.ml` does — so that refusal is gone too.
## 2. The transient thunk
`flan_reload_call` is `emit_main` without the argv and the exit: no caller hands it a transfer channel, so it
owns a null cell on its own frame and passes that cell's address on. Sixteen bytes of frame rather than eight,
because rsp has to be 16-aligned at the call.
The thunk is excluded from everything else the module does — no cell, no publish, no registry slot. There are
4096 slots and an expression evaluated in a loop would exhaust them, and a module with nothing pointing into it
is what lets the agent `dlclose` it at all.
`@flan_reload_transient` is that claim, under `emit.ml`'s three conditions. The third is about **data** rather
than text and is the one that can be got wrong in the dangerous direction: a string literal lives in this
module's image, an expression may store one anywhere it likes, and a global left pointing into an unmapped
image is silent garbage rather than a fault. So the count is kept where the literals are made — `string_const`
bumps the same `Emit.m.nstr` field `emit.ml` counts on. Two deliberate decisions in that:
- **A float constant is not counted.** It is a label in the same `.rodata` and it is *loaded*, never retained.
Counting rodata bytes would be the wrong test; `emit.ml` keeps frame descriptors in a separate `nfi` for
exactly this reason and says so.
- **The installer's own registry name strings are counted.** That is right rather than incidental: a module
that interned a name left something behind, and `flan_dev.c` `strdup`s it precisely because the module that
passed it may go away.
## 3. The wiring
**The choice is a session setting, not a per-command flag**, and it is spelled exactly as `debug` already is:
one field on `Session.t`, set once in `Dev.start`, carried on every `Session.change` the session emits.
`session.ml`'s own comment on `debug` gives the reason and it is the same one — the modules have to match the
process they are loaded into. `Session.redefinition` is the single place that picks a backend, so the six call
sites cannot disagree and the refusal has one home; `change.x86` rides beside `change.ir` so the text and the
builder can never come from two different answers to the same question.
**There is no fallback and there must not be one.** If `X86.redefinition` refuses a form the daemon reports the
refusal. Quietly building an LLVM module instead is precisely the crossed pair `flan.abi.x86` exists to refuse
at `dlopen`. A refusal reaches the editor as a diagnostic like any other: `X86.Unsupported` is re-raised as a
`Loc.Error` at the form it is about, because every caller already handles that and none handled the other, and
a daemon that died on the first unsupported form would be worse than one that says so and stays up.
`flan reload` got the same flag at the same time. A command that could build a module for a host the other
backend compiled is how the crossed pair was reachable from the CLI at all; `HANDOFF-x86-aggregates.md`'s
two-line reproduction no longer has a second half.
**`--x86 --debug` is refused for the daemon**, and this is a decision rather than an oversight.
`flan build --x86 --debug` stays allowed — `X86.program` emits a hand-written DWARF 4 unit — but
`X86.redefinition` emits none, so a `--debug` session would build a host with a line table and then send it
modules without one. A breakpoint set on a line in the buffer would fire before the first `C-c C-c` and stop
firing after it. Accepting the flag and ignoring it would be worse.
## The merged daemon, which is the finding
**`flan dev --x86` refuses the merged daemon and needs `--two-process`.**
A merged build is the program and the compiler in one process. The compiler expands macros by `dlopen`ing a
module `Build.macro_module` made — through `Emit.program`, always, and cached on disk under
`~/.cache/flan/objcache` by the *macro source*, not by the backend. A merged host is linked `-rdynamic` so a
redefinition module can reach its cells, and that exports every `flan.*` body it has. So the macro module's own
copy of a prelude function is **interposed by the host's**.
With an LLVM host both halves are LLVM and nobody notices. With an `--x86` host the caller is LLVM and the body
it lands in is this backend's. Measured, before the refusal went in:
```
Thread 2 "program" received signal SIGSEGV
#0 0x0000000000403884 in flan[clamp] () <- the --x86 host's body
#1 0x00007ffff6f6b58c in flan.macro[clamp] () from ~/.cache/flan/objcache/flan-macros-....so
#2 flan_macro_call (dynload_stubs.c:68)
...
#19 camlFlan__Session.create_inner (lib/session.ml:117)
#20 camlFlan__Dev.merged_setup (lib/dev.ml:3013)
```
During the **first macro expansion**, before the program had started. `flan dev --x86` printed its build line
and exited 139.
Three things worth stating about it:
- **`flan.abi.x86` does not catch this and was never meant to.** It guards a redefinition module.
`HANDOFF-x86-abi-marker.md` reasoned explicitly that macro modules are unaffected because
`Build.macro_module` calls `Emit.program` without `~dev`, so a macro module neither defines nor requires a
marker — and that reasoning was correct for what it covered. This is a *third* path, and it exists only
because the merged daemon puts the compiler and the program in one address space.
- **`-Bsymbolic` is the wrong fix**, though it is one line. The macro module links its own `flan_rt.c`, and
binding symbolically would bind those calls to a copy of the runtime `flan_rt_init` never ran on — a second
bug hiding behind a green suite — and it would change the cached object for the LLVM path, which is the
default and must not move. `-Bsymbolic-functions` has the same defect.
- **The honest fix is hidden visibility on a macro module's Flan bodies.** That leaves the C runtime symbols
binding to the host's exactly as they do now and stops only the Flan ones from being interposed. It still
changes the cached object for both backends, so it wants a lane and a suite run of its own.
`--two-process` has no such meeting: the compiler is a separate binary that LLVM built, the macro module is
loaded into *it* and never into the program, and the only thing crossing between them is a redefinition module
— which this session now builds with the same backend as the host.
`start_merged` keeps its `--x86` plumbing (`rename_program_main_asm`, the `merged_executable` fork, the
`FLAN_DEV_X86` environment variable). It is unreachable today. It is the half that is right and it is what will
be wanted the day the macro module is fixed: the `--x86` merged host does build and link, and it is the *macro*
module and nothing about the host that stops it.
## Measured
One machine, `llc`/`clang` as installed here, warm caches. **This machine's `llc` is slower than the one
`docs/BUILT.md` was written on** — 42–48ms against that file's 15–17ms — so both rows below are measured here
rather than compared against that table. The shape of the answer is what matters and it does not depend on
which machine: `llc` is replaced by `as`, and `as` is five times cheaper.
`flan reload`, five runs each, on one changed `defn`:
| | LLVM | `--x86` |
|---|---|---|
| codegen | `llc` **42–48ms** | `as` **8.0–8.4ms** |
| link | `ld -shared` 9.7–11.4ms | `ld -shared` 8.9–9.3ms |
**Read `timing.llc_ms` carefully**: `Build.shared_x86` puts the *assembler's* time in that field, because the
record is shared between the two. `flan reload` now prints `as` or `llc` according to what ran, so its output
does not mislead; anything reading the field directly still has to know.
The round trip a user feels, through a real `flan dev --two-process` daemon on `programs/dev-repl.flan`,
measured at the socket — so this includes checking the form, emitting, building, delivering to the agent and
waiting for a frame boundary:
| | LLVM | `--x86` |
|---|---|---|
| `C-c C-c` (`eval`, one `defn`) | 62, 66, 65ms | **27, 28, 30ms** |
| of which the build reports | 53.0, 52.6, 53.5ms | **17.9, 17.2, 18.2ms** |
| `C-x C-e` (`eval-expr`) | 61, 60, 60ms | **24, 24, 25ms** |
**Better than twice as fast end to end, and three times on the build.** That is the claim the lane was written
to test and it holds.
Two things the numbers say that the headline does not:
- **`ld -shared` is now the bulk of the `--x86` build.** 9ms of an 18ms build, and it did not move between the
two backends. `docs/BUILT.md` records it at 3ms on the other machine; whatever the cause, the next
millisecond in this loop is in the linker and not in codegen. Nothing here tried to move it.
- **About 9ms of the round trip is neither codegen nor link.** 27ms at the socket against an 18ms build leaves
the frontend re-checking the program, the wire, the `dlopen` and the wait for a frame boundary.
`docs/BUILT.md` puts the re-check "under 10ms" and that is consistent. It was 14% of the LLVM round trip and
is 33% of this one, which is the ordinary consequence of removing the big term: the next thing worth
measuring has changed.
## Verification
| | before (`f459352`) | after |
|---|---|---|
| `dune test --root .` | exit 0, 232 checks, 0 failures | **exit 0, 232 checks, 0 failures**, three runs |
| `spike/x86/survey.sh` | 103 MATCH / 0 DIFFER / 0 REFUSED / 0 NOX86 | **103 / 0 / 0 / 0** |
| skip breakdown | 28 does-not-compile / 8 no-main / 2 runs-forever | 28 / **9** / 2 |
| `spike/x86/cells.sh` | 4/4 ok | **4/4 ok** |
| `bash web/examples/check.sh` | green | **green** |
The `no-main` count moving from 8 to 9 is `reload-v6.flan` existing: `survey.sh` globs
`test/programs/*.flan`, and a program with no `main` fails the LLVM link and is classified there before the x86
build is attempted. `reload-agg.flan` moved it from 6 to 8 for the same reason. The **MATCH** count is what
must not move, and it did not.
The survey is the measurement that could have moved and did not, which is why it is run: `Lslot` and
`fnctx.slot` default to the whole-program answer and `string_const` now mutates `md.Emit.nstr` on that path
too, harmlessly, because nothing there reads it. The survey is what says so structurally rather than by
argument.
One more trap, and it wasted a run here. `dune test` caches a test's *result*: the second and third runs of an
unchanged tree print nothing and exit 0 without having executed anything. If what you want is three real runs
— which is what the flakiness in this area asks for — it is `dune test --root . --force`.
Run `dune test --root .` **without a pipe** — piping to `tail` gives you `tail`'s exit status, and the
`dev-robust` fixture puts `ld` and `clang` failure text in the output either way. Run the survey **detached**
(`setsid timeout 2400 spike/x86/survey.sh > log 2>&1 </dev/null`) or a signal to the harness's process group
comes back as 143, which is not a result. And do not run the survey while `dune test` is running: both take the
`_build` lock, and the loser reports a lock error rather than a count.
## What remains
- **The macro module, so the merged daemon can be `--x86`.** §The merged daemon above has the mechanism, the
measurement and the fix that should be tried. This is the largest remaining piece and it is what stands
between `flan dev --x86` and being the default shape of the loop.
- **The linker.** 9ms, unchanged between backends, now the bulk of an `--x86` build.
- **DWARF from `X86.redefinition`**, which is what `flan dev --x86 --debug` is refused for.
- **`X86.program ~macros`**, if the macro module is ever to be built by this backend rather than merely made
immune to interposition. Not needed for the fix recommended above.
- **`test/test_emacs.ml` got no `--x86` case, deliberately.** It drives the Elisp client against a daemon, and
the client neither knows nor can say which backend a session uses — the flag is `flan dev`'s and the protocol
above it is identical. The real editor path for *this* lane is `test_dev.ml`, which drives the daemon's own
verbs and is where the case went. Worth revisiting only if `--x86` ever grows a spelling in the protocol.
- Items 2–7 of `HANDOFF-x86-rt.md` §6, unchanged. And still worth doing: **run `spike/x86/survey.sh` in CI**.

182
lib/dev.ml
View File

@ -418,6 +418,29 @@ let error ?loc msg =
^ (match loc with None -> "" | Some l -> " :loc " ^ Wire.quote l)
^ ")"
(* One module, built by whichever backend wrote it. The choice travels on the
change rather than being asked again here, so the text and the builder can
never come from two different answers — and an [--x86] host therefore gets
[--x86] modules by construction, which is the licence [lib/x86.ml] rests on.
[flan.abi.x86] is the backstop if this is ever got wrong: a crossed pair
fails the [dlopen] naming both backends.
The extension follows for the same reason. What [Build.shared_x86] is handed
is assembly, and the copy kept beside the [.so] is what [disassemble] reads
back ten reloads later. *)
let module_ext (c : Session.change) = if c.Session.x86 then ".s" else ".ll"
let build_module (c : Session.change) ~debug ~out =
if c.Session.x86 then
Build.shared_x86
~opts:{ Build.default with Build.dev = true; Build.x86 = true;
Build.debug = debug }
~asm:c.Session.ir ~out ()
else
Build.shared
~opts:{ Build.default with Build.dev = true; Build.debug = debug }
~ir:c.Session.ir ~out ()
(* [pause], when given, is the position of the form to stop at — §9. It rides
beside the code rather than in it, and the reply echoes it back so an editor
marks the buffer only for a mark the session actually applied. *)
@ -441,12 +464,12 @@ let eval t ~code ~origin ~pause =
after the module. Writing our own copy beside the .so is what makes
[disassemble] able to show the IR of a body installed ten reloads ago:
nothing else on this machine still has that text. *)
let ll = Filename.concat t.dir (Printf.sprintf "m%d.ll" t.n) in
let ll =
Filename.concat t.dir
(Printf.sprintf "m%d%s" t.n (module_ext c))
in
write_file ll c.Session.ir;
(match Build.shared
~opts:{ Build.default with Build.dev = true;
Build.debug = t.session.Session.debug }
~ir:c.Session.ir ~out () with
(match build_module c ~debug:t.session.Session.debug ~out with
| timing ->
(match deliver t out with
| "ok" ->
@ -485,10 +508,7 @@ let eval_expr t ~code ~origin ~pause =
let before = match result t with Some (g, _) -> g | None -> 0L in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in
(match Build.shared
~opts:{ Build.default with Build.dev = true;
Build.debug = t.session.Session.debug }
~ir:c.Session.ir ~out () with
(match build_module c ~debug:t.session.Session.debug ~out with
| _ ->
(match deliver t out with
| "ok" ->
@ -845,12 +865,7 @@ let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result =
let before = match result t with Some (g, _) -> g | None -> 0L in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "%s%d.so" tag t.n) in
match
Build.shared
~opts:{ Build.default with Build.dev = true;
Build.debug = t.session.Session.debug }
~ir:c.Session.ir ~out ()
with
match build_module c ~debug:t.session.Session.debug ~out with
| exception Failure m -> Error m
| _ ->
(match deliver t out with
@ -1250,11 +1265,10 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
Tast.fns = s.Session.program.Tast.fns @ [ thunk ];
externs = s.Session.program.Tast.externs @ Session.externs @ [ addr_extern ] }
in
let ir =
Emit.redefinition ~dev:true ~debug:s.Session.debug ~known:(Session.known s)
~call:name program ~fns:[ name ]
in
Ok { Session.ir; names = []; fns = []; installs = true }
(* Through the session's own chooser, so that this thunk is compiled by
whichever backend built the process it is about to be loaded into. *)
let ir = Session.redefinition s ~call:name program ~fns:[ name ] in
Ok { Session.ir; x86 = s.Session.x86; names = []; fns = []; installs = true }
(* [(:op "at" :addr N :type "Enemy")] — point at any heap address.
@ -2473,7 +2487,7 @@ let accept_loop t ls =
deletes it — and silently making every reloaded body -O0 would change the
frame time of the one function you are iterating on, in the loop whose whole
point is watching that number. *)
let two_process ?(debug = false) ~file ~sock () =
let two_process ?(debug = false) ?(x86 = false) ~file ~sock () =
let t0 = Unix.gettimeofday () in
(* Absolute, because every location this daemon ever reports is derived from
it and an editor is not in this process's working directory. [flan dev
@ -2481,7 +2495,7 @@ let two_process ?(debug = false) ~file ~sock () =
"src/game.flan:12:7", which the editor can only resolve by guessing which
directory it was relative to. *)
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
let session, l = Session.create ~debug ~file () in
let session, l = Session.create ~debug ~x86 ~file () in
let dir =
Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
@ -2502,11 +2516,16 @@ let two_process ?(debug = false) ~file ~sock () =
ignore
(Build.executable
~opts:{ Build.default with Build.dev = true; Build.keep = true;
Build.debug }
Build.debug; Build.x86 }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe);
let host_ll = Filename.concat dir "host.ll" in
(* Host and modules are chosen together, which is the whole licence: an
[--x86] host gets [--x86] modules because one flag set both, and the
source [Build.executable] kept is assembly rather than IR. *)
let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
(try
Sys.rename (Filename.concat (Build.workdir ()) (Filename.basename exe ^ ".ll"))
Sys.rename
(Filename.concat (Build.workdir ())
(Filename.basename exe ^ if x86 then ".s" else ".ll"))
host_ll
with Sys_error _ -> ());
let agent = Filename.concat dir "agent.sock" in
@ -2859,6 +2878,34 @@ let rename_program_main ir =
String.sub ir 0 i ^ "define i32 @flan_program_main("
^ String.sub ir (i + n) (len - i - n)
(* The same rename on assembly, for an [--x86] merged build. [X86.emit_main]
writes exactly one [main] with no quotes around it -- every Flan symbol is
quoted and prefixed, so ["flan.main"] cannot be confused for it -- and the
two places it appears are the header and the [.size] that closes it. The
spike's finding holds here too: the rename is all it takes. *)
let rename_program_main_asm asm =
let hdr = "\t.globl\tmain\n\t.type\tmain, @function\nmain:\n"
and hdr' =
"\t.globl\tflan_program_main\n\t.type\tflan_program_main, @function\n\
flan_program_main:\n"
and siz = "\t.size\tmain, . - main\n"
and siz' = "\t.size\tflan_program_main, . - flan_program_main\n" in
let replace hay needle by =
let n = String.length needle and h = String.length hay in
let rec go i =
if i + n > h then None
else if String.sub hay i n = needle then Some i
else go (i + 1)
in
match go 0 with
| None ->
failwith
"no main in the emitted assembly — the merged build renames it so a C \
main can own the process"
| Some i -> String.sub hay 0 i ^ by ^ String.sub hay (i + n) (h - i - n)
in
replace (replace asm hdr hdr') siz siz'
(* The link, which is [Build.executable]'s with three additions: the program's
[@main] renamed, the C above, and the compiler object.
@ -2874,11 +2921,17 @@ let merged_executable ~opts ~csrcs ~lflags ~pnames (p : Tast.program) ~out ~ll =
a --debug build that came out -O2 makes [basis] and the listing lie. *)
let opts = if opts.debug then { opts with opt = "-O0" } else opts in
let tflags = target_flags opts in
let ir =
Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames
~sanitize:opts.sanitize p
in
write ll (rename_program_main ir);
(* The same one fork [Build.executable] has: the dev backend hands clang an
assembly file where LLVM hands it IR text, and clang takes either on its
command line, so everything past this point is the same link. *)
write ll
(if opts.x86 then
rename_program_main_asm
(X86.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug p)
else
rename_program_main
(Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug
~pnames ~sanitize:opts.sanitize p));
let cc src name = compile_c ~opts ~tflags ~src ~name () in
let objs =
(cc Runtime_src.source "flan_rt.c"
@ -2900,6 +2953,11 @@ let merged_executable ~opts ~csrcs ~lflags ~pnames (p : Tast.program) ~out ~ll =
String.concat " "
([ Filename.quote clang; opts.opt; "-Wno-override-module" ]
@ cflags opts
(* The hand-written DWARF 4 compile unit in the .s, for the reason
[Build.executable] gives at the same place: the assembler's own stub
line table is a DWARF 5 header otherwise, and readelf calls it
corrupt. *)
@ (if opts.x86 && opts.debug then [ "-gdwarf-4" ] else [])
(* Still needed, and for the same reason: a delivered module reaches the
host's cells and globals through the dynamic symbol table. *)
@ (if opts.dev then [ "-rdynamic" ] else [])
@ -2946,12 +3004,13 @@ let merged_setup () =
let host_ll = need_env "FLAN_DEV_HOST_LL" in
let agent = need_env "FLAN_AGENT_SOCKET" in
let debug = Sys.getenv_opt "FLAN_DEV_DEBUG" = Some "1" in
let x86 = Sys.getenv_opt "FLAN_DEV_X86" = Some "1" in
(* The session is built a second time here rather than carried across the
exec. It is the frontend only — about 12ms — and the alternative is
marshalling a [Session.t] through a file, which buys nothing: the source
cannot have changed between the two, because the build that produced
this binary is the one that exec'd it. *)
let session, _ = Session.create ~debug ~file () in
let session, _ = Session.create ~debug ~x86 ~file () in
(* The program's output has to reach an editor exactly as it did when the
daemon held the other end of a pipe. Same pipe, one process: fd 1 is
replaced before the program starts, and the accept loop drains it —
@ -3017,10 +3076,10 @@ let merged_serve () =
(* The merged build is made here and then [exec]'d, so what an editor talks to
is the program itself rather than something that launched it. The launcher
does not survive: there is one process from the first reply onwards. *)
let start_merged ?(debug = false) ~file ~sock () =
let start_merged ?(debug = false) ?(x86 = false) ~file ~sock () =
let t0 = Unix.gettimeofday () in
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
let session, l = Session.create ~debug ~file () in
let session, l = Session.create ~debug ~x86 ~file () in
let dir =
Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
@ -3032,10 +3091,10 @@ let start_merged ?(debug = false) ~file ~sock () =
in this file, so it can simply be told where to put it. It is the text
clang was given, with [@main] renamed — which is what this binary really
was built from, and what [basis] must not misreport. *)
let host_ll = Filename.concat dir "host.ll" in
let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
ignore
(merged_executable
~opts:{ Build.default with Build.dev = true; Build.debug }
~opts:{ Build.default with Build.dev = true; Build.debug; Build.x86 }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags ~pnames:[]
session.Session.host ~out:exe ~ll:host_ll);
let agent = Filename.concat dir "agent.sock" in
@ -3049,6 +3108,10 @@ let start_merged ?(debug = false) ~file ~sock () =
Unix.putenv "FLAN_DEV_DIR" dir;
Unix.putenv "FLAN_DEV_HOST_LL" host_ll;
Unix.putenv "FLAN_DEV_DEBUG" (if debug then "1" else "0");
(* The session is rebuilt inside the exec'd binary, and it has to come back
with the same backend: the modules it emits are loaded into this very
process, which was just compiled by that backend. *)
Unix.putenv "FLAN_DEV_X86" (if x86 then "1" else "0");
(* Not read by the exec'd binary's dev path but by [Macro]: the merged binary
expands the prelude a second time, and the object cache's macro key is
keyed on the compiler's identity. Its own [Sys.executable_name] is this
@ -3065,6 +3128,49 @@ let start_merged ?(debug = false) ~file ~sock () =
flan.cmxa beside the binary — and it is what every behaviour in this file
was written against, so it stays until the transport it exists to drive is
actually deleted. *)
let start ?(debug = false) ?(merged = true) ~file ~sock () =
if merged then start_merged ~debug ~file ~sock ()
else two_process ~debug ~file ~sock ()
let start ?(debug = false) ?(merged = true) ?(x86 = false) ~file ~sock () =
(* [--x86] and [--debug] are refused together here, and only here: [flan
build --x86 --debug] is deliberately allowed, because [X86.program] emits
a hand-written DWARF 4 unit. [X86.redefinition] does not, so a [--debug]
session would build a host with a line table and then send it modules with
none -- a breakpoint on a line in the buffer would fire before the first
C-c C-c and stop firing after it, which is worse than not offering the
combination. Accepting the flag and ignoring it would be worse still. *)
if x86 && debug then
failwith
"flan dev --x86 --debug: the dev backend emits DWARF for a whole program \
but not yet for a redefinition module, so a breakpoint set on a line \
would stop firing at the first C-c C-c. Use one or the other.";
(* And the merged daemon is refused outright, which is a finding and not a
convenience. A merged build is the program and the compiler in one
process, and the compiler expands macros by [dlopen]ing a module
[Build.macro_module] made -- through [Emit.program], always, and cached on
disk by the macro source rather than by the backend. A merged host is
linked [-rdynamic] so a redefinition module can reach its cells, which
also exports every [flan.*] body it has; the macro module's own copy of a
prelude function is then interposed by the host's. In an LLVM session both
are LLVM and nobody notices. In an [--x86] one the caller is LLVM and the
body it lands in is this backend's, which is the crossed pair -- measured
here as a SIGSEGV inside [flan.\[clamp\]] during the *first* macro
expansion, before the program had started.
[flan.abi.x86] does not catch it and was never meant to: it guards a
redefinition module, and a macro module deliberately neither defines nor
requires a marker (docs/handoffs/HANDOFF-x86-abi-marker.md says so, and
the reasoning was right for what it covered). This is a third path. The
honest fix is hidden visibility on a macro module's Flan bodies, which
changes the cached object for both backends and wants a lane of its own.
[--two-process] has no such meeting: the compiler is a separate binary
that LLVM built, the macro module is loaded into it and never into the
program, and the only thing crossing between them is a redefinition module
-- which this session now builds with the same backend as the host. *)
if x86 && merged then
failwith
"flan dev --x86 needs --two-process. A merged daemon expands macros by \
loading a module LLVM built into the program itself, and a --rdynamic \
x86 host interposes that module's own prelude bodies -- an LLVM caller \
lands in an x86 body and the process dies during the first macro \
expansion. See docs/handoffs/HANDOFF-x86-devloop.md.";
if merged then start_merged ~debug ~x86 ~file ~sock ()
else two_process ~debug ~x86 ~file ~sock ()

84
lib/session.ml
View File

@ -56,6 +56,14 @@ type t = {
against and nothing to line up the host's own frames with. Both ends are
set from one flag — see [Dev.start]. *)
debug : bool;
(* Which backend compiles the modules this session emits, and it belongs to
the session for exactly the reason [debug] does: it has to match the
process they are loaded into. The two backends agree on every scalar and
disagree on every aggregate, so a module from one dlopened into a host
from the other is correct until the first redefined function takes or
returns a struct. Both ends are set from one flag -- see [Dev.start] --
and [flan.abi.x86] is the backstop if they ever come apart. *)
x86 : bool;
}
let fail = Loc.fail
@ -103,7 +111,7 @@ let own_macros (forms : Form.t list) : Form.t list =
| _ -> None)
forms
let create ?(debug = false) ~file () =
let create ?(debug = false) ?(x86 = false) ~file () =
let forms = Reader.read_file file in
let l = Load.program ~file forms in
let p, env = Check.program_with_env l.Load.decls in
@ -112,7 +120,7 @@ let create ?(debug = false) ~file () =
package the program imports, the bare name wins for a form typed into
that buffer. [macro_union] keeps the left. *)
macros = Load.macro_union (own_macros forms) l.Load.macros;
thunks = 0; debug }, l)
thunks = 0; debug; x86 }, l)
(* Which package a file being edited belongs to, if any.
@ -335,6 +343,12 @@ let compatible_enums ~loc old_ new_ =
both editor commands: C-c C-c sends one form, C-c C-k sends a file. *)
type change = {
ir : string; (* the module to build and send *)
(* Which backend wrote [ir], and therefore which builder and which file
extension it wants: LLVM IR through [Build.shared], or x86-64 assembly
through [Build.shared_x86]. It rides on the change rather than being
looked up again at the build, so the text and the choice of builder can
never come from two different answers to the same question. *)
x86 : bool;
names : string list; (* everything the forms declared *)
fns : string list; (* the subset that has a body to install *)
(* False when the module would define nothing: no body to publish and no
@ -355,6 +369,45 @@ type change = {
it — which is an ordinary [C-c C-c] over the same form, with no [:pause].
That is §9's settled behaviour, and it is the same one statement that
accepts every other change. *)
(* The one place the backend choice is made, so that the six callers below
cannot disagree about it and the refusal has one home.
There is no fallback and there must not be one. If [X86.redefinition]
refuses a form, the daemon reports the refusal; quietly building an LLVM
module instead would hand an [--x86] host a module from the other backend,
which is the crossed pair [flan.abi.x86] exists to refuse at [dlopen]. A
refusal a user can read is the right answer; a segfault three frames later
is not. *)
let redefinition (t : t) ?retains ?call ?(consts = []) program ~fns =
if not t.x86 then
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ?retains
~consts ?call program ~fns
else
match
X86.redefinition ~checks:true ~dev:true ~known:(known t) ?retains ~consts
?call program ~fns
with
| asm -> asm
(* The dev backend covers a subset of the IR and refuses the rest by name,
which is what makes a build that succeeds one it really compiled. A
refusal has to reach the editor as a diagnostic like every other, so it
is re-raised at the form it is about -- the first name being redefined,
which is where a reader would look. Every caller already handles
[Loc.Error]; none of them handles [X86.Unsupported], and a session that
died on the first unsupported form would be worse than one that says so
and stays up. *)
| exception X86.Unsupported m ->
let loc =
match
List.find_opt
(fun (f : Tast.fn) -> List.mem f.Tast.name fns)
program.Tast.fns
with
| Some f -> f.Tast.floc
| None -> Loc.unknown
in
fail loc "the x86 dev backend cannot compile this: %s" m
let eval ?(origin = "<eval>") ?pause t src : change =
let forms = Reader.read_all ~file:origin src in
Parse.with_imported t.macros @@ fun () ->
@ -534,10 +587,7 @@ let eval ?(origin = "<eval>") ?pause t src : change =
program.Tast.globals)
names
in
let ir =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~consts program
~fns
in
let ir = redefinition t ~consts program ~fns in
let allocates =
List.exists
(fun (g : Tast.global) -> not (known t g.Tast.gname))
@ -550,7 +600,7 @@ let eval ?(origin = "<eval>") ?pause t src : change =
t.decls <- decls;
t.program <- program;
t.env <- env;
{ ir; names; fns; installs = fns <> [] || allocates || consts <> [] }
{ ir; x86 = t.x86; names; fns; installs = fns <> [] || allocates || consts <> [] }
(* ── Evaluating an expression ──────────────────────────────────────── *)
@ -791,11 +841,10 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
externs = t.program.Tast.externs @ externs }
in
let ir =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:[ name ]
redefinition t ~call:name program ~fns:[ name ]
in
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
(* ── One slot of a stopped frame, walked ───────────────────────────── *)
@ -1050,12 +1099,12 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
externs = t.program.Tast.externs @ externs }
in
let ir =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t)
redefinition t
~call:tname program ~fns:[ tname ]
in
ignore origin;
Ok
({ ir; names = []; fns = []; installs = true },
({ ir; x86 = t.x86; names = []; fns = []; installs = true },
name ^ path_text path,
Types.to_string v.Tast.ty)))
@ -1139,11 +1188,10 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
externs = t.program.Tast.externs @ externs }
in
let ir =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:[ name ]
redefinition t ~call:name program ~fns:[ name ]
in
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
(* [pause] is [C-u C-x C-e] — §9's "last expression" target. It is a flag and
not a position, because there is only one form here and it is the whole of
@ -1234,8 +1282,8 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
function nobody sets a breakpoint on by name, but it is a frame on the
stack when the expression signals, and a frame the debugger cannot name
is the thing the conditions buffer is trying to stop showing. *)
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ])
redefinition t ~call:name program
~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ])
in
(* The copies stay in the session's program, unlike the thunk: the thunk is
not a declaration and there is nothing to keep, but a copy that has been
@ -1247,7 +1295,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
a body that no module was ever written for. A daemon that answers and has
lost track of what the program contains is worse than one that died. *)
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
{ ir; names = []; fns = []; installs = true }
{ ir; x86 = t.x86; names = []; fns = []; installs = true }
(* ── What a macro call expands to ──────────────────────────────────── *)

355
lib/x86.ml
View File

@ -557,6 +557,17 @@ type fnctx = {
module answers true for the host's cells, globals and bodies, and those
go through the GOT -- see [modrm_got]. *)
ext : string -> bool;
(* [Some slot] of a symbol that does not exist anywhere: a function or a
global the host was never built with, introduced by a redefinition module
while the process was running. There is no symbol to bind to and ELF has
no way to grow one, so the address is looked up by string at install time
and parked in [slot], which is this module's own object. Always [None] for
a whole program, where [known] is true of everything -- so the
whole-program path emits byte-identical output and the survey goes on
being a structural check on all of this. [ext] and this are two questions
and not one: [ext] says "the host's, reach it through the GOT", this says
"nobody's yet, reach it through a slot I filled". *)
slot : string -> string option;
(* The line table under construction, in a [--debug] build. [None] is every
other build, and then [dwline] below is the only thing that looks at it
and does nothing — so a release build's output is byte-identical to what
@ -685,7 +696,15 @@ let escape_bytes s =
(List.map (fun c -> Printf.sprintf "0x%02x" (Char.code c))
(List.init (String.length s) (String.get s)))
(* Counted, on the same field [emit.ml] counts it on and for the same one
reason: it is the test [redefinition] applies before it lets an expression
thunk's module say it may be unloaded. A string literal is emitted into this
module's image and the expression may store it anywhere it likes, so a
module holding one keeps its mapping. A float constant is a label in the
same section and is deliberately not counted -- it is loaded, never
retained. *)
let string_const f s =
f.md.Emit.nstr <- f.md.Emit.nstr + 1;
let l = rodata_label f in
Buffer.add_string f.rodata (Printf.sprintf "\t.align 1\n%s:\n" l);
if String.length s > 0 then
@ -716,6 +735,13 @@ type loc =
| Lf of int (* rbp + d *)
| Lg of string * int (* rip-relative symbol + d *)
| Lgot of string * int (* a symbol this object does not define; + d *)
(* A name that did not exist when the host was built, so there is no symbol
anywhere to bind to. The address lives in a slot this module defines and
[flan_reload_install] fills by asking the runtime's registry for it by
string. The slot is this object's own, so naming it is pc-relative and
never goes through the GOT; reading it is the one extra load, which is
exactly [Lgot]'s shape with [Sym] where it has [Got]. *)
| Lslot of string * int (* a module-local slot holds the address; + d *)
| Lp of int * int (* [rbp + p] is a pointer; + d *)
let shift l d =
@ -723,6 +749,7 @@ let shift l d =
| Lf o -> Lf (o + d)
| Lg (s, a) -> Lg (s, a + d)
| Lgot (s, a) -> Lgot (s, a + d)
| Lslot (s, a) -> Lslot (s, a + d)
| Lp (p, a) -> Lp (p, a + d)
(* [scratch] is only touched by the [Lp] case, and every caller passes r11 —
@ -737,6 +764,9 @@ let lmem f (l : loc) ~scratch : mem =
| Lgot (s, a) ->
load_int f.b ~dst:scratch ~mm:(Got s) ~size:8 ~signed:false;
Reg (scratch, a)
| Lslot (s, a) ->
load_int f.b ~dst:scratch ~mm:(Sym (s, 0)) ~size:8 ~signed:false;
Reg (scratch, a)
| Lp (p, a) ->
load_int f.b ~dst:scratch ~mm:(Frame p) ~size:8 ~signed:false;
Reg (scratch, a)
@ -748,13 +778,19 @@ let addr_into f ~reg (l : loc) =
| Lgot (s, a) ->
load_int f.b ~dst:reg ~mm:(Got s) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
| Lslot (s, a) ->
load_int f.b ~dst:reg ~mm:(Sym (s, 0)) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
| Lp (p, a) ->
load_int f.b ~dst:reg ~mm:(Frame p) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
(* The spellings of "name a symbol", each picking the pc-relative form
for a symbol this object defines and the GOT form for one it does not. *)
let sym_loc f s = if f.ext s then Lgot (s, 0) else Lg (s, 0)
let sym_loc f s =
match f.slot s with
| Some sl -> Lslot (sl, 0)
| None -> if f.ext s then Lgot (s, 0) else Lg (s, 0)
(* [lea] of a symbol is an address; out of the GOT the address is already
there, so the [lea] becomes a load. *)
@ -769,11 +805,20 @@ let addr_sym f ~dst s =
beside [call *%r11] reads as "call through the cell" and in fact calls the
cell. docs/DISCUSS.md item 15 said this is how hand-encoding fails. *)
let load_sym f ~dst s =
if f.ext s then begin
load_int f.b ~dst ~mm:(Got s) ~size:8 ~signed:false;
match f.slot s with
(* The slot holds the cell's address, just as the GOT entry below does, so
this is the same two loads with one relocation swapped. Which is the point
of spelling a run-time-new name this way: every site that reaches a cell
already double-loads, and none of them had to learn a third case. *)
| Some sl ->
load_int f.b ~dst ~mm:(Sym (sl, 0)) ~size:8 ~signed:false;
load_int f.b ~dst ~mm:(Reg (dst, 0)) ~size:8 ~signed:false
end
else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false
| None ->
if f.ext s then begin
load_int f.b ~dst ~mm:(Got s) ~size:8 ~signed:false;
load_int f.b ~dst ~mm:(Reg (dst, 0)) ~size:8 ~signed:false
end
else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false
let scalar_size f (t : Types.t) =
match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t)
@ -2542,7 +2587,8 @@ let incoming_of ~sret (params : Types.t list) =
sret_at, ps, next_int ()
let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
?(hidden = false) ?dw (fn : Tast.fn) : string * string =
?(slot = fun _ -> None) ?(hidden = false) ?dw (fn : Tast.fn)
: string * string =
let b = create () in
let nslots = Array.length fn.Tast.slots in
let f =
@ -2551,7 +2597,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
xfer_off = 0; sret_off = 0; retval = 0;
frame = 0; maxframe = 0; outgoing = 0;
loops = []; pads = []; xfer_lbl = ""; unwound = false;
rodata = Buffer.create 64; externs; fns; ext; dw }
rodata = Buffer.create 64; externs; fns; ext; slot; dw }
in
(* The subprogram this function's rows hang off. Its first row is the
function symbol itself, at the line the [defn] was written on, so the
@ -2874,7 +2920,7 @@ let emit_globals_init ?(cfi = false) (md : Emit.m) ~externs ~fns
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;
rodata = Buffer.create 64; externs; fns; ext = (fun _ -> false);
dw = None }
slot = (fun _ -> None); dw = None }
in
(* Two slots, not one: [xfer_off] holds the *pointer* every call passes on,
and [cell] is what it points at. Storing a null into [xfer_off] itself —
@ -3350,26 +3396,40 @@ let program ~checks ?(dev = false) ?(debug = false) (p : Tast.program) : string
frame boundary, on the game thread. [reload_host.c] and
[vendor/agent/flan_agent.c] both [dlsym] exactly that spelling.
{b The scope, and it is narrower than [Emit.redefinition]'s.} Only names the
host already has. A name introduced since has no symbol to bind to, and
[Emit.redefinition] answers that with [flan_dev_cell] / [flan_dev_global] and
[Emit.cellptr]'s deeper spelling -- a module-local slot resolved by string at
install time. That is not built here, and neither is the [consts] republish
nor the transient [flan_reload_call] thunk. Each is refused by name, which is
this file's idiom for a case it has not earned the right to compile. *)
{b A name the host was never built with.} There is no symbol to bind to and
ELF has no way to grow one, so the address is asked for by string at install
time -- [flan_dev_cell] for a function's cell, [flan_dev_global] for a
global's storage -- and parked in a slot this module defines. [Lslot] is how
every later reference reads it, and it is [Lgot]'s shape with the relocation
swapped, so no call site and no place expression had to learn a third case.
[Emit.cellptr] and [Emit.globalptr] are the same two slots on the LLVM side,
spelled the same way here so the two are readable against each other.
A new global's declared initial value travels with it, because
[flan_dev_global] copies it onto the allocation the first time the name is
seen and ignores it afterwards -- which is where "a reload must not reset the
program's state" lives. [emit.ml] folds that value into an LLVM constant; it
has a folder for the IR's own syntax and this file does not. So the image is
built the way [emit_globals_init] builds a global's storage in a whole
program: a module-local buffer, written by the initialiser expression lowered
as ordinary code. A few instructions once, and no second evaluator that could
disagree with the first about what a struct literal means.
{b The scope, and it is still narrower than [Emit.redefinition]'s.} The
transient [flan_reload_call] thunk is not built here, and is refused by name
-- this file's idiom for a case it has not earned the right to compile. *)
let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
?(consts = []) ?call (p : Tast.program) ~fns : string =
?(retains = true) ?(consts = []) ?call (p : Tast.program) ~fns : string =
if not dev then
unsupported
"x86 redefinition without cells: there is nothing to publish a body \
into, and this backend's release build has no indirection";
if consts <> [] then
unsupported "x86 redefinition: republishing a defconst is not built yet";
(match call with
| Some _ ->
unsupported
"x86 redefinition: the transient flan_reload_call thunk is not built yet"
| None -> ());
(* A thunk this module runs itself is excluded from all of the machinery
below: [flan_reload_call] calls it directly, so it needs no cell, must not
be published into one, and must not take a registry slot -- there are 4096
of those and an expression evaluated in a loop would exhaust them.
Nothing pointing into the module is also what lets the agent unload it. *)
let transient n = call = Some n in
let target name =
match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name) p.Tast.fns with
| Some f -> f
@ -3390,24 +3450,19 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
let siblings =
List.filter (fun (f : Tast.fn) -> f.Tast.fparent = None) p.Tast.fns
in
List.iter
(fun (f : Tast.fn) ->
if not (known f.Tast.name) then
unsupported
"x86 redefinition: %s is new to this session, and a name the host \
was not built with needs the flan_dev_cell lookup and \
Emit.cellptr's second spelling, which are not built here yet"
f.Tast.name)
siblings;
List.iter
(fun (g : Tast.global) ->
if not (known g.Tast.gname) then
unsupported
"x86 redefinition: the global %s is new to this session, and a new \
global needs the flan_dev_global lookup, which is not built here \
yet"
g.Tast.gname)
p.Tast.globals;
(* The names this module introduces, each of which gets a slot below. A
function's slot holds its cell's address and a global's holds its
storage's, so the two are the same eight bytes and differ only in what
fills them. *)
let new_fns =
List.filter
(fun (f : Tast.fn) ->
(not (known f.Tast.name)) && not (transient f.Tast.name))
siblings
and new_globals =
List.filter (fun (g : Tast.global) -> not (known g.Tast.gname))
p.Tast.globals
in
let md = layout_ctx ~checks ~dev p in
let externs = Hashtbl.create 16 in
List.iter
@ -3424,6 +3479,19 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
List.iter (fun (f : Tast.fn) -> Hashtbl.replace mine (fsym f.Tast.name) ())
(targets @ lifted);
let ext s = not (Hashtbl.mem mine s) in
(* And the third answer: a name that is nobody's symbol yet. Keyed by the
spelling the reference uses -- a function is reached through its cell, so
the key is [csym]; a global is reached by its own name, so it is [gsym].
The two can never collide, because a function and a global cannot share a
name and [gsym] and [fsym] are the same string. *)
let cellp n = asm_sym ("flan.cellp." ^ n)
and gp n = asm_sym ("flan.gp." ^ n) in
let slots = Hashtbl.create 8 in
List.iter (fun (f : Tast.fn) ->
Hashtbl.replace slots (csym f.Tast.name) (cellp f.Tast.name)) new_fns;
List.iter (fun (g : Tast.global) ->
Hashtbl.replace slots (gsym g.Tast.gname) (gp g.Tast.gname)) new_globals;
let slot s = Hashtbl.find_opt slots s in
let text = Buffer.create 8192 and rodata = Buffer.create 1024 in
Buffer.add_string text
"# Generated by flan's x86-64 backend: one or more functions, recompiled\n\
@ -3432,32 +3500,183 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
\t.text\n\n";
List.iter
(fun (f : Tast.fn) ->
let t, r = emit_fn md ~externs ~fns:fnstbl ~ext ~hidden:true f in
let t, r = emit_fn md ~externs ~fns:fnstbl ~ext ~slot ~hidden:true f in
Buffer.add_string text t;
Buffer.add_string rodata r)
(lifted @ targets);
(* Publishing: one store per target, and the cell's address has to be read
out of the GOT first because the cell itself lives in the host. The body
is this module's own and hidden, so its address is an ordinary
pc-relative [lea]. *)
let b = create () in
(* [flan_reload_install] is a function with a frame, not a run of loads and
stores, and it has to be: it calls into the runtime, and a [call] made on
an unaligned stack faults inside glibc's own [movaps] rather than anywhere
a reader would look. A prologue is what makes rsp 16-aligned at every call
below, since [frame_bytes] rounds. Its shape is [emit_globals_init]'s and
for the same reasons, down to owning a null transfer cell that no caller
hands it. *)
let ib = create () in
let f =
{ b = ib; md; fnname = "<install>"; retlbl = new_label () "install";
fret = Types.Unit; slots = [||]; xfer_off = 0; sret_off = 0; retval = 0;
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;
rodata = Buffer.create 256; externs; fns = fnstbl; ext; slot; dw = None }
in
let chan = ptmp f in
f.xfer_off <- ptmp f;
f.xfer_lbl <- new_label f "ixfer";
(* A new global's initial value, written into a buffer of this module's own.
[flan_dev_global] copies it the first time the name is interned and
ignores it on every call after, so a second module mentioning the same
name cannot reset the state the reload exists to preserve. Doing it before
any lookup is deliberate: nothing outside this module can see these
buffers, so they are not a publication and the order below is still
"resolve everything, then publish". *)
let images =
List.map
(fun (g : Tast.global) ->
let size, align = Emit.lay md g.Tast.gty in
let l = rodata_label f in
scoped f (fun () -> lower f g.Tast.ginit (Lg (l, 0)));
(g, l, max 1 size, max 1 align))
new_globals
in
(* The lookups, all of them, before a single body is published. Publishing
first would expose a function whose slots are still null to anything that
called it, and here that means every call site in the host. [emit.ml] says
the same and [test_reload.ml] checks it there by grepping the IR text;
there is no text to grep on this side, so the guarantee is this loop
order and this comment. *)
let cstr sym = let l = string_const f sym in lea f.b ~dst:rdi ~mm:(Sym (l, 0)) in
List.iter
(fun (f : Tast.fn) ->
load_int b ~dst:rax ~mm:(Got (csym f.Tast.name)) ~size:8 ~signed:false;
lea b ~dst:r11 ~mm:(Sym (fsym f.Tast.name, 0));
store_int b ~src:r11 ~mm:(Reg (rax, 0)) ~size:8)
(fun (fn : Tast.fn) ->
cstr ("flan." ^ fn.Tast.name);
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dev_cell";
store_int f.b ~src:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8)
new_fns;
List.iter
(fun ((g : Tast.global), l, size, _) ->
cstr ("flan." ^ g.Tast.gname);
movabs f.b ~dst:rsi (Int64.of_int size);
lea f.b ~dst:rdx ~mm:(Sym (l, 0));
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dev_global";
store_int f.b ~src:rax ~mm:(Sym (gp g.Tast.gname, 0)) ~size:8)
images;
(* A [defconst] whose value the checker never folded is just bytes in the
program's memory, so a new value is published the same way a new body is:
one store, at the frame boundary the agent chose. One the checker did fold
is in the shape of the program and never gets here -- the session refuses
it before it asks for a module. *)
List.iter
(fun (g : Tast.global) ->
if List.exists (String.equal g.Tast.gname) consts then
scoped f (fun () -> lower f g.Tast.ginit (sym_loc f (gsym g.Tast.gname))))
p.Tast.globals;
(* And now the bodies. A name the host has is published into its cell, whose
address comes out of the GOT because the cell lives in the host; a name it
does not is published through the slot the lookup above filled. Either way
the body is this module's own and hidden, so its address is an ordinary
pc-relative [lea]. *)
List.iter
(fun (fn : Tast.fn) ->
if transient fn.Tast.name then ()
else begin
if known fn.Tast.name then
load_int f.b ~dst:rax ~mm:(Got (csym fn.Tast.name)) ~size:8
~signed:false
else
load_int f.b ~dst:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8
~signed:false;
lea f.b ~dst:r11 ~mm:(Sym (fsym fn.Tast.name, 0));
store_int f.b ~src:r11 ~mm:(Reg (rax, 0)) ~size:8
end)
targets;
ret b;
flush b;
(* Nothing a constant initialiser can do transfers, so this exit is
unreachable and is emitted only when something claims to aim at it. *)
if f.unwound then begin
jmp_lbl f.b f.retlbl; lbl f.b f.xfer_lbl; jmp_lbl f.b f.retlbl
end;
let pb = create () in
push_r pb rbp;
mov_rr pb ~dst:rbp ~src:rsp;
let n = frame_bytes f in
if n > 0 then sub_imm pb ~dst:rsp n;
xor_rr pb ~dst:rax ~src:rax;
store_int pb ~src:rax ~mm:(Frame chan) ~size:8;
lea pb ~dst:rax ~mm:(Frame chan);
store_int pb ~src:rax ~mm:(Frame f.xfer_off) ~size:8;
lbl f.b f.retlbl;
leave f.b;
ret f.b;
flush pb;
flush f.b;
Buffer.add_string text
"\t.globl\tflan_reload_install\n\
\t.type\tflan_reload_install, @function\n\
flan_reload_install:\n";
Buffer.add_buffer text b.out;
Buffer.add_buffer text pb.out;
Buffer.add_buffer text f.b.out;
Buffer.add_string text
"\t.size\tflan_reload_install, . - flan_reload_install\n\n";
(* An expression evaluation compiles to a function with nowhere to be called
from, so the module says so and the agent runs it once -- after the
install, on the game thread, so it sees both the bodies this module just
published and a program state the program agrees is consistent.
The thunk takes no parameter but the transfer channel, and no caller hands
this wrapper one, so it owns a null cell on its own frame exactly as
[emit_main] does. Sixteen bytes rather than eight keeps rsp 16-aligned at
the call, which is the whole of what the ABI asks of a frame that makes
one. *)
(match call with
| None -> ()
| Some fn ->
let cb = create () in
push_r cb rbp;
mov_rr cb ~dst:rbp ~src:rsp;
sub_imm cb ~dst:rsp 16;
xor_rr cb ~dst:rax ~src:rax;
store_int cb ~src:rax ~mm:(Frame (-8)) ~size:8;
lea cb ~dst:rdi ~mm:(Frame (-8));
xor_rr cb ~dst:rax ~src:rax;
call_sym cb (fsym fn);
leave cb;
ret cb;
flush cb;
Buffer.add_string text
"\t.globl\tflan_reload_call\n\
\t.type\tflan_reload_call, @function\n\
flan_reload_call:\n";
Buffer.add_buffer text cb.out;
Buffer.add_string text
"\t.size\tflan_reload_call, . - flan_reload_call\n\n");
Buffer.add_buffer rodata f.rodata;
let out = Buffer.create 8192 in
Buffer.add_buffer out text;
(* The slots, and the buffers holding a new global's initial value. Both are
this module's own and neither is [.globl]: a second module introducing the
same name gets its own slot and fills it from the registry with the same
answer, which is exactly what makes two modules agree about a name that
has no symbol. [.bss], because every one of them is written before it is
read -- the slots by the lookups above, the images by the initialisers. *)
if new_fns <> [] || new_globals <> [] then begin
Buffer.add_string out "\n\t.bss\n";
List.iter
(fun (fn : Tast.fn) ->
Buffer.add_string out
(Printf.sprintf "\t.align\t8\n\t.type\t%s, @object\n\
\t.size\t%s, 8\n%s:\n\t.zero\t8\n"
(cellp fn.Tast.name) (cellp fn.Tast.name) (cellp fn.Tast.name)))
new_fns;
List.iter
(fun ((g : Tast.global), l, size, align) ->
let s = gp g.Tast.gname in
Buffer.add_string out
(Printf.sprintf "\t.align\t8\n\t.type\t%s, @object\n\
\t.size\t%s, 8\n%s:\n\t.zero\t8\n\
\t.align\t%d\n%s:\n\t.zero\t%d\n"
s s s align l size))
images
end;
(* The ABI marker this module requires of its host. A pointer-sized datum
holding the host's marker is a relocation the loader has to resolve while
it maps the object, whatever it does about lazy binding of calls, so a
@ -3470,6 +3689,34 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
Buffer.add_string out
(Printf.sprintf "\n\t.data\n\t.align\t8\n%s:\n\t.quad\t%s\n"
(asm_sym "flan.abi.require") (asm_sym abi_marker));
(* Nothing outside this module refers to anything in it once the call has
returned -- no cell holds an address in its text, the registry has no slot
for it, and the value it produced was copied out. So it says so, and the
agent [dlclose]s it. A module that publishes a body can never say this:
its whole purpose is to leave a pointer behind.
[nstr = 0] is the third condition and it is about data, not text. A string
literal is emitted into this module's own image, and an expression may
store one anywhere it likes -- [(set msg "tuned")] on a string global
leaves that global pointing into the mapping the agent is about to drop.
The next thunk can be mapped at the same address, so the result is silent
garbage rather than a fault. A module with no string constants has nothing
in its image anyone could still be pointing at; one with any keeps its
mapping, which costs a page and is the same bargain every redefinition
already makes. [string_const] is where the count is kept, and the install
function's own registry names go through it too -- which is right rather
than incidental, since a module that interned a name left something
behind. *)
(match call with
| Some fn
when fns = [ fn ] && consts = []
&& ((not retains) || md.Emit.nstr = 0) ->
Buffer.add_string out
"\n\t.data\n\t.globl\tflan_reload_transient\n\
\t.type\tflan_reload_transient, @object\n\
\t.size\tflan_reload_transient, 1\n\
flan_reload_transient:\n\t.byte\t1\n"
| _ -> ());
Buffer.add_string out "\n\t.section\t.rodata\n";
Buffer.add_buffer out rodata;
Buffer.add_string out "\n\t.section\t.note.GNU-stack,\"\",@progbits\n";

17
test/programs/reload-v6.flan Normal file
View File

@ -0,0 +1,17 @@
;;;; A run-time-new global with a value of its own, which is the half of the
;;;; new-name path that a zeroed defvar cannot measure: [flan_dev_global]
;;;; allocates with calloc, so a global declared zero looks right whether or
;;;; not its initial value travelled with the module. [tuning] is 42, and the
;;;; transcript is the number the host prints, so an image that never arrived
;;;; prints 4 rather than 88.
(defvar counter i64)
(defvar tuning i64 42)
(defn helper [x i64] i64 (* x 2))
(defn bump [] i64
(println "v6")
(set counter (+ counter tuning 1))
(helper counter))
(defn outer [] i64 (bump))

100
test/test_dev.ml
View File

@ -3132,6 +3132,106 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ rsock; rout; rerr ];
(* The dev loop on the other backend, through the daemon rather than
through the library. [test_reload.ml] builds an --x86 host and --x86
modules by hand and loads them into a C host; this is the same thing
arriving the way a user meets it — one flag on [flan dev], and every
module the session emits compiled by the backend that built the process
they are loaded into. A C-c C-c that works in [test_reload.ml] and not
here is not a dev loop.
[--two-process], because [--x86] refuses the merged daemon and says why:
a merged host exports every [flan.*] body for -rdynamic and so interposes
the prelude bodies of the LLVM-built macro module the compiler loads into
itself. The refusal is asserted below. *)
let xsock2 = tmp "x86.sock" and xout2 = tmp "x86.out" in
(try Sys.remove xsock2 with Sys_error _ -> ());
let xfd2 =
Unix.openfile xout2 [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
in
let xpid2 =
Unix.create_process flan
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; xsock2; "--x86";
"--two-process" |]
Unix.stdin xfd2 Unix.stderr
in
Unix.close xfd2;
if not (listening ~pid:xpid2 xsock2) then begin
fail "the --x86 daemon %s" !listen_why;
(try Unix.kill xpid2 Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect xsock2 in
let value r = Option.value ~default:"" (Wire.string_field r "value") in
let said r = Option.value ~default:"" (Wire.string_field r "message") in
(* C-c C-c on a name the host was built with: the case X86.redefinition
could already compile, now reached through the daemon. *)
let r =
request c
"(:op \"eval\" :code \"(defn step [] i64 (set ticks (+ ticks 5)) ticks)\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 C-c C-c: %s" (said r);
(* C-x C-e: the transient thunk and the marker the agent unloads on,
which is a different emitter from the one above. *)
let r =
request c "(:op \"eval-expr\" :code \"(+ 2 3)\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 C-x C-e: %s" (said r)
else if value r <> "5" then fail "x86 C-x C-e answered %S" (value r);
(* A string literal in the thunk. The module keeps its mapping rather
than claiming to be transient — the value is copied out, but a module
holding a literal can never say nothing points into it. *)
let r =
request c
"(:op \"eval-expr\" :code \"\\\"hi\\\"\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 C-x C-e on a literal: %s" (said r)
else if value r <> "\"hi\"" then
fail "x86 C-x C-e on a literal answered %S" (value r);
(* A defvar the host has no storage for, with a value of its own, and a
defn the host has no cell for: both go through flan_dev.c's registry
into slots this backend fills at install time. The expression after
them reads one and calls the other, so the answer is what says the
lookups resolved rather than that the module merely loaded. *)
let r =
request c
"(:op \"eval\" :code \"(defvar fresh i64 41)\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 new defvar: %s" (said r);
let r =
request c
"(:op \"eval\" :code \"(defn twice [x i64] i64 (* x 2))\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 new defn: %s" (said r);
let r =
request c
"(:op \"eval-expr\" :code \"(twice fresh)\" :file \"/tmp/x86buf.flan\")"
in
if status r <> "ok" then fail "x86 new name round trip: %s" (said r)
else if value r <> "82" then
fail "x86 (twice fresh) answered %S, so the registry lookups did not resolve" (value r);
ignore (request c "(:op \"close\")");
(try Unix.close c with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] xpid2) with Unix.Unix_error _ -> ())
end;
(* And the merged daemon refuses --x86 by name. A refusal is the whole
deliverable here: the alternative was a SIGSEGV inside a prelude
function during the first macro expansion, before the program started,
with nothing having said a word. *)
let mout = tmp "x86merged.err" in
let mcode =
Sys.command
(Printf.sprintf "%s dev programs/dev-repl.flan --x86 > /dev/null 2> %s"
(Filename.quote flan) (Filename.quote mout))
in
let msaid = In_channel.with_open_bin mout In_channel.input_all in
if mcode = 0 then fail "the merged daemon accepted --x86 (exit 0)";
if not (contains_sub msaid "--two-process") then
fail "the merged daemon refused --x86 without naming the remedy: %S"
msaid;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ xsock2; xout2; mout ];
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ sock; out; bsock; bout ];
if !failures = 0 then print_endline "dev: all tests passed"

56
test/test_reload.ml
View File

@ -207,10 +207,12 @@ let () =
be correct until the first redefined function took or returned a struct.
So an --x86 host gets --x86 modules and the two never meet.
Only v1 and v2, which is the whole of what X86.redefinition compiles:
every name they touch is one the host was built with. v3 and v4
introduce a function and a global at run time, and the flan_dev_cell /
flan_dev_global lookups that needs are refused there by name.
All four modules, and the same expected string as the LLVM path above:
v3 introduces a defvar and a defn the host was never built with, and v4
redefines the one v3 introduced. Neither has a symbol anywhere, so both
go through flan_dev.c's by-name registry into a slot the module defines
and [flan_reload_install] fills -- [X86.Lslot], which is the GOT path
with the relocation swapped.
Read by running, not by reading. A disassembly reads correctly beside a
wrong answer often enough (docs/DISCUSS.md item 15) that only the printed
@ -231,26 +233,46 @@ let () =
in
let xso1 = xmodule p1 [ "bump" ] "xv1.so" in
let xso2 = xmodule p2 [ "bump" ] "xv2.so" in
let xso3 = xmodule p3 [ "bump"; "added" ] "xv3.so" in
let xso4 = xmodule p4 [ "added" ] "xv4.so" in
let xout = tmp "xout" in
let xcode =
Sys.command
(Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote xhost)
(Filename.quote xso1) (Filename.quote xso2) (Filename.quote xout)
(Printf.sprintf "%s %s %s %s %s > %s 2> %s" (Filename.quote xhost)
(Filename.quote xso1) (Filename.quote xso2) (Filename.quote xso3)
(Filename.quote xso4) (Filename.quote xout)
(Filename.quote (tmp "xerr")))
in
let xtext = In_channel.with_open_bin xout In_channel.input_all in
let xwant =
"v1\nhost 2\nv1\nafter1 4\n" ^ v2s ^ "after2 1204\ncounter 102\n"
in
if xcode <> 0 || xtext <> xwant then
if xcode <> 0 || xtext <> want then
fail "x86 reload\n got: %S (exit %d)\n wanted: %S" xtext xcode
xwant;
(* A name the host was never built with has no symbol to bind to, and the
registry path is not built here. It has to refuse rather than emit
something that links and then stores through a null. *)
(match X86.redefinition ~checks:true ~dev:true ~known p3 ~fns:[ "added" ] with
| _ -> fail "x86 redefinition accepted a name the host does not have"
| exception X86.Unsupported _ -> ());
want;
(* [extra] is a defvar the host has no storage for, so its declared value
has to travel with it: [flan_dev_global] copies the module's image onto
the allocation the first time the name is interned and ignores it every
time after. [extra] is declared zero here, which calloc would also give,
so the case is asserted where it is visible -- a run-time-new global
with a value of its own. *)
let p6 = checked "programs/reload-v6.flan" in
let xso6 = xmodule p6 [ "bump" ] "xv6.so" in
let xhost6 = tmp "xhost6" in
ignore
(Build.executable ~opts:x86 ~csrcs:[ "reload_host.c" ]
~lflags:[ "-ldl" ] p1 ~out:xhost6);
let xout6 = tmp "xout6" in
let xcode6 =
Sys.command
(Printf.sprintf "%s %s > %s 2> %s" (Filename.quote xhost6)
(Filename.quote xso6) (Filename.quote xout6)
(Filename.quote (tmp "xerr6")))
in
let xtext6 = In_channel.with_open_bin xout6 In_channel.input_all in
let xwant6 = "v1\nhost 2\nv6\nafter1 88\ncounter 44\n" in
if xcode6 <> 0 || xtext6 <> xwant6 then
fail "x86 reload of a new global with a value\n \
got: %S (exit %d)\n wanted: %S" xtext6 xcode6 xwant6;
List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
[ xso1; xso2; xso3; xso4; xso6; xhost; xhost6; xout; xout6 ];
(* The aggregate case, which is the whole reason X86.redefinition exists
rather than an --x86 host dlopening what Emit.redefinition made.