diff --git a/bin/main.ml b/bin/main.ml index 49fb41c..6f7915c 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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 [-s socket] [--debug] [--two-process]"; + "usage: flan dev [-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 [-o out.so] [--debug]"; + "usage: flan reload [-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 [-o out] [--no-bounds-checks] [--dev] \ [--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\ \ flan run [args...]\n\ - \ flan reload [-o out.so]\n\ - \ flan dev [-s socket]"; + \ flan reload [-o out.so] [--x86]\n\ + \ flan dev [-s socket] [--x86]"; exit 2 diff --git a/docs/handoffs/HANDOFF-x86-devloop.md b/docs/handoffs/HANDOFF-x86-devloop.md new file mode 100644 index 0000000..73036b9 --- /dev/null +++ b/docs/handoffs/HANDOFF-x86-devloop.md @@ -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.` for a function's +cell, `flan.gp.` 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 "" | 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 () diff --git a/lib/session.ml b/lib/session.ml index 8226c16..f6b0ba3 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -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 = "") ?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 = "") ?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 = "") ?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 = "") 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 = "") 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 = "") 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 = "") ?(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 = "") ?(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 ──────────────────────────────────── *) diff --git a/lib/x86.ml b/lib/x86.ml index e17fc18..22a478b 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -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 = ""; 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"; diff --git a/test/programs/reload-v6.flan b/test/programs/reload-v6.flan new file mode 100644 index 0000000..4065cc8 --- /dev/null +++ b/test/programs/reload-v6.flan @@ -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)) diff --git a/test/test_dev.ml b/test/test_dev.ml index 715a091..d549100 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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" diff --git a/test/test_reload.ml b/test/test_reload.ml index 43b4215..ff23ce7 100644 --- a/test/test_reload.ml +++ b/test/test_reload.ml @@ -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.