diff --git a/bin/main.ml b/bin/main.ml index 9cd06fb..a77137e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -38,6 +38,25 @@ let load path : Flan.Load.t = let checked path = Flan.Check.program (load path).decls +(* What the source called each parameter, per function. The typed IR refers to + locals by slot index and records no names — [Check] has them in its scope + list and drops them — so the debug info would otherwise print [p0] for + every argument. Slots 0..n-1 are the parameters in order ([Tast.fn]), which + is what makes this recoverable here, from declarations that are already in + hand, rather than needing a change to the typed IR. It stops at the + parameters: a let-bound local's name is genuinely not available without one. + Only gathered for a debug build. *) +let param_names (l : Flan.Load.t) = + List.filter_map + (fun (d : Flan.Ast.decl) -> + match d.Flan.Ast.d with + | Flan.Ast.Defn fn -> + Some (fn.Flan.Ast.name, + List.map (fun (p : Flan.Ast.field) -> p.Flan.Ast.fname) + fn.Flan.Ast.params) + | _ -> None) + l.Flan.Load.decls + (* Bounds checks are on unless a build asks for them off — the release decision, not the optimisation level (NEXT.md, Bounds checks). *) let no_checks_flag = "--no-bounds-checks" @@ -47,7 +66,13 @@ let no_checks_flag = "--no-bounds-checks" so a loaded module can reach them (NEXT.md, the dev loop). *) let dev_flag = "--dev" -let flags = [ no_checks_flag; dev_flag ] +(* Source-level debugging: DWARF in the IR, -g on the C, and -O0 forced. + Its own flag and not a mode of --dev, because the two answer different + questions — --dev is "can I redefine this while it runs", --debug is "can I + stop it and read it". See [Build.opts]. *) +let debug_flag = "--debug" + +let flags = [ no_checks_flag; dev_flag; debug_flag ] (* [--target=wasm32-wasi], the one cross target. Unlike the flags above it carries a value, so it is matched by prefix and stripped from the residual @@ -127,15 +152,21 @@ let () = | _ :: "emit" :: args when List.exists (fun a -> not (is_flag a)) args -> let checks = not (List.mem no_checks_flag args) in let dev = List.mem dev_flag args in + let debug = List.mem debug_flag args in let files = List.filter (fun a -> not (is_flag a)) args in List.iter (fun path -> with_errors path (fun () -> - checked path |> Flan.Emit.program ~checks ~dev |> print_string)) + let l = load path in + let pnames = if debug then param_names l else [] in + Flan.Check.program l.decls + |> Flan.Emit.program ~checks ~dev ~debug ~pnames + |> 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 debug = List.mem debug_flag rest in let target = target_of rest in let out = match List.filter (fun a -> not (is_flag a)) rest with @@ -150,7 +181,7 @@ let () = | _ -> prerr_endline "usage: flan build [-o out] [--no-bounds-checks] \ - [--dev] [--target=wasm32-wasi]"; + [--dev] [--debug] [--target=wasm32-wasi]"; exit 2 in with_errors path (fun () -> @@ -162,8 +193,9 @@ let () = raylib and still be buildable for wasm32. *) let p, csrcs, lflags = Flan.Reach.link ~dev l p in ignore (Flan.Build.executable - ~opts:{ Flan.Build.default with checks; dev; target } - ~csrcs ~lflags p ~out)) + ~opts:{ Flan.Build.default with checks; dev; debug; target } + ~csrcs ~lflags ~pnames:(if debug then param_names l else []) + p ~out)) (* The daemon an editor talks to: one session, the program it belongs to running beside it, and a socket. Unlike [flan reload] the session persists, so a defvar added by one evaluation is part of what the next one is checked @@ -228,7 +260,7 @@ let () = prerr_endline "usage: flan (read|parse|check|emit|shim) ...\n\ \ flan build [-o out] [--no-bounds-checks] [--dev] \ - [--target=wasm32-wasi]\n\ + [--debug] [--target=wasm32-wasi]\n\ \ flan run [args...]\n\ \ flan reload [-o out.so]\n\ \ flan dev [-s socket]"; diff --git a/lib/build.ml b/lib/build.ml index 6bd3a2c..48df980 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -59,6 +59,19 @@ type opts = { 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; + (* DWARF in the .ll and -g on the C, so lldb can put a breakpoint on a Flan + function by name and print its locals. + + Its own axis, and deliberately not implied by -O0. The acceptance table + runs the same programs at -O0 and -O2 to compare the emitted IR against + what mem2reg makes of it, and if -O0 pulled in debug info every one of + those comparisons would be against a different module. It is not implied + by [dev] either: a dev build is about reloading, this is about reading, + and either is useful without the other. What it *does* imply, downwards, + is -O0 -- see [executable], where it sets [opt] -- because the whole + mechanism is a [llvm.dbg.declare] on an alloca and mem2reg deletes the + alloca. *) + debug : bool; } (* Checks are deliberately independent of [opt]: the acceptance table runs the @@ -66,7 +79,8 @@ type opts = { 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; dev = false } + { target = None; opt = "-O2"; keep = false; checks = true; dev = false; + debug = false } (* ── wasm32, which needs more than a triple ────────────────────────── The native target is whatever clang was built for, so [--target=] alone is @@ -264,6 +278,7 @@ let compile_c ~opts ?tflags ~src ~name () = (Digest.string (String.concat "\000" [ name; src; Lazy.force clang_stamp; opts.opt; + (if opts.debug then "-g" else ""); String.concat " " tflags ])) in let obj = Filename.concat (cachedir ()) (key ^ ".o") in @@ -276,7 +291,9 @@ let compile_c ~opts ?tflags ~src ~name () = let tmp = Printf.sprintf "%s.%d.tmp" obj (Unix.getpid ()) in let cmd = String.concat " " - ([ Filename.quote clang; opts.opt; "-c" ] @ tflags + ([ Filename.quote clang; opts.opt ] + @ (if opts.debug then [ "-g" ] else []) + @ [ "-c" ] @ tflags @ [ Filename.quote c; "-o"; Filename.quote tmp ]) in let code = Sys.command cmd in @@ -290,7 +307,7 @@ let compile_c ~opts ?tflags ~src ~name () = (* [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 it binds to. *) -let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) +let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) (p : Tast.program) ~out = (* A dev build is the REPL's, and the REPL reaches a running process through [-rdynamic] and [dlopen]. Neither exists on wasm32, so the combination is @@ -299,10 +316,25 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) failwith "wasm32: --dev is native only — the reload path is dlopen, which wasm32 \ has no equivalent of"; + (* Refused rather than emitted-and-hoped-for. The member offsets in the DWARF + are computed for the host's layout — [ptr] 8 bytes — and wasm32's pointer + is 4, so a slice's [len] is at byte 8 there and at byte 16 here. Emitting + the host numbers would give a debugger a confident wrong answer for every + slice and every struct holding one, which is the failure this project + keeps meeting at the FFI boundary. *) + if wasm_target opts && opts.debug then + failwith + "wasm32: --debug is native only — the DWARF member offsets are computed \ + for the host's layout, and wasm32's 32-bit pointer moves every one of \ + them"; + (* -O0 is not a choice a debug build offers: [llvm.dbg.declare] describes an + alloca, and at -O2 mem2reg deletes the alloca. *) + let opts = if opts.debug then { opts with opt = "-O0" } else opts in let tflags = target_flags opts in let dir = workdir () in let ll = Filename.concat dir (Filename.basename out ^ ".ll") in - write ll (Emit.program ~checks:opts.checks ~dev:opts.dev p); + write ll + (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames p); (* [flan_dev.c] is compiled into every build, not only a dev one. Nothing in a release build calls into it — the compiler only emits a registry lookup for a name the host was not built with, which cannot arise without cells — @@ -313,6 +345,9 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) space and not binary size, and [-rdynamic] and the cells are still what [--dev] means. *) let cc src name = compile_c ~opts ~tflags ~src ~name () in + (* The runtime's own C wants -g too, or a backtrace that passes through + flan_error lands in a frame with no line. The flag is part of the object + cache key via [compile_c]'s [opt]/[tflags] digest — see [cflags]. *) let objs = cc Runtime_src.source "flan_rt.c" :: [ cc Runtime_src.dev_source "flan_dev.c" ] @@ -332,6 +367,9 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) let cmd = String.concat " " ([ Filename.quote clang; opts.opt; "-Wno-override-module" ] + (* -g at the link so clang does not strip, and keeps the object files' + debug sections; the .ll carries its own. *) + @ (if opts.debug then [ "-g" ] else []) @ (if opts.dev then [ "-rdynamic" ] else []) @ tflags @ [ Filename.quote ll ] @@ -387,6 +425,7 @@ let run what cmd = if code <> 0 then failwith (Printf.sprintf "%s failed (exit %d)" what code) let shared ?(opts = default) ~ir ~out () : timing = + let opts = if opts.debug then { opts with opt = "-O0" } else opts in if wasm_target opts then failwith "wasm32: the reload path is native only — it is llc + ld -shared + \