A dev session that ends cleanly takes its directories with it, and Build.executable says where the IR it kept is

This commit is contained in:
Joseph Ferano 2026-09-25 07:28:34 +07:00
parent 37ccca56a3
commit 54ec52fde6
3 changed files with 83 additions and 33 deletions

View File

@ -1465,11 +1465,14 @@ in a merged build that process is the program, the compiler and the listener at
once. It reported as a connection refusal on a path that plainly existed, which once. It reported as a connection refusal on a path that plainly existed, which
misdirected two investigations. misdirected two investigations.
** TODO The daemon leaves its temp directory behind ** DONE The daemon leaves its temp directory behind
About seven megabytes a session, and nothing removes it. Two deliberate non-goals CLOSED: [2026-09-25]
when it is fixed: not on a crash, because the directory is the post-mortem, and A session that ends cleanly — =close=, or the editor gone past the grace —
never another session's directory, because a stale pid is not proof of anything. removes =flan-dev-<pid>= (program, modules, agent socket) and its own
The agent socket goes with it. =Build.workdir=. Kept on a crash: the accept loop raising, or a two-process
child killed by a signal. Only the two paths named for this pid are touched;
nothing sweeps other sessions' directories. =flan build= and =flan run= still
leave an empty =flan-<pid>= each; that is not this entry.
** DONE (agent/start) takes no argument, and binds before main ** DONE (agent/start) takes no argument, and binds before main
CLOSED: [2026-09-20] CLOSED: [2026-09-20]
@ -2010,9 +2013,12 @@ go through one helper. The CLI loads through its own path and checks with a
different entry point, so this is not a matter of calling the test module from the different entry point, so this is not a matter of calling the test module from the
binary — closing it means the pipeline moving into the library. binary — closing it means the pipeline moving into the library.
** TODO Build.executable returns only its output path ** DONE Build.executable returns only its output path
The daemon recovers the host's IR file by recomputing the working directory. One CLOSED: [2026-09-25]
line away: return the path rather than recomputing it. It returns the output path and, under =keep=, the path of the IR or assembly
it kept; without =keep= that file is gone and the second half is =None=. The
two-process daemon moves the host's IR from the path it is given and no longer
recomputes =Build.workdir=.
** TODO The 2MB OFL font is not vendored ** TODO The 2MB OFL font is not vendored
One example wants a font that is OFL and redistributable; it says on screen when One example wants a font that is OFL and redistributable; it says on screen when

View File

@ -729,7 +729,11 @@ let compile_c ~opts ?tflags ?(warn = []) ~src ~name () =
(* [csrcs] and [lflags] come from the imported packages (see [Load]): the C (* [csrcs] and [lflags] come from the imported packages (see [Load]): the C
shim a package binds through, and the arguments needed to link the library shim a package binds through, and the arguments needed to link the library
it binds to. *) it binds to.
Returns the output path and, when [opts.keep] asked for it, the path of the
IR (or, under [x86], the assembly) the build was made from. Without [keep]
that file is removed before this returns, so there is no path to give. *)
let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
(p : Tast.program) ~out = (p : Tast.program) ~out =
(* The JS dialect leaves here, before anything that assumes a clang. Its (* The JS dialect leaves here, before anything that assumes a clang. Its
@ -749,7 +753,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
if opts.x86 then if opts.x86 then
failwith "js: --x86 and --target=js are two different backends — pick one"; failwith "js: --x86 and --target=js are two different backends — pick one";
write out (Js.program ~checks:opts.checks p); write out (Js.program ~checks:opts.checks p);
out (out, None)
end end
else else
(* A dev build is the REPL's, and the REPL reaches a running process through (* A dev build is the REPL's, and the REPL reaches a running process through
@ -943,8 +947,11 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
let code = Sys.command cmd in let code = Sys.command cmd in
if code <> 0 then if code <> 0 then
failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll); 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 _ -> ()); if opts.keep then (out, Some ll)
out else begin
(try Sys.remove ll with Sys_error _ -> ());
(out, None)
end
(* ── The dev path: one function into a loadable object ──────────────── *) (* ── The dev path: one function into a loadable object ──────────────── *)

View File

@ -64,6 +64,10 @@ type t = {
again ([eval]) and when a re-run is accepted ([rerun]), so the next park again ([eval]) and when a re-run is accepted ([rerun]), so the next park
is a new one and gets the whole sentence. *) is a new one and gets the whole sentence. *)
mutable park_noted : bool; mutable park_noted : bool;
(* How the two-process daemon's child ended, once [liveness] has reaped it.
A signal here is a crash, and a crash keeps [dir] on disk: see
[remove_session_dirs]. *)
mutable died : Unix.process_status option;
} }
(* The program's stdout is a pipe into this process, so that an editor can see (* The program's stdout is a pipe into this process, so that an editor can see
@ -597,7 +601,7 @@ let liveness t =
Some Some
(match Unix.waitpid [ Unix.WNOHANG ] child with (match Unix.waitpid [ Unix.WNOHANG ] child with
| 0, _ -> true | 0, _ -> true
| _ -> false | _, status -> t.died <- Some status; false
| exception Unix.Unix_error _ -> false) | exception Unix.Unix_error _ -> false)
in in
liveness_of ~child_alive ~finished:t.finished ~program:(Program.state ()) liveness_of ~child_alive ~finished:t.finished ~program:(Program.state ())
@ -4241,6 +4245,29 @@ let accept_loop ?grace t ls =
in in
go () go ()
(* A session that ended cleanly takes its directories with it: [t.dir], which
holds the program, every module it was sent and the agent's socket, and
[Build.workdir], which holds what the builds left there. Both are named for
this process's pid, so both are this session's and no other's. Nothing looks
further than those two paths — a stale pid in another directory's name is
not proof that its session is over.
Called only on the way out of a clean end. A crash leaves both where they
are, because they are what there is to look at afterwards: the IR the
program was built from and the modules it was running. *)
let remove_session_dirs t =
let rec remove path =
match (Unix.lstat path).Unix.st_kind with
| Unix.S_DIR ->
Array.iter (fun n -> remove (Filename.concat path n))
(try Sys.readdir path with Sys_error _ -> [||]);
(try Unix.rmdir path with Unix.Unix_error _ -> ())
| _ -> (try Unix.unlink path with Unix.Unix_error _ -> ())
| exception Unix.Unix_error _ -> ()
in
remove t.dir;
remove (Build.workdir ())
(* [debug] is off by default, which keeps [flan dev] exactly what it was: a (* [debug] is off by default, which keeps [flan dev] exactly what it was: a
-O2 host and -O2 modules. It is opt-in rather than always-on because a debug -O2 host and -O2 modules. It is opt-in rather than always-on because a debug
build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg
@ -4266,28 +4293,26 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
actually given, not a second emission of it, which is the difference actually given, not a second emission of it, which is the difference
between showing what the process was built from and showing what it between showing what the process was built from and showing what it
probably was. [Build.executable] leaves it in its own working directory 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 and says where; it is moved here so that nothing else in this process can
process can reuse the name. *) reuse the name. *)
(* The host and the modules are one decision. DWARF in a redefinition is (* The host and the modules are one decision. DWARF in a redefinition is
only half a debuggable dev loop: lldb re-resolves a *name* breakpoint only half a debuggable dev loop: lldb re-resolves a *name* breakpoint
against each module as it loads either way, but a breakpoint set on a line against each module as it loads either way, but a breakpoint set on a line
in the .flan buffer needs a line table on both sides — the host's to fire in the .flan buffer needs a line table on both sides — the host's to fire
before the first C-c C-c, the module's to follow the reload. *) before the first C-c C-c, the module's to follow the reload. *)
ignore let _, kept =
(Build.executable Build.executable
~opts:{ Build.default with Build.dev = true; Build.keep = true; ~opts:{ Build.default with Build.dev = true; Build.keep = true;
Build.debug; Build.x86 } Build.debug; Build.x86 }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe
in
(* Host and modules are chosen together, which is the whole licence: an (* Host and modules are chosen together, which is the whole licence: an
[--x86] host gets [--x86] modules because one flag set both, and the [--x86] host gets [--x86] modules because one flag set both, and the
source [Build.executable] kept is assembly rather than IR. *) source [Build.executable] kept is assembly rather than IR. *)
let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
(try (match kept with
Sys.rename | Some src -> (try Sys.rename src host_ll with Sys_error _ -> ())
(Filename.concat (Build.workdir ()) | None -> ());
(Filename.basename exe ^ if x86 then ".s" else ".ll"))
host_ll
with Sys_error _ -> ());
let agent = Filename.concat dir "agent.sock" in let agent = Filename.concat dir "agent.sock" in
(* The program's source names some socket path; the daemon is the one that (* The program's source names some socket path; the daemon is the one that
@ -4337,7 +4362,7 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
{ session; child = Some child; agent; dir; stdout = rd; { session; child = Some child; agent; dir; stdout = rd;
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false; agent_watch = None; host_ll; host_exe = exe; finished = false; agent_watch = None;
park_noted = false } park_noted = false; died = None }
in in
ignore_sigpipe (); ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
@ -4352,7 +4377,13 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
(try Unix.close ls with Unix.Unix_error _ -> ()); (try Unix.close ls with Unix.Unix_error _ -> ());
(try Unix.close rd with Unix.Unix_error _ -> ()); (try Unix.close rd with Unix.Unix_error _ -> ());
(try Unix.unlink sock with Unix.Unix_error _ -> ())) (try Unix.unlink sock with Unix.Unix_error _ -> ()))
(fun () -> accept_loop t ls) (fun () -> accept_loop t ls);
(* Here only when the loop returned: an exception out of it has already
left through the [finally]. A child killed by a signal is the crash that
keeps the directory. *)
match t.died with
| Some (Unix.WSIGNALED _) -> ()
| _ -> remove_session_dirs t
(* ── One process: the program and the compiler in the same binary ──── *) (* ── One process: the program and the compiler in the same binary ──── *)
@ -5172,7 +5203,7 @@ let merged_setup () =
{ session; child = None; agent; dir; stdout = rd; { session; child = None; agent; dir; stdout = rd;
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false; agent_watch = None; host_ll; host_exe = exe; finished = false; agent_watch = None;
park_noted = false } park_noted = false; died = None }
in in
ignore_sigpipe (); ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
@ -5228,12 +5259,18 @@ let merged_serve () =
this process. See [agent_check] for where the sentence is said now, and this process. See [agent_check] for where the sentence is said now, and
[eval] for what a delivery to such a program honestly reports. *) [eval] for what a delivery to such a program honestly reports. *)
t.agent_watch <- Some (Unix.gettimeofday () +. 10.); t.agent_watch <- Some (Unix.gettimeofday () +. 10.);
(match accept_loop t ls with let clean =
| () -> () match accept_loop t ls with
| () -> true
| exception e -> | exception e ->
Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e)); Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e);
false
in
(try Unix.close ls with Unix.Unix_error _ -> ()); (try Unix.close ls with Unix.Unix_error _ -> ());
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
(* The program is this process, so a program that crashed never gets here;
the one end that does and is not clean is the loop raising. *)
if clean then remove_session_dirs t;
(* [close] from the editor ends the session, and so now does an editor that (* [close] from the editor ends the session, and so now does an editor that
stopped being there; in one process either means the program too — which stopped being there; in one process either means the program too — which
is what the daemon did by killing its child. [_exit] for the loader-lock is what the daemon did by killing its child. [_exit] for the loader-lock