diff --git a/lib/build.ml b/lib/build.ml index 24bf682..bdde411 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -732,12 +732,35 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) does not do this: see [opts]. *) let opts = if opts.debug then { opts with opt = "-O0" } else opts in let tflags = target_flags opts in - if opts.x86 && (wasm_target opts || opts.dev || opts.debug || opts.sanitize) + (* [--dev] used to be in this list, for the indirection cells. It is not any + more: [x86.ml] emits a cell per function, spelled as [Emit.cellname] + spells it and exported the same way, and calls and function values read + it. What a `--x86 --dev` build still lacks is anything to *write* one — + [Emit.redefinition] has no x86 counterpart. That costs nothing here, + because [flan dev] never reaches this fork: [--x86] is read only by + [flan build], the daemon builds its host and its modules through this + function without it, and there is no spelling that hands it one. So the + flag means what it says — a host whose call sites are redefinable, built + by this backend — and the module that would redefine through them arrives + with the lane that writes it. + + That lane inherits one thing this comment should say out loud rather than + leave for it to find. [x86.ml]'s header licenses its own calling + convention on the grounds that a dev build is compiled entirely by it and + a release build entirely by LLVM, so the two never meet in one process. + Publishing a cell an LLVM-built module can store into is the first thing + that could make that false: the two conventions agree on scalars and + disagree on every aggregate, so an [Emit.redefinition] module dlopened + into an [--x86] host would be correct until the first redefined function + took or returned a struct. Nothing in the toolchain does that today — + [flan reload] and [flan dev] both build host and module through LLVM — + and the fix when something does is to emit the module through this + backend too, not to grow a classifier. *) + if opts.x86 && (wasm_target opts || opts.debug || opts.sanitize) then failwith - "--x86 is the native dev backend on its own: it emits no DWARF, has no \ - indirection cells for a REPL to redefine through, and there is no \ - sanitizer pass over hand-written assembly"; + "--x86 is the native dev backend on its own: it emits no DWARF and \ + there is no sanitizer pass over hand-written assembly"; let dir = workdir () in (* The one fork in this function. The x86 backend hands clang an assembly file where LLVM hands it IR text; clang takes either on its command line, @@ -748,7 +771,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) (Filename.basename out ^ if opts.x86 then ".s" else ".ll") in write ll - (if opts.x86 then X86.program ~checks:opts.checks p + (if opts.x86 then X86.program ~checks:opts.checks ~dev:opts.dev p else Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames ~sanitize:opts.sanitize p); diff --git a/lib/x86.ml b/lib/x86.ml index 2a0a5a7..1e264fe 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -20,6 +20,16 @@ this backend runs. So the convention is ours to pick, and we pick the simplest one that exists: + {b The licence has an edge now, and it is the indirection cells below.} A + cell is a mutable global an out-of-process redefinition can store into, and + the module doing the storing is built by [Emit.redefinition], which is + LLVM. The two conventions agree on scalars and disagree on every + aggregate, so an LLVM-built module dlopened into a build made here would be + correct exactly until a redefined function took or returned a struct. + Nothing in the toolchain does that today — [flan reload] and [flan dev] + build host and module through LLVM together — and the answer when + something does is a redefinition emitter {e here}, not a classifier. + - {b Scalars} — integers, [bool], pointers, enums, handles, allocators, function pointers — go in SysV's integer registers [rdi rsi rdx rcx r8 r9], then right-to-left on the stack. [bool] is one byte, zero-extended. @@ -319,7 +329,7 @@ let xorps b ~dst = rex b ~w:false ~r:dst ~x:0 ~m:dst; u8 b 0x0f; u8 b 0x57; modr (* [Emit.m] carries the struct and union tables [Emit.lay] reads. Built here rather than imported so that this module adds no line to [emit.ml]: the record has no signature hiding it and every field it needs is inert. *) -let layout_ctx ~checks (p : Tast.program) : Emit.m = +let layout_ctx ~checks ~dev (p : Tast.program) : Emit.m = let structs = Hashtbl.create 16 and unions = Hashtbl.create 16 in List.iter (fun (s : Tast.structure) -> Hashtbl.replace structs s.Tast.sname s) p.Tast.structs; @@ -327,7 +337,7 @@ let layout_ctx ~checks (p : Tast.program) : Emit.m = p.Tast.unions; { Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; unions; globals = Hashtbl.create 1; externs = Hashtbl.create 1; checks; - dev = false; known = (fun _ -> true); dbg = None; sanitize = false; + dev; known = (fun _ -> true); dbg = None; sanitize = false; nstr = 0; nfi = 0 } let sizeof md t = fst (Emit.lay md t) @@ -365,6 +375,14 @@ let asm_sym s = "\"" ^ s ^ "\"" let fsym n = asm_sym ("flan." ^ n) let gsym n = asm_sym ("flan." ^ n) +(* The indirection cell: a mutable global holding the address of the function + that is currently this name's body. Spelled exactly as [Emit.cellname] + spells it, because that is the whole point of having one here — a + redefinition module is still built by LLVM, and it binds + [@"flan.cell." = external global ptr] against whatever built the host. + Byte-for-byte or the link fails and the piece served nothing. *) +let csym n = asm_sym ("flan.cell." ^ n) + (* ── Function context ────────────────────────────────────────────────── *) type fnctx = { @@ -919,12 +937,24 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = let l = place f p in addr_into f ~reg:rax l; store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 - (* Not the indirection cell: this backend owns the whole build and nothing - is redefined into it, so a function's address is its symbol. When it - stops being true, [Fnval] is the case that grows a load. *) - | Tast.FnAddr (Tast.Flanfn n) | Tast.FnAddr (Tast.Fnval n) -> + (* The symbol itself, not a load from it: a function's address is a + link-time constant, and this is the spelling a lifted handler clause is + reached by. [emit.ml] says the same of [Flanfn]. *) + | Tast.FnAddr (Tast.Flanfn n) -> lea f.b ~dst:rax ~mm:(Sym (fsym n, 0)); store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 + (* A function value someone wrote, which is the one [FnAddr] that is not the + symbol. In a release build there is nothing to redefine and it is the + symbol after all; in a dev build it is the cell's contents, so that a + value taken after a redefinition is the new body. What that does not give + — and [emit.ml] names it rather than papering over it with a trampoline — + is a value taken *before* a redefinition and called after it. Once the + address is in a slot there is nothing left to re-resolve. *) + | Tast.FnAddr (Tast.Fnval n) -> + if f.md.Emit.dev then + load_int f.b ~dst:rax ~mm:(Sym (csym n, 0)) ~size:8 ~signed:false + else lea f.b ~dst:rax ~mm:(Sym (fsym n, 0)); + store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 | Tast.FnAddr (Tast.Rtfn n) -> lea f.b ~dst:rax ~mm:(Sym (n, 0)); store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8 @@ -932,7 +962,12 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | Tast.Call (name, args) -> (match Hashtbl.find_opt f.externs name with | Some sym -> call_c f ~sym ~args ~rty:t dst - | None -> call_flan f ~target:(`Sym (fsym name)) ~args ~rty:t dst) + | None -> + (* A dev build calls through the cell so that a redefinition reaches + every existing call site; a release build names the symbol. *) + call_flan f + ~target:(if f.md.Emit.dev then `Cell (csym name) else `Sym (fsym name)) + ~args ~rty:t dst) | Tast.CallPtr (callee, args) -> let c = eval f callee in call_flan f ~target:(`Loc c) ~args ~rty:t dst @@ -1701,7 +1736,8 @@ and ret_loc f = if is_agg f.fret then Lp (f.sret_off, 0) else Lf f.retval and call_flan f ~target ~args ~rty dst = let vals = List.map (fun (a : Tast.expr) -> eval f a, a.Tast.ty) args in let callee = - match target with `Sym s -> `Sym s | `Loc l -> `Loc (off_of l) + match target with + | `Sym s -> `Sym s | `Cell s -> `Cell s | `Loc l -> `Loc (off_of l) in let sret = (not (is_void rty)) && is_agg rty in let head = if sret then [ Aptr dst ] else [] in @@ -1718,8 +1754,17 @@ and call_flan f ~target ~args ~rty dst = the pointer we were handed, so one cell serves the whole chain. *) let chan = [ Aint (Lf f.xfer_off, Types.Ptr Types.Unit) ] in ignore (emit_args f (head @ body @ chan)); + (* The cell is loaded *after* the arguments, and [emit.ml] has the same as a + load-bearing comment: a redefinition that lands between two calls still + must not land in the middle of one. [r11] is scratch and no argument + register, so this cannot disturb what [emit_args] just placed. [CallPtr] + is deliberately the other way round — the callee there is written first + and there is no cell to keep out of an argument list. *) (match callee with | `Sym s -> call_sym f.b s + | `Cell s -> + load_int f.b ~dst:r11 ~mm:(Sym (s, 0)) ~size:8 ~signed:false; + call_r f.b r11 | `Loc o -> load_int f.b ~dst:r11 ~mm:(Frame o) ~size:8 ~signed:false; call_r f.b r11); @@ -2447,10 +2492,37 @@ let check_no_transfer (p : Tast.program) = in List.iter (fun (g : Tast.global) -> ex g.Tast.ginit) p.Tast.globals +(* One cell per function, initialised to the body this build compiled, and + [.globl] so that a redefinition module can bind to it. Nothing has been + redefined yet when the program starts, so a dev build begins by behaving + exactly like a release one — the indirection is the only difference, and + that is what makes the whole corpus a test of it. + + [.data] and not [.bss]: the initialiser is a relocation against the body, + not a zero. Default visibility, because interposition is the point here; + only a redefined *body* is hidden, and this backend emits none. + + What is not here is [Emit.cellptr] — the second, deeper spelling for a name + the host was never built with. It cannot arise in a whole-program build, + where [known] is true of everything, and it belongs with the redefinition + module that would introduce such a name. *) +let emit_cells (p : Tast.program) = + let out = Buffer.create 256 in + Buffer.add_string out "\t.data\n"; + List.iter + (fun (fn : Tast.fn) -> + let c = csym fn.Tast.name in + Buffer.add_string out + (Printf.sprintf "\t.globl\t%s\n\t.align\t8\n\t.type\t%s, @object\n\ + \t.size\t%s, 8\n%s:\n\t.quad\t%s\n" + c c c c (fsym fn.Tast.name))) + p.Tast.fns; + Buffer.contents out + (* A whole program as one assembly file. *) -let program ~checks (p : Tast.program) : string = +let program ~checks ?(dev = false) (p : Tast.program) : string = check_no_transfer p; - let md = layout_ctx ~checks p in + let md = layout_ctx ~checks ~dev p in let externs = Hashtbl.create 16 in List.iter (fun (e : Tast.extern) -> Hashtbl.replace externs e.Tast.ename e.Tast.esym) @@ -2479,9 +2551,19 @@ let program ~checks (p : Tast.program) : string = Buffer.add_buffer out text; (* The globals' initialiser runs before main, through the same constructor slot [emit.ml] uses to arm the allocation registry. *) + (* [flan_dev_reg_enable] arms the allocation registry, and a dev build is the + only build that has one. A constructor rather than a line in [main] for + [emit.ml]'s reason: a [defvar] initialiser allocates before [main] runs, + and a note that arrived before the flag was set would be a block the table + never heard of. It is ordered before [init_sym] here for the same reason. + Leaving it out was the one visible difference between a `--x86 --dev` + build and an LLVM one over the whole corpus: [registry.flan] asks + [(live? ...)] and got four zeroes. *) Buffer.add_string out - (Printf.sprintf "\t.section\t.init_array,\"aw\",@init_array\n\t.align\t8\n\ - \t.quad\t%s\n\n" init_sym); + (Printf.sprintf "\t.section\t.init_array,\"aw\",@init_array\n\t.align\t8\n%s\ + \t.quad\t%s\n\n" + (if dev then "\t.quad\tflan_dev_reg_enable\n" else "") init_sym); + if dev then Buffer.add_string out (emit_cells p); Buffer.add_string out (emit_globals_data md p.Tast.globals); Buffer.add_string out "\n\t.section\t.rodata\n"; Buffer.add_buffer out rodata; diff --git a/spike/x86/cell-override.c b/spike/x86/cell-override.c new file mode 100644 index 0000000..98be268 --- /dev/null +++ b/spike/x86/cell-override.c @@ -0,0 +1,31 @@ +/* Redefine flan.cell.twice from outside the program, without a compiler. + * + * A dev build exports one cell per function -- a mutable global holding the + * address of the body that is current -- and it is -rdynamic, so the cell is + * in .dynsym and dlsym can find it by name. Storing a different function + * pointer there is the whole of what a redefinition does to an existing call + * site; the rest of the dev loop is about producing the new body, and none of + * that is needed to answer "does a call actually read the cell". + * + * A Flan function's signature is its parameters followed by the transfer + * channel, so this takes (i64, void *) where the Flan body takes (n i64). It + * never transfers, so it never writes through the channel. + * + * A release build has no cells, dlsym answers NULL, and this does nothing -- + * which is the control: it shows the change below comes from the indirection + * and not from ordinary symbol interposition. See spike/x86/cells.sh. + */ +#define _GNU_SOURCE +#include +#include +#include + +static int64_t instead(int64_t n, void *xfer) { + (void)xfer; + return n + 1; +} + +__attribute__((constructor)) static void install(void) { + void **cell = (void **)dlsym(RTLD_DEFAULT, "flan.cell.twice"); + if (cell != NULL) *cell = (void *)instead; +} diff --git a/spike/x86/cells.sh b/spike/x86/cells.sh new file mode 100755 index 0000000..cae5481 --- /dev/null +++ b/spike/x86/cells.sh @@ -0,0 +1,59 @@ +#!/usr/bin/env bash +# Does a --x86 --dev build actually call through the indirection cell? +# +# survey.sh cannot answer this and no program can. A dev build begins with +# every cell pointing at the body this build compiled, so it prints exactly +# what a release build prints whether the call reads the cell or ignores it. +# The only way to tell is to change what a cell holds and see whether anything +# notices. +# +# So: cell-override.c is preloaded, and its constructor looks up +# flan.cell.twice with dlsym and stores a different body there. No compiler is +# involved and nothing is redefined in the language's sense -- this is just the +# one store a redefinition ends in, done from outside. +# +# Four builds, and the two controls are half the test: +# +# llvm --dev cell is read -> 22 22 +# x86 --dev cell is read -> 22 22 (this lane's claim) +# llvm no cell -> 42 42 (dlsym answers NULL) +# x86 no cell -> 42 42 +# +# The release rows are what say the change came from the indirection and not +# from ordinary symbol interposition. +set -u +here=$(cd "$(dirname "$0")" && pwd) +root=$(cd "$here/../.." && pwd) +cd "$root" || exit 1 + +dune build --root . bin/main.exe 2>&1 | head -30 +flan=$root/_build/default/bin/main.exe +test -x "$flan" || { echo "build failed"; exit 1; } + +out=$(mktemp -d); trap 'rm -rf "$out"' EXIT +cc -shared -fPIC -o "$out/override.so" "$here/cell-override.c" || exit 1 + +src=$here/p8-cell.flan +fail=0 + +run() { # run