diff --git a/NEXT.md b/NEXT.md index f87ae35..5369f09 100644 --- a/NEXT.md +++ b/NEXT.md @@ -1,5 +1,10 @@ # Where this is +**Dev loop steps 1 and 2 are done** — see *The reload primitive* below. +A function can be recompiled and installed into a running process, and call +sites compiled before it existed follow it. That is `C-c C-c` on a `defn`, +without an editor attached to it yet. + Milestone 4 is done: **sand.flan builds, links raylib and runs**, and its simulation has a headless acceptance case that runs on the `dune test` path at `-O0` and `-O2`. Milestones 2 and 3 are behind it (`calc-me.flan` compiles and @@ -29,6 +34,8 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run` | | `test/test_flan.ml` | reader, parser and checker | | `test/test_acceptance.ml` | expression/result pairs + whole programs + the traps | +| `test/test_reload.ml` | **the reload primitive: recompile one function, load it, call it** | +| `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process | ``` $ flan run calc-me.flan "1 + 2 * (3 - 0.5) / 2" @@ -285,6 +292,135 @@ enforces, and a later change could quietly drop it. first expression. Only the parameter position and `(Option …)` are unambiguous. +## The reload primitive — dev loop steps 1 and 2, measured + +`llc` → `ld -shared` → `dlopen` → call, with no protocol and no daemon. +`dune test` runs it: one function is recompiled into its own object and called +inside a process that is already running, twice, with a changed body the second +time. + +| Step | Cost | +|---|---| +| `Emit.redefinition` | below the timer (<0.1ms) | +| `llc -O2 -filetype=obj` | 15–17ms | +| `ld -shared` | 3ms | +| `dlopen` + `dlsym` | **0.04ms** | + +**~19ms end to end**, and the load itself is free. plan.org's 16ms was measured +with clang somewhere else; this is the number from this codebase. For contrast, +`clang -shared` on the same IR is 50ms — the driver is again most of the cost, +which is why the dev path skips it. `llc` and `clang` are both 20.1.8 here; +check that before trusting the `.ll`, since the driver absorbs IR the bare +tools reject. + +`ld -shared` rather than `clang -shared` for a second reason: a shared object +is allowed undefined symbols, and that *is* the mechanism. What the new module +does **not** define is the whole design: + +- **a global is `external`.** This settles the open question below in the only + direction that supports the demo: a redefinition can change a function's + body and can never re-initialise the program's data. Define the global and + the loaded object gets a second copy — sand's `grid` would reset on every + reload, and "edit the code, keep the sand" is the thesis. +- **every other function is a `declare`**, so a redefined `settle` calls the + host's `move-grain` rather than freezing a private copy of it. +- **no `main`.** This module is loaded, not started. + +Its string constants still come along; omitting them is an undefined `@.str.N` +at link time, and it is easy to miss because a one-function module usually has +none. `Emit.signature` is now the single place a function's LLVM signature is +spelled, because a `define` here and a `declare` there drift the moment one of +them grows a case for `Unit` or for a slice parameter. + +**`-rdynamic` is load-bearing.** A normal executable exports nothing: `nm -D +calc-me | grep 'flan\.'` is empty, so a loaded module's `declare`s would have +nothing to bind to. The test passes it through `lflags`, which keeps it a +property of the dev build rather than of every build. `dlsym` on `"flan.bump"` +works — a dot is legal in an ELF symbol. + +Two things about the test are deliberate and are what make it prove anything: +both loads happen in **one process**, since two runs would pass while saying +nothing about an in-process swap; and the versions are **two paths**, since +`dlopen` caches by path and re-opening one would hand back the handle it +already had, so the check would lie. And `helper` is `(* x 2)` in one fixture +and `(* x 3)` in the other: the second body is dead text, since the module +declares `helper` rather than defining it, so the expected 1024 coming back +instead of 1036 is what proves the call landed on the host's copy. With the two +bodies identical nothing at run time would notice a module that grew its own. + +String constants are emitted `private unnamed_addr`, so the module's own +`@.str.N` cannot be interposed by the host's — worth knowing, because with +external linkage a redefined function would silently print the *old* text and +nothing would fail at link time. The fixtures each print a literal so that path +is actually exercised. + +### Cells — how a call site follows a redefinition + +Loading a new body is not installing it. A call bound at link time cannot be +made to notice one, so **a dev build routes every Flan-to-Flan call through a +cell**: a mutable global holding the address of the function that is current. + +``` +@"flan.cell.bump" = global ptr @"flan.bump" ; the host defines it +%p = load ptr, ptr @"flan.cell.bump" ; every call site +%r = call i64 %p() +``` + +Redefinition is then one store. A redefinition module declares the cells +`external`, exactly like the globals, and exposes `flan_reload_install()` that +stores its own body into its own cell — cost **below a microsecond**, which is +what makes a frame-boundary swap a non-event. + +The cell load is emitted *after* the arguments, so a redefinition landing +between two calls cannot land in the middle of one. + +Four things about this that are not free choices: + +- **`flan_reload_install` is a named function and not an ELF constructor.** A + constructor runs during `dlopen`, on whatever thread called it, mid-frame. + The agent has to choose when the store happens. Loading and installing are + separate on purpose. +- **A redefinition's own body is `hidden`.** Default visibility in a shared + object is interposable, and that applies to *taking the address* too: plain + `@"flan.bump"` inside the module resolves to the host's copy, so the + installer would publish the very function it was replacing and the reload + would appear to do nothing. There is a test on the linkage, because the + failure is silent. +- **This also fixes the self-call edge**, which the previous version of this + section listed as a sharp edge: a redefined function calling itself goes + through the cell like any other call, so it reaches the new body. v2 of the + fixture recurses on purpose, and would print the old body's text if it did + not. +- **`-rdynamic` is what exports the cells**, so it and cells are one flag: + `Build.opts.dev`, `flan build --dev`. This is the first time `opts` means + something semantic rather than an optimisation level. + +LLVM cannot fold the indirection away — the cell is an external mutable global +— and a `--dev` build of calc-me keeps 46 indirect calls at `-O2`. The +acceptance table now runs `values`, `machine` and `sand-headless` as dev builds +as well; the sand hash is the case that matters, since it is the one result +that would notice a call reaching the wrong function. + +### Still missing for `C-c C-c` + +- **A new `defvar` has nowhere to live.** Editing one works — a redefinition + module declares it `external`, so the storage stays the host's. *Adding* one + needs storage the host never laid out, which needs a runtime registry + (`flan_dev_cell(name)` handing out stable cell addresses, allocating on + first use) and globals reached through cells too. That is the next commit. +- **The agent**, so the install happens at a frame boundary in a real process + rather than in a C test harness. Step 3. +- **A session that holds the checker environment.** `Check.program` builds a + `new_env ()`, prepends the prelude, mutates it through `collect` and throws + it away. A REPL keeps it — and has to check each new form into a scratch copy + and commit only on success, or one typo leaves a half-declared name behind + and every later eval sees it. +- **Layout drift has to be rejected.** Editing a `defstruct` or retyping a + `defvar` changes the shape of memory the running process already laid out. + The house rule below says compare against the declaration the session was + built with and refuse with a reason, rather than load a module that reads a + field at the wrong offset. Nothing does this yet. + ## Where build time goes `flan build calc-me.flan` was ~160ms, and ~95% of it was clang. **The object @@ -329,18 +465,12 @@ project**, so it comes first. Staged so each step is runnable on its own — the failure mode is building a daemon and a protocol before knowing the reload primitive works. -1. **The reload primitive, measured.** `llc` + `ld -shared` → `.so` → - `dlopen` → call. No sockets, no protocol. A test that compiles one function, - loads it, calls it, recompiles it changed, and calls it again. plan.org's - 16ms was measured with `clang` in isolation and never in this codebase. - It forces the first real change: `emit.ml` needs a mode that compiles one - redefinable function into its own module *against the existing globals*, - rather than as a whole program. -2. **Indirection cells.** Every cross-function call in a dev build goes through - a pointer; redefinition is one atomic store. A fork in `emit.ml` between dev - and release codegen, and the first time `Build.opts` means something - semantic rather than an optimisation level. `test/programs/` gets a case - where a running loop's callee is swapped mid-run. +1. ~~**The reload primitive, measured.**~~ **Done** — `Emit.redefinition`, + `Build.shared`, `test/reload_host.c`, ~19ms. See the section above. +2. ~~**Indirection cells.**~~ **Done** — `Build.opts.dev` / `flan build --dev`, + `flan_reload_install`, and a fixture whose untouched call site follows the + swap. See the section above. Still to do here: a *new* `defvar`, which needs + a runtime cell registry. 3. **The agent, in C.** A socket listener in the game process, `dlopen` off the game thread with `RTLD_NOW`, and the staged cell publish at a frame boundary. It lives next to `flan_rt.c` — no OCaml runtime in the game @@ -352,14 +482,16 @@ primitive works. the protocol is mechanical once 1–3 exist, and the editor client is where the taste is. -**Two decisions to settle before step 2**, because both change codegen and are +**One decision left to settle before step 2**, because both change codegen and are painful to retrofit: -- **Do cells cover globals, or only functions?** plan.org says redefining a - `defvar` is not covered (open decision #6, milestone 7). But sand's `grid` is - a global, and "edit the code, keep the sand" is exactly the demo — which - works only if globals *survive* a reload, meaning the new `.so` must not - re-emit them. +- ~~**Do cells cover globals, or only functions?**~~ **Settled by step 1: + functions only.** A redefinition module declares every global `external`, so + globals live in the host and survive a reload — which is what "edit the code, + keep the sand" needs. The consequence to watch is the other half: adding a + `defvar` to a file cannot take effect on reload, and changing one's type is a + silent mismatch against storage the host already laid out. Nothing detects + that yet. - **What is a redefinition unit — one function, or a file?** A file is much easier to make correct and is what `load-file` wants anyway; one function is what `C-c C-c` wants and is where the 16ms number comes from. diff --git a/bin/main.ml b/bin/main.ml index a24fbcb..898b64c 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -39,6 +39,13 @@ let checked path = Flan.Check.program (load path).decls decision, not the optimisation level (NEXT.md, Bounds checks). *) let no_checks_flag = "--no-bounds-checks" +(* A dev build is the one a REPL can attach to: every call goes through a cell + so a redefinition can be installed, and the cells and globals are exported + so a loaded module can reach them (NEXT.md, the dev loop). *) +let dev_flag = "--dev" + +let flags = [ no_checks_flag; dev_flag ] + let () = match Array.to_list Sys.argv with | _ :: "read" :: files when files <> [] -> @@ -75,29 +82,32 @@ let () = (Flan.Types.to_string f.ret) (Array.length f.slots)) p.fns)) files - | _ :: "emit" :: args when List.exists (fun a -> a <> no_checks_flag) args -> + | _ :: "emit" :: args when List.exists (fun a -> not (List.mem a flags)) args -> let checks = not (List.mem no_checks_flag args) in - let files = List.filter (fun a -> a <> no_checks_flag) args in + let dev = List.mem dev_flag args in + let files = List.filter (fun a -> not (List.mem a flags)) args in List.iter (fun path -> with_errors path (fun () -> - checked path |> Flan.Emit.program ~checks |> print_string)) + checked path |> Flan.Emit.program ~checks ~dev |> print_string)) files | _ :: "build" :: path :: rest -> let checks = not (List.mem no_checks_flag rest) in + let dev = List.mem dev_flag rest in let out = - match List.filter (fun a -> a <> no_checks_flag) rest with + match List.filter (fun a -> not (List.mem a flags)) rest with | [ "-o"; o ] -> o | [] -> Filename.remove_extension (Filename.basename path) | _ -> prerr_endline - "usage: flan build [-o out] [--no-bounds-checks]"; + "usage: flan build [-o out] [--no-bounds-checks] [--dev]"; exit 2 in with_errors path (fun () -> let l = load path in let p = Flan.Check.program l.decls in - ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks } + ignore (Flan.Build.executable + ~opts:{ Flan.Build.default with checks; dev } ~csrcs:l.csrcs ~lflags:l.lflags p ~out)) | _ :: "run" :: path :: args -> with_errors path (fun () -> @@ -116,6 +126,6 @@ let () = | _ -> prerr_endline "usage: flan (read|parse|check|emit) ...\n\ - \ flan build [-o out] [--no-bounds-checks]\n\ + \ flan build [-o out] [--no-bounds-checks] [--dev]\n\ \ flan run [args...]"; exit 2 diff --git a/lib/build.ml b/lib/build.ml index 6ffeeef..c9cc5d5 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -5,8 +5,8 @@ {v flan → typed IR → .ll → clang --target={native,wasm32} v} Not the dev path — that one never invokes the clang driver, because the - driver *is* the cost (52ms of the measured 68), and goes llc + ld -shared + - dlopen instead for ~16ms. Nothing at milestone 2 needs it yet. *) + driver *is* the cost, and goes llc + ld -shared + dlopen instead. That is + [shared], at the bottom of this file, measured at ~19ms. *) let clang = try Sys.getenv "FLAN_CLANG" with Not_found -> "clang" @@ -39,13 +39,19 @@ type opts = { opt : string; keep : bool; (* leave the .ll behind *) checks : bool; (* bounds-check [at] and [slice] *) + (* A dev build is the one a REPL can attach to. Two things, and they belong + together because either alone is useless: every cross-function call goes + through a cell so a redefinition can be installed, and [-rdynamic] exports + those cells (and the globals) so a dlopen'd module can reach them. *) + dev : bool; } (* Checks are deliberately independent of [opt]: the acceptance table runs the same programs at -O0 and -O2 to compare the emitted IR against what mem2reg makes of it, and that comparison is only meaningful if both emit the same checks. Dropping them is a release decision, not an optimisation one. *) -let default = { target = None; opt = "-O2"; keep = false; checks = true } +let default = + { target = None; opt = "-O2"; keep = false; checks = true; dev = false } (* What the compiler itself is, cheaply: its path, size and mtime. A clang upgrade changes one of those, so the key changes with it — without paying a @@ -113,7 +119,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) (p : Tast.program) ~out = let dir = workdir () in let ll = Filename.concat dir (Filename.basename out ^ ".ll") in - write ll (Emit.program ~checks:opts.checks p); + write ll (Emit.program ~checks:opts.checks ~dev:opts.dev p); let objs = compile_c ~opts ~src:Runtime_src.source ~name:"flan_rt.c" :: List.map @@ -124,6 +130,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) let cmd = String.concat " " ([ Filename.quote clang; opts.opt; "-Wno-override-module" ] + @ (if opts.dev then [ "-rdynamic" ] else []) @ (match opts.target with None -> [] | Some t -> [ "--target=" ^ t ]) @ [ Filename.quote ll ] @ List.map Filename.quote objs @@ -135,3 +142,63 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll); if not opts.keep then (try Sys.remove ll with Sys_error _ -> ()); out + +(* ── The dev path: one function into a loadable object ──────────────── *) + +(* Step 1 of the dev loop (NEXT.md): [Emit.redefinition] text → a [.so] the + running process can [dlopen]. This never invokes the clang driver — the + driver is most of what a build costs and none of what it does is needed + here, since the input is already IR and the output has no libc to find. + + [ld -shared] rather than [clang -shared] for the same reason. A shared + object is allowed undefined symbols, which is the whole mechanism: the + redefined function's calls to other Flan functions, to the globals and to + the runtime are all left for the loader to bind back to the host. + + PIC has to be asked for. [llc] defaults to the static relocation model on + this target, and the failure is at link time, not at codegen: "relocation + R_X86_64_32S against ... can not be used when making a shared object". *) + +let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc" +let linker = try Sys.getenv "FLAN_LD" with Not_found -> "ld" + +(* Times in milliseconds, per stage, because a single total does not say + whether the number is worth chasing. *) +type timing = { llc_ms : float; link_ms : float } + +let time f = + let t0 = Unix.gettimeofday () in + let x = f () in + (x, (Unix.gettimeofday () -. t0) *. 1000.) + +let run what cmd = + let code = Sys.command cmd in + if code <> 0 then failwith (Printf.sprintf "%s failed (exit %d)" what code) + +let shared ?(opts = default) ~ir ~out () : timing = + let dir = workdir () in + let base = Filename.remove_extension (Filename.basename out) in + let ll = Filename.concat dir (base ^ ".ll") in + let obj = Filename.concat dir (base ^ ".o") in + write ll ir; + let (), llc_ms = + time (fun () -> + run llc + (String.concat " " + ([ Filename.quote llc; opts.opt; "-filetype=obj"; + "-relocation-model=pic" ] + @ (match opts.target with None -> [] | Some t -> [ "-mtriple=" ^ t ]) + @ [ Filename.quote ll; "-o"; Filename.quote obj ]))) + in + let (), link_ms = + time (fun () -> + run linker + (String.concat " " + [ Filename.quote linker; "-shared"; Filename.quote obj; "-o"; + Filename.quote out ])) + in + if not opts.keep then begin + (try Sys.remove ll with Sys_error _ -> ()); + (try Sys.remove obj with Sys_error _ -> ()) + end; + { llc_ms; link_ms } diff --git a/lib/emit.ml b/lib/emit.ml index 9dbbdec..a894033 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -53,6 +53,13 @@ let fname n = "@" ^ quoted ("flan." ^ n) let gname n = "@" ^ quoted ("flan." ^ n) let sname n = "%" ^ quoted n +(* A dev build's redefinable calls go through a cell: a mutable global holding + the address of the function that is current. Redefinition is then one store, + and every existing call site follows it — which is the whole point, since a + call bound at link time cannot be made to notice a new body. Release builds + have no cells and call the symbol directly. *) +let cellname n = "@" ^ quoted ("flan.cell." ^ n) + (* ── Types ─────────────────────────────────────────────────────────── *) let rec ll (t : Types.t) = @@ -86,6 +93,7 @@ type m = { symbol directly; there is no thunk. *) externs : (string, string) Hashtbl.t; checks : bool; (* emit bounds checks *) + dev : bool; (* call through cells (below) *) mutable nstr : int; } @@ -240,7 +248,7 @@ let rec value f (e : Tast.expr) : string = | Tast.Call (name, args) -> (match Hashtbl.find_opt f.md.externs name with | Some sym -> extern_call f e.Tast.ty ("@" ^ sym) args - | None -> call f e.Tast.ty (fname name) args) + | None -> call f e.Tast.ty name args) | Tast.Do body -> block f body | Tast.Let (bs, body) -> List.iter @@ -378,11 +386,21 @@ and block f body = List.iter (fun e -> last := value f e) body; !last -and call f ret name args = +and call f ret flan args = let vs = map_lr (fun (a : Tast.expr) -> let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in + (* The cell is loaded *after* the arguments, so a redefinition that lands + between two calls still cannot land in the middle of one. *) + let callee = + if not f.md.dev then fname flan + else begin + let p = fresh f in + ins f "%s = load ptr, ptr %s" p (cellname flan); + p + end + in let t = fresh f in - ins f "%s = call %s %s(%s)" t (ll ret) name (String.concat ", " vs); + ins f "%s = call %s %s(%s)" t (ll ret) callee (String.concat ", " vs); t (* A foreign call, where the same rule applies as to the runtime shims: a slice @@ -709,7 +727,24 @@ and cast f (x : Tast.expr) target = (* ── Functions ─────────────────────────────────────────────────────── *) -let emit_fn m (fn : Tast.fn) = +(* The one place a Flan function's LLVM signature is spelled. A [define] and + the [declare] a redefinition module needs for the same function have to + agree exactly, and the way they stop agreeing is one of them growing a case + for Unit or for a slice parameter that the other never gets. *) +let signature ~named (fn : Tast.fn) = + let params = + List.mapi + (fun i ty -> if named then Printf.sprintf "%s %%p%d" (ll ty) i else ll ty) + fn.Tast.params + in + Printf.sprintf "%s %s(%s)" (ll fn.Tast.ret) (fname fn.Tast.name) + (String.concat ", " params) + +(* [hidden] on a redefinition's own body, and this is load-bearing. Default + visibility in a shared object is interposable: [@"flan.bump"] inside the + module would resolve to the *host's* copy, so the installer would publish + the function it was replacing and the reload would appear to do nothing. *) +let emit_fn m ?(hidden = false) (fn : Tast.fn) = let n = Array.length fn.Tast.slots in let f = { md = m; @@ -741,12 +776,9 @@ let emit_fn m (fn : Tast.fn) = discarded, so the return is the Unit constant rather than that value. *) if Types.equal fn.Tast.ret Types.Unit then last := "zeroinitializer"; term f "ret %s %s" (ll fn.Tast.ret) !last; - let params = - List.mapi (fun i ty -> Printf.sprintf "%s %%p%d" (ll ty) i) fn.Tast.params - in Buffer.add_string m.out - (Printf.sprintf "\ndefine %s %s(%s) {\nentry:\n%s%s}\n" - (ll fn.Tast.ret) (fname fn.Tast.name) (String.concat ", " params) + (Printf.sprintf "\ndefine %s%s {\nentry:\n%s%s}\n" + (if hidden then "hidden " else "") (signature ~named:true fn) (Buffer.contents f.allocas) (Buffer.contents f.b)) (* ── Globals ───────────────────────────────────────────────────────── *) @@ -826,14 +858,16 @@ let emit_main m (fn : Tast.fn) = Buffer.add_string b ")\n unreachable\n}\n"; Buffer.add_string m.out (Buffer.contents b) -(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or - [slice], a release build is told to drop them. *) -let program ?(checks = true) (p : Tast.program) : string = +(* Everything a module needs before its own definitions: the tables the + emitters look names up in, the struct types, and the foreign [declare]s. + Both entry points below start here, so a redefinition module cannot drift + from the whole-program one in how it names or lays out a type. *) +let new_module ~checks ~dev (p : Tast.program) = let m = { out = Buffer.create 8192; strs = Buffer.create 512; structs = Hashtbl.create 16; globals = Hashtbl.create 16; externs = Hashtbl.create 32; - checks; nstr = 0; + checks; dev; nstr = 0; } in List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s) p.Tast.structs; @@ -866,9 +900,88 @@ let program ?(checks = true) (p : Tast.program) : string = e.Tast.eparams)))) p.Tast.externs; if p.Tast.externs <> [] then Buffer.add_char m.out '\n'; + m + +let finish m = header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out + +(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or + [slice], a release build is told to drop them. *) +let program ?(checks = true) ?(dev = false) (p : Tast.program) : string = + let m = new_module ~checks ~dev p in + (* One cell per function, initialised to the function this build compiled. + Nothing has been redefined yet, so a dev build starts out behaving exactly + like a release one — the indirection is the only difference. *) + if dev then begin + List.iter + (fun (fn : Tast.fn) -> + Buffer.add_string m.out + (Printf.sprintf "%s = global ptr %s\n" (cellname fn.Tast.name) + (fname fn.Tast.name))) + p.Tast.fns; + Buffer.add_char m.out '\n' + end; List.iter (emit_global m) p.Tast.globals; List.iter (emit_fn m) p.Tast.fns; (match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with | Some fn -> emit_main m fn | None -> ()); - header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out + finish m + +(* One function, compiled into its own module against a host that is already + running — the reload primitive (NEXT.md, step 1). The difference from + [program] is entirely in what this module *does not* define: + + - a global is [external]. Defining it would give the loaded object a second + copy, and the whole point of reloading into a live process is that the + state survives: sand's grid is a global, and "edit the code, keep the + sand" is the demo. So a redefinition can change a function's body and can + never re-initialise the program's data. + - every other function is a [declare], resolved back to the host at load + time, so a redefined [settle] calls the host's [move-grain] rather than + carrying a private copy of it. + - there is no [main]; this module is loaded, not started. + + String literals still have to come along: they are this module's own + constants, and omitting them is an undefined [@.str.N] at link time. *) +let redefinition ?(checks = true) ?(dev = false) (p : Tast.program) ~fn : string = + let target = + match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = fn) p.Tast.fns with + | Some f -> f + | None -> failwith (Printf.sprintf "no such function: %s" fn) + in + let m = new_module ~checks ~dev p in + List.iter + (fun (g : Tast.global) -> + Buffer.add_string m.out + (Printf.sprintf "%s = external %s %s\n" (gname g.Tast.gname) + (if g.Tast.gconst then "constant" else "global") (ll g.Tast.gty))) + p.Tast.globals; + List.iter + (fun (f : Tast.fn) -> + if not (String.equal f.Tast.name fn) then + Buffer.add_string m.out + (Printf.sprintf "declare %s\n" (signature ~named:false f))) + p.Tast.fns; + if dev then begin + (* The cells are the host's, like the globals. Referencing one is how a + redefined function reaches its siblings, and storing into one is how it + replaces itself. *) + List.iter + (fun (f : Tast.fn) -> + Buffer.add_string m.out + (Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name))) + p.Tast.fns; + Buffer.add_char m.out '\n' + end; + emit_fn m ~hidden:dev target; + if dev then + (* Publishing is a separate, named function rather than a constructor: the + agent has to choose *when* the swap happens — at a frame boundary, on + the game thread — and a loader-run ctor would do it during dlopen, on + whatever thread called it, in the middle of a frame. *) + Buffer.add_string m.out + (Printf.sprintf + "\ndefine void @flan_reload_install() {\nentry:\n \ + store ptr %s, ptr %s\n ret void\n}\n" + (fname fn) (cellname fn)); + finish m diff --git a/test/dune b/test/dune index 69c59b4..d3c98fd 100644 --- a/test/dune +++ b/test/dune @@ -1,6 +1,6 @@ (tests - (names test_flan test_acceptance) - (libraries flan) + (names test_flan test_acceptance test_reload) + (libraries flan unix) ; The acceptance programs are part of the test corpus: if the reader, the ; parser or the checker regresses on them we want to know here, not at the CLI. (deps @@ -10,4 +10,6 @@ ; the FFI case import them and an import reads the directory at build time. (glob_files %{workspace_root}/sand-sim/*) (glob_files %{workspace_root}/vendor/raylib/*) - (glob_files programs/*.flan))) + (glob_files programs/*.flan) + ; The reload primitive's host: a C main that dlopens what Build.shared made. + (file reload_host.c))) diff --git a/test/programs/reload-v2.flan b/test/programs/reload-v2.flan new file mode 100644 index 0000000..5282c64 --- /dev/null +++ b/test/programs/reload-v2.flan @@ -0,0 +1,26 @@ +;;;; The reload primitive's fixture, v2. Three differences from v1, each one a +;;;; separate thing being checked: +;;;; +;;;; [bump] steps by 10 and adds 1000, so the host's untouched call site in +;;;; [outer] visibly runs the new body rather than the one it was linked to. +;;;; +;;;; [bump] also calls *itself*. Inside a shared object a plain call would be +;;;; interposed by the host's copy — the module would look self-consistent and +;;;; silently run the old body — so the self-call goes through the cell like +;;;; any other. If it did not, the first recursive step would print "v1" and +;;;; the transcript would say so. +;;;; +;;;; [helper] is changed only as a tripwire. The module declares it rather than +;;;; defining it, so this body is dead text and the call has to land on the +;;;; host's [* x 2]; with the two bodies identical nothing at run time would +;;;; notice a module that grew its own copy. +(defvar counter i64) + +(defn helper [x i64] i64 (* x 3)) + +(defn bump [] i64 + (print-line "v2") + (set counter (+ counter 10)) + (if (> counter 100) (+ (helper counter) 1000) (bump))) + +(defn outer [] i64 (bump)) diff --git a/test/programs/reload.flan b/test/programs/reload.flan new file mode 100644 index 0000000..96cf2cb --- /dev/null +++ b/test/programs/reload.flan @@ -0,0 +1,22 @@ +;;;; The reload primitive's fixture, v1 (NEXT.md, dev loop step 1 and 2). +;;;; +;;;; There is deliberately no [main]: the host is reload_host.c, which links +;;;; this program and then dlopens two rebuilt copies of [bump]. +;;;; +;;;; [counter] is the state that has to survive a reload — a redefinition +;;;; module declares it [external], so the loaded object writes the host's copy +;;;; and not a new one. [outer] is the call site that has to *follow* a reload: +;;;; it is compiled once, into the host, and never rebuilt, so if a redefined +;;;; [bump] runs when the host calls [outer] then the cell is doing its job. +;;;; The string is not decoration either — a redefinition module has to carry +;;;; its own constants, and a one-function module usually has none. +(defvar counter i64) + +(defn helper [x i64] i64 (* x 2)) + +(defn bump [] i64 + (print-line "v1") + (set counter (+ counter 1)) + (helper counter)) + +(defn outer [] i64 (bump)) diff --git a/test/reload_host.c b/test/reload_host.c new file mode 100644 index 0000000..20580c8 --- /dev/null +++ b/test/reload_host.c @@ -0,0 +1,86 @@ +/* reload_host.c — redefinition, exercised in one process. + * + * This is the smallest thing that can prove the dev loop's first two steps: + * a function recompiled into its own object, loaded into a program that is + * already running, *installed* there, and then reached by a call site that + * was compiled before it existed. No socket, no daemon, no frame boundary — + * those are step 3, and the agent that does them lives next to flan_rt.c for + * the same reason this host is C: there is no OCaml in a game process. + * + * It stands in for the entry point of a Flan program, so the .flan fixture it + * links against has no [main] of its own. Three things are being checked, and + * only a single process can check any of them: + * + * - installing a new body makes the host's own [outer] — linked once, never + * rebuilt — call it, which is the whole of C-c C-c; + * - the loaded copy writes the *host's* [counter] and calls the host's + * [helper], because a redefinition module declares both rather than + * defining them; + * - the state carries across two reloads untouched. + * + * The two versions are separate files rather than one path rewritten in + * place: dlopen keys its cache on the path, so re-opening the same name can + * hand back the handle it already has and the test would then "pass" on the + * code it loaded the first time. + */ + +#include +#include +#include +#include + +/* The Flan symbols the executable itself defines. Flan names contain + * characters C identifiers cannot, so each one is reached through its asm + * label — the same name Emit spells. */ +extern int64_t flan_outer(void) __asm__("flan.outer"); +extern int64_t flan_counter __asm__("flan.counter"); + +void flan_rt_init(int32_t argc, char **argv); + +/* What a redefinition module exposes. It is a named function and not an ELF + * constructor on purpose: the agent has to choose when the store happens — + * on the game thread, between frames — and a constructor would do it during + * dlopen, wherever that call happened to be. */ +typedef void (*install_fn)(void); + +/* The load is timed here rather than from the test process, because this is + * the part that has to fit inside a frame. */ +static double now_ms(void) { + struct timespec t; + clock_gettime(CLOCK_MONOTONIC, &t); + return (double)t.tv_sec * 1e3 + (double)t.tv_nsec / 1e6; +} + +static int install(const char *path) { + double t0 = now_ms(); + void *h = dlopen(path, RTLD_NOW | RTLD_LOCAL); + if (h == NULL) { + fprintf(stderr, "dlopen %s: %s\n", path, dlerror()); + return 0; + } + install_fn f = (install_fn)(uintptr_t)dlsym(h, "flan_reload_install"); + if (f == NULL) { + fprintf(stderr, "dlsym flan_reload_install in %s: %s\n", path, dlerror()); + return 0; + } + double t1 = now_ms(); + f(); + fprintf(stderr, "dlopen+dlsym %.2fms install %.4fms\n", t1 - t0, + now_ms() - t1); + return 1; +} + +int main(int argc, char **argv) { + flan_rt_init(argc, argv); + if (argc != 3) { + fprintf(stderr, "usage: %s \n", argv[0]); + return 2; + } + printf("host %lld\n", (long long)flan_outer()); + if (!install(argv[1])) return 1; + printf("v1 %lld\n", (long long)flan_outer()); + if (!install(argv[2])) return 1; + printf("v2 %lld\n", (long long)flan_outer()); + printf("counter %lld\n", (long long)flan_counter); + return 0; +} diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 0e70878..8e9af15 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -23,7 +23,7 @@ let run exe arg = Sys.remove out; (code, text) -let compile ?(opt = "-O2") ?(checks = true) path = +let compile ?(opt = "-O2") ?(checks = true) ?(dev = false) path = let exe = Filename.concat scratch ("flan-t-" ^ Filename.remove_extension (Filename.basename path)) @@ -32,7 +32,7 @@ let compile ?(opt = "-O2") ?(checks = true) path = brings back the package's C shim and linker arguments as well. *) let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in let p = Check.program l.Load.decls in - ignore (Build.executable ~opts:{ Build.default with opt; checks } + ignore (Build.executable ~opts:{ Build.default with opt; checks; dev } ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p ~out:exe); exe @@ -93,8 +93,8 @@ let () = surface calc-me does not reach — globals, 2-D arrays, places through a pointer, casts, match with either arm taken, and the value semantics of spec-memory.md. *) - let outputs ?opt name path expected = - let exe = compile ?opt path in + let outputs ?opt ?dev name path expected = + let exe = compile ?opt ?dev path in let code, text = run exe None in if text <> expected || code <> 0 then begin incr failures; @@ -136,6 +136,14 @@ let () = outputs ~opt:"-O0" "value semantics, -O0" "programs/values.flan" values_out; outputs ~opt:"-O0" "machine surface, -O0" "programs/machine.flan" machine_out; + (* And once more as a dev build. Every call in one goes through a cell, so + this is the same table asserting the indirection changes nothing before + anything has been redefined — the sand hash especially, since it is the + one result that would notice a call reaching the wrong function. *) + outputs ~dev:true "sand, headless, dev" "programs/sand-headless.flan" sand_out; + outputs ~dev:true "value semantics, dev" "programs/values.flan" values_out; + outputs ~dev:true "machine surface, dev" "programs/machine.flan" machine_out; + (* Bounds checks, NEXT.md item 2. A trap has no result — it has a nonzero exit and a message on stderr — so it needs a case shape the table above does not have. What is asserted is the *reason*: the location, and which diff --git a/test/test_reload.ml b/test/test_reload.ml new file mode 100644 index 0000000..17c3a10 --- /dev/null +++ b/test/test_reload.ml @@ -0,0 +1,141 @@ +(* The reload primitive, measured (NEXT.md, dev loop step 1). + + One function is recompiled into its own object and loaded into a process + that is already running. Everything after this — indirection cells, the + agent in the game, the daemon — assumes this works and is fast; nothing in + the codebase had ever done it, and plan.org's 16ms was measured with clang + in isolation somewhere else. + + The parts, all of them new here: + + Emit.program ~dev a cell per function; every call goes through one + Emit.redefinition one [define], everything else [declare]/[external], + plus [flan_reload_install] to publish it into its cell + Build.shared that IR text through llc + ld -shared, timed + reload_host.c dlopen, install, call — twice, in one process + + The host is C rather than OCaml because that is where it has to end up: the + agent of step 3 lives in the game process, next to flan_rt.c, and there is + no OCaml runtime there. *) + +open Flan + +let failures = ref 0 +let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt + +let scratch = Filename.get_temp_dir_name () +let tmp name = Filename.concat scratch ("flan-reload-" ^ name) + +let checked path = + Check.program + (Load.program ~file:path (Parse.program (Reader.read_file path))).Load.decls + +let ms f = + let t0 = Unix.gettimeofday () in + let x = f () in + (x, (Unix.gettimeofday () -. t0) *. 1000.) + +let () = + match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with + | 0 -> + let p1 = checked "programs/reload.flan" in + let p2 = checked "programs/reload-v2.flan" in + + (* [dev] is the two halves of a reloadable build together: cells, so a + call site can be made to follow a redefinition, and [-rdynamic], so the + cells and globals are visible to a dlopen'd object at all. [-ldl] is the + host's own, for its dlopen. *) + let dev = { Build.default with Build.dev = true } in + let host = tmp "host" in + ignore + (Build.executable ~opts:dev ~csrcs:[ "reload_host.c" ] + ~lflags:[ "-ldl" ] p1 ~out:host); + + (* Two paths, not one rewritten in place: dlopen caches by path and would + hand back the first handle, so the swap would silently not happen. *) + let so1 = tmp "v1.so" and so2 = tmp "v2.so" in + let ir1, emit_ms = ms (fun () -> Emit.redefinition ~dev:true p1 ~fn:"bump") in + let t1 = Build.shared ~opts:dev ~ir:ir1 ~out:so1 () in + let ir2, emit2_ms = ms (fun () -> Emit.redefinition ~dev:true p2 ~fn:"bump") in + let t2 = Build.shared ~opts:dev ~ir:ir2 ~out:so2 () in + + (* A redefinition module must not define what the host already owns: + defining [counter] would give the loaded object a private copy and the + state would reset on every reload, and defining [helper] would freeze a + stale copy of it into the module. *) + let has hay needle = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + go 0 + in + if not (has ir2 "@\"flan.counter\" = external global i64") then + fail "redefinition defines the global instead of declaring it"; + if not (has ir2 "declare i64 @\"flan.helper\"(i64)") then + fail "redefinition defines a sibling function instead of declaring it"; + if has ir2 "define i64 @\"flan.helper\"" then + fail "redefinition emitted a second body for a function it does not own"; + if has ir2 "define i32 @main" then fail "redefinition emitted an entry point"; + (* [hidden], or the module's own [@"flan.bump"] is interposed by the host's + and the installer publishes the very function it is replacing. *) + if not (has ir2 "define hidden i64 @\"flan.bump\"") then + fail "redefinition's own body is interposable"; + if not (has ir2 "@\"flan.cell.helper\" = external global ptr") then + fail "redefinition defines a cell instead of using the host's"; + (* A dev host's calls are indirect; a release host's are not. That is the + only difference between the two, and the whole of C-c C-c rests on it. *) + let host_ir = Emit.program ~dev:true p1 in + if not (has host_ir "@\"flan.cell.bump\" = global ptr @\"flan.bump\"") then + fail "dev build emitted no cell"; + if has (Emit.program p1) "flan.cell." then + fail "release build emitted a cell"; + + let out = tmp "out" in + let cmd = + (* stderr kept apart from stdout: the host times its own dlopen there, + and stdout is what the expected transcript is compared against. *) + Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote host) + (Filename.quote so1) (Filename.quote so2) (Filename.quote out) + (Filename.quote (tmp "err")) + in + let (code, dlopen_ms) = ms (fun () -> Sys.command cmd) in + let text = In_channel.with_open_bin out In_channel.input_all in + let timings = + In_channel.with_open_bin (tmp "err") In_channel.input_all in + + (* host: counter 0 -> 1, helper 1 = 2. v1: 1 -> 2, helper 2 = 4. + v2: the changed body, +10 and +1000, over the counter v1 left behind — + so 2 -> 12, helper 12 = 24, 1024. Two things are being read here. The + last line is the state: it is the host's, and two reloads did not touch + it. And 1024 rather than 1036 is the call: v2's own text for [helper] + multiplies by three, so the host's copy is demonstrably the one that + ran. The bare "v1"/"v2" lines come from inside each [bump] and are what + exercise a redefinition module's string constants. + + Two things are load-bearing about the shape of this transcript. Every + call is [outer], compiled once into the host and never rebuilt — so a + changed answer can only mean its call site followed the redefinition. + And v2's [bump] recurses until the counter passes 100, through the cell: + 2 -> 12 -> ... -> 102, ten "v2" lines, helper 102 = 204, 1204. An + interposed self-call would reach the host's v1 body instead, print "v1" + on the second line of that run, and land nowhere near 1204. *) + let v2s = String.concat "" (List.init 10 (fun _ -> "v2\n")) in + let want = + "v1\nhost 2\nv1\nv1 4\n" ^ v2s ^ "v2 1204\ncounter 102\n" + in + if code <> 0 || text <> want then + fail "reload\n got: %S (exit %d)\n wanted: %S" text code want; + + Printf.printf + "reload: emit %.1fms llc %.1fms ld %.1fms (v2: emit %.1fms llc %.1fms ld %.1fms) host run %.1fms\n" + emit_ms t1.Build.llc_ms t1.Build.link_ms emit2_ms t2.Build.llc_ms + t2.Build.link_ms dlopen_ms; + print_string timings; + + List.iter (fun p -> try Sys.remove p with Sys_error _ -> ()) + [ host; so1; so2; out; tmp "err" ]; + if !failures = 0 then print_endline "reload: all tests passed" + else begin + Printf.printf "\n%d failure(s)\n" !failures; + exit 1 + end + | _ -> print_endline "reload: skipped (no clang or llc on PATH)"