From bd5892eccd6ced35029fc7a55a192a8f0c765f8b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:50:44 +0700 Subject: [PATCH] Keep the text each body was built from A module's .ll is deleted by the build and the host's lives in a working directory named after the process rather than the module, so ten reloads in there is nothing left on disk that says what a given function was compiled from. The daemon owns the build and is the only thing that could have kept it, so it keeps it: one .ll beside each .so, and a table from function name to the last module that carried a body for it. --- lib/dev.ml | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 67 insertions(+), 2 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index 7ec16d6..69695e6 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -13,6 +13,16 @@ only if it is the session that compiled it. So the daemon launches the program rather than attaching to one. *) +(* Where a function's body was last built. The daemon owns the build, so it is + the only thing that can answer "which module defines this name now" — but + see [basis] below for what that answer honestly is. *) +type origin = { + ogen : int; (* reload generation; 0 is the host's *) + oso : string; (* the object the body was linked into *) + oll : string; (* the IR it was built from *) + oloc : string; (* where the source it came from was written *) +} + type t = { session : Session.t; child : int; (* the running program *) @@ -21,6 +31,12 @@ type t = { stdout : Unix.file_descr; (* the program's output, on its way to here *) out : Buffer.t; (* ...buffered until an editor asks for it *) mutable n : int; (* dlopen caches by path: never reuse one *) + (* Bookkeeping for disassembly, and the reason it can exist at all: the + daemon compiled every module it sent, so the .ll and the .so are on its + own disk. What it does not have is a way back into the process's cells. *) + mutable gen : int; (* accepted deliveries, in order *) + owners : (string, origin) Hashtbl.t; (* fn name -> the last module sent *) + host_ll : string; (* the IR the running program was built from *) } (* The program's stdout is a pipe into this process, so that an editor can see @@ -199,6 +215,29 @@ let alive t = | _ -> false | exception Unix.Unix_error _ -> false +(* ── What a body was built from ─────────────────────────────────────── *) + +let write_file path text = + let oc = open_out_bin path in + Fun.protect ~finally:(fun () -> close_out oc) (fun () -> output_string oc text) + +let read_file path = + let ic = open_in_bin path in + Fun.protect + ~finally:(fun () -> close_in ic) + (fun () -> really_input_string ic (in_channel_length ic)) + +let find_fn t name = + List.find_opt + (fun (f : Tast.fn) -> + String.equal f.Tast.name name && f.Tast.fparent = None) + t.session.Session.program.Tast.fns + +let fn_loc t name = + match find_fn t name with + | Some f -> Loc.to_string f.Tast.floc + | None -> "" + (* ── Ops ───────────────────────────────────────────────────────────── *) (* Every reply is a plist with a :status, so an editor can dispatch on one key @@ -258,11 +297,24 @@ let eval t ~code ~origin = | c -> t.n <- t.n + 1; let out = Filename.concat t.dir (Printf.sprintf "m%d.so" t.n) in + (* [Build.shared] deletes its own .ll unless asked to keep it, and what it + keeps is in a working directory named after this process rather than + 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 + write_file ll c.Session.ir; (match Build.shared ~opts:{ Build.default with Build.dev = true } ~ir:c.Session.ir ~out () with | timing -> (match deliver t out with | "ok" -> + t.gen <- t.gen + 1; + List.iter + (fun n -> + Hashtbl.replace t.owners n + { ogen = t.gen; oso = out; oll = ll; oloc = fn_loc t n }) + c.Session.fns; ok [ ":names " ^ Wire.strings c.Session.names; ":fns " ^ Wire.strings c.Session.fns; @@ -511,9 +563,21 @@ let start ~file ~sock = in (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); let exe = Filename.concat dir "program" in + (* [keep] so the host's own IR survives the build. It is the text [llc] was + actually given, not a second emission of it, which is the difference + between showing what the process was built from and showing what it + probably was. [Build.executable] leaves it in its own working directory + under the module's basename; it is moved here so that nothing else in this + process can reuse the name. *) ignore - (Build.executable ~opts:{ Build.default with Build.dev = true } + (Build.executable + ~opts:{ Build.default with Build.dev = true; Build.keep = true } ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); + let host_ll = Filename.concat dir "host.ll" in + (try + Sys.rename (Filename.concat (Build.workdir ()) (Filename.basename exe ^ ".ll")) + host_ll + with Sys_error _ -> ()); let agent = Filename.concat dir "agent.sock" in (* The program's source names some socket path; the daemon is the one that @@ -538,7 +602,8 @@ let start ~file ~sock = end; let t = - { session; child; agent; dir; stdout = rd; out = Buffer.create 4096; n = 0 } + { session; child; agent; dir; stdout = rd; out = Buffer.create 4096; n = 0; + gen = 0; owners = Hashtbl.create 32; host_ll } in (try Unix.unlink sock with Unix.Unix_error _ -> ()); let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in