flan dev --x86: the host and its modules, chosen together
Item 3, and the reason the backend was written. Until now --x86 was read only by flan build's argument list; the daemon built both halves through LLVM, so none of this reached the dev loop at all. 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 change the session emits. session.ml's comment on [debug] already 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. Session.change carries the answer beside the text, so the builder and the text can never come from two different decisions. There is no fallback and there must not be one. X86.redefinition refusing a form is reported to the editor; 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 session 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; the aggregate handoff's two-line reproduction no longer has a second half. And the finding: flan dev --x86 refuses the merged daemon. A merged build is the program and the compiler in one process, and the compiler expands macros by dlopening a module Build.macro_module made through Emit.program, cached on disk by the macro source rather than by the backend. The merged host is linked -rdynamic so a redefinition module can reach its cells, which also 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 nobody notices. With an --x86 host the caller is LLVM and the body it lands in is this backend's, and the process dies inside flan.[clamp] during the first macro expansion, before the program has started. flan.abi.x86 does not catch it and was never meant to: a macro module deliberately neither defines nor requires a marker. 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. Until then the refusal names the mechanism and the remedy, and --two-process has no such meeting. start_merged keeps its --x86 plumbing, unreachable for now, because it is the half that is right and will be wanted the day the macro module is fixed. test_dev.ml drives an --x86 daemon through C-c C-c, C-x C-e, a literal, a new defvar with a value of its own and a new defn, and asserts (twice fresh) is 82 -- which only holds if both registry lookups resolved. The merged refusal is asserted there too. bin/main.ml learned to print a bare Failure as a sentence rather than an uncaught exception and its backtrace.
This commit is contained in:
parent
5b1567c49f
commit
f182fb4728
53
bin/main.ml
53
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 <program.flan> [-s socket] [--debug] [--two-process]";
|
||||
"usage: flan dev <program.flan> [-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 <program.flan> <forms.flan> [-o out.so] [--debug]";
|
||||
"usage: flan reload <program.flan> <forms.flan> [-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 <file.flan> [-o out] [--no-bounds-checks] [--dev] \
|
||||
[--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\
|
||||
\ flan run <file.flan> [args...]\n\
|
||||
\ flan reload <program.flan> <forms.flan> [-o out.so]\n\
|
||||
\ flan dev <program.flan> [-s socket]";
|
||||
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
|
||||
\ flan dev <program.flan> [-s socket] [--x86]";
|
||||
exit 2
|
||||
|
||||
182
lib/dev.ml
182
lib/dev.ml
@ -418,6 +418,29 @@ let error ?loc msg =
|
||||
^ (match loc with None -> "" | 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 ()
|
||||
|
||||
@ -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 = "<eval>") ?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 = "<eval>") ?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 = "<eval>") ?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 = "<locals>") 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 = "<inspect>") 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 = "<globals>") 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 = "<eval>") ?(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 = "<eval>") ?(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 ──────────────────────────────────── *)
|
||||
|
||||
|
||||
100
test/test_dev.ml
100
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"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user