diff --git a/NEXT.md b/NEXT.md index b396cdf..2caec13 100644 --- a/NEXT.md +++ b/NEXT.md @@ -57,11 +57,37 @@ merged; 3 and 4 are still running. 3. **The first ten raylib core examples**, plus the window and input bindings they need. The deliverable is the *language gap list* as much as the ported files — sand.flan is the only real raylib program today, so this is the first time the language is pushed by code it was not designed around. -4. **Names in DWARF.** The two items under "One line away" below, promoted here because the inspector and the - conditions buffer are only as good as what lldb can say: let-bound locals print as `s0`, `s2` because `Tast` refers - to them by slot index and `Check` drops the names, and `Session.eval` never passes the `~debug` that - `Emit.redefinition` already takes and is already tested for. The second also unblocks source interleaving in the - disassembly buffer. +4. **Names in DWARF.** *Done.* `Tast.fn` carries `snames` beside `slots`, so a let-bound local is its own name under + lldb instead of `s0`; a slot the compiler invented keeps `s`, because a synthesized slot has no source name + and inventing one puts a variable in the debugger that is not in the file. Shadowing had to be decided rather than + assumed: every `!DILocalVariable` is scoped to the subprogram — the typed IR has no block structure to build a + `!DILexicalBlock` from — so two slots called `v` left lldb answering `p v` with the outer one while the body computed + with the inner, and not listing the inner at all. A repeat now gets a `~2` suffix, which is unambiguous because `~` + cannot occur in a source symbol. That is a way of not lying, not a way of being right; the real fix is a lexical + block per `Let` and the `llvm.dbg.declare`s moved out of the entry block, and it is the one thing left here. + + And `flan dev --debug` now builds the host *and* every redefinition module with DWARF. One flag, because it is one + decision — measured, not reasoned: a line breakpoint needs a line table on the host to fire before the first + `C-c C-c` and one in each module to still be firing after. Off by default, because a debug build is an `-O0` build + and silently making every reloaded body `-O0` changes the frame time of the function being iterated on. + +**What a dlopen'd redefinition module does to a breakpoint, measured.** lldb picks the new module's DWARF up on the +`dlopen` and says so — "1 location added to breakpoint 3". A breakpoint set by *name* gains a second location either +way, so dlopen was never the difficulty; what the module's line table buys is that it stops with **source** rather than +disassembly, and that a *file and line* breakpoint on the new body resolves at all — it sits at `locations = 0 +(pending)` forever without one. A file-and-line breakpoint on the **host's** copy stays pinned at `locations = 1`, which +is correct rather than stale: the old body is still mapped and every call site that has not gone through its cell again +still reaches it. The stack crosses the boundary intact — a frame in the reloaded `.so` and the frame below it in the +host each name their own `.flan` file. The transcripts are in `emacs/flan-dape.el`, under "Reloading and breakpoints". + +**Source interleaving in the disassembly buffer is unblocked, and not done.** `Dev.asm_of` runs `objdump -d`; with a +`--debug` module `objdump -dS` interleaves the Flan source correctly (verified). What it needs is the `-S` and a +`parse_listing` that tolerates source lines among the instructions. + +**`flan-cnr.el`'s stack pane was refusing for the wrong reason** and now names the real one. DWARF was never the gap: +what is missing is anything *attached* to the stopped program. That buffer reaches it over the daemon's socket, and a +socket cannot read another process's frames — the break loop stopped itself, it is not being debugged. It wants either +an unwinder in the agent or lldb on the same pid. ### Queued — split this file @@ -662,10 +688,6 @@ Sixty mutations, nineteen left the whole suite green. The severe cluster is clos - **`match` over enums.** Fully desugarable, wanted, and blocked only by `Ast.pattern` needing a keyword case, which `load.ml` matches exhaustively. -- **[in flight]** **DWARF for a redefinition module.** `Emit.redefinition` takes `~debug` and is tested; `Session.eval` does not pass - it. That also unblocks source interleaving in the disassembly buffer. -- **[in flight]** **Let-bound locals print as `s0`, `s2`** under lldb. Parameters get their real names; `Tast` refers to the rest by - slot index and `Check` drops the names. - **`Build.executable` returns only `out`**, so the daemon recovers the host `.ll` by recomputing `Build.workdir ()`. ### Deferred with a reason diff --git a/bin/main.ml b/bin/main.ml index a77137e..22d1794 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -202,13 +202,22 @@ let () = against — and it owns the build, which is what makes its layout rules describe the process that is actually running. *) | _ :: "dev" :: path :: rest -> + (* --debug builds the host *and* every module this daemon sends with DWARF, + which is one flag because it is one decision: a line breakpoint in a + .flan buffer needs a line table on the host to fire at all, and one in + 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 + let rest = List.filter (fun a -> not (is_flag a)) rest in let sock = match rest with | [ "-s"; s ] -> s | [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock" - | _ -> prerr_endline "usage: flan dev [-s socket]"; exit 2 + | _ -> + prerr_endline "usage: flan dev [-s socket] [--debug]"; + exit 2 in - with_errors path (fun () -> Flan.Dev.start ~file:path ~sock) + with_errors path (fun () -> Flan.Dev.start ~debug ~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 @@ -216,19 +225,22 @@ let () = is one a running process can be told at all — neither of which a command given only a list of function names could. *) | _ :: "reload" :: prog :: forms :: rest -> + let debug = List.mem debug_flag rest in + let rest = List.filter (fun a -> not (is_flag a)) rest in let out = match rest with | [ "-o"; o ] -> o | [] -> Filename.remove_extension (Filename.basename forms) ^ ".so" | _ -> - prerr_endline "usage: flan reload [-o out.so]"; + prerr_endline + "usage: flan reload [-o out.so] [--debug]"; exit 2 in with_errors forms (fun () -> - let t, _ = Flan.Session.create ~file:prog in + let t, _ = Flan.Session.create ~debug ~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 } 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 diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 525aaa8..9e0d8c6 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -78,9 +78,9 @@ from fixtures, and so `flan-dev.el' is named in one place.") (params . "restart arguments are checked at run time against a frame that does not record its arity [needs a field in the restart frame]") (stack - . "a Flan build carries no frame metadata, so there is nothing to walk the stopped stack with [blocked: needs DWARF]") + . "nothing here is attached to the stopped program. DWARF is not the gap and has not been for a while: `flan build --debug' emits it, `flan dev --debug' now builds the host and every redefinition module with it, and lldb walks a stack that crosses from a reloaded .so back into the host naming both sides' .flan files. But this buffer reaches the program over the daemon's socket, and a socket cannot read another process's frames — the break loop stopped itself, it is not being debugged. So this wants either an unwinder in the agent, beside `flan_rt.c', or lldb attached to the same pid and this buffer reading it [needs one of those two, not DWARF]") (locals - . "reading a stopped frame's locals needs both the frame layout and a renderer aimed at an address rather than at an expression [blocked: needs DWARF, and the same thunk the condition's fields need]")) + . "same reason as the stack above it, plus a renderer aimed at an address rather than at an expression. The names and types are in the DWARF now — a let-bound local is its own name there, not `s0' — so whatever walks the frames can read them; nothing is walking the frames [needs the same attachment, and the same thunk the condition's fields need]")) "Why a section of this buffer is empty, by name.") (defun flan-cnr--why (key) diff --git a/emacs/flan-dape.el b/emacs/flan-dape.el index 84def30..9ab2b31 100644 --- a/emacs/flan-dape.el +++ b/emacs/flan-dape.el @@ -27,8 +27,8 @@ ;; - a --dev build and a --debug build are different builds, and M-x ;; flan-debug does not attach to the program `flan dev' is running; ;; - across a redefinition a breakpoint set by NAME gains a second location -;; and both stay live, while one set by FILE AND LINE stops firing — -;; because the redefinition module carries no DWARF yet. +;; and both stay live; one set by FILE AND LINE follows the reload if the +;; module was built with `flan dev --debug', and does not otherwise. ;;; Code: @@ -207,23 +207,53 @@ common case is one command rather than a config prompt." ;; Both fire, and both are correct — 1.1 is not stale, it is the body the old ;; call sites still run. That is `dape-breakpoint-global', which sets by name. ;; -;; A breakpoint set by FILE AND LINE does not follow, and the reason is not -;; that dape pinned it to an address. It stays at locations = 1 because the -;; redefinition module carries no line table for it to resolve against. Given -;; one it does follow: a pending breakpoint on a file the executable had never -;; heard of went from "no locations (pending)" to "1 location added" the moment -;; a .so with DWARF for that file was dlopened, and stopped with full source. -;; So the gap is exactly one missing thing, and nothing about dlopen. +;; A breakpoint set by FILE AND LINE depends on how the module was built, and +;; the difference is a line table and nothing about dlopen. Both halves were +;; measured against the same host, one redefinition module built each way. ;; -;; That missing thing, by name: `Emit.redefinition' takes a ~debug argument and -;; `Session.eval' does not pass it, so `flan reload' and the `flan dev' daemon -;; build modules without DWARF. Until they do, a reloaded body breaks by name -;; and shows disassembly instead of source, and a line breakpoint in the .flan -;; buffer silently stops firing after the first C-c C-c. lib/session.ml is the -;; dev loop's file and is not this one's to change. +;; Without DWARF in the module the line breakpoint stays where it was: ;; -;; So, for now: debug with `dape-breakpoint-global' if you are also reloading, -;; and use line breakpoints for a program you are only running. +;; 2: file = 'v2local.flan', line = 25, locations = 0 (pending) +;; +;; and the name breakpoint still gains its second location — so dlopen was +;; never the problem — but stops into disassembly, because there is no source +;; to show: +;; +;; frame #0: 0x7ffff7fba190 nodbg-v2.so`flan.bump +;; -> 0x7ffff7fba190 <+0>: pushq %rbx +;; +;; With DWARF in the module, the same breakpoint resolves on the dlopen — lldb +;; prints "1 location added to breakpoint 3" as the module loads — and stops +;; with source and named locals: +;; +;; 3: file = 'v2local.flan', line = 25, locations = 1, resolved = 1 +;; 3.1: where = v2.so`flan.bump + 78 at v2local.flan:25:21, resolved +;; +;; (lldb) frame variable +;; (long) step = 10 +;; (long) prior = 11 +;; +;; The stack crosses the boundary intact, which is the part worth knowing: a +;; frame in the reloaded .so and the frame below it in the host each name their +;; own .flan file, and the C host below both. +;; +;; frame #0: v2.so`flan.bump at v2local.flan:25:21 +;; frame #2: host`flan.outer at reload.flan:38:20 +;; frame #3: host`main at reload_host.c:94:44 +;; +;; A breakpoint set by FILE AND LINE on the *host's* copy stays at locations = 1 +;; and does not move. That is correct rather than stale: the old body is still +;; mapped and every call site that has not gone through the cell again still +;; reaches it, so pinning there is the only honest thing to do. +;; +;; How to get it: `flan dev --debug'. It is one flag on purpose — the host +;; needs a line table for a breakpoint to fire before the first C-c C-c, and +;; each module needs one for it to still be firing after — and it is off by +;; default because a debug build is an -O0 build, which is not what you want +;; under a frame budget unless you asked for it. +;; +;; So: with `flan dev --debug', line breakpoints work across a reload. Without +;; it, debug with `dape-breakpoint-global', which sets by name. (provide 'flan-dape) ;;; flan-dape.el ends here diff --git a/lib/check.ml b/lib/check.ml index b4e2cbf..6a6eb03 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -83,6 +83,11 @@ type ctx = { (* The type of each slot, newest first. A backend needs it to size the frame — nothing else records it, since the IR refers to slots by index. *) mutable slot_tys : Types.t list; + (* The source name of each slot, newest first, parallel to [slot_tys]. + [None] for a slot the checker invented -- see [Tast.fn.snames]. Recorded + here rather than recovered later because this scope list is the only place + that ever knows it. *) + mutable slot_names : string option list; mutable scope : (string * binding) list; (* innermost first *) (* Deferred forms, most recently registered first — which is also the order they run in. At milestone 4 [defer] is function-scoped (see [check_fn]), @@ -111,14 +116,51 @@ type ctx = { owner : string; } -let fresh_slot ctx ty = +(* [?name] is the source name, when there is one. It is optional so that the + several places that allocate a hidden slot say nothing and get [None] -- + a synthesized slot cannot accidentally acquire a name it was never given. *) +let fresh_slot ?name ctx ty = let s = ctx.slots in ctx.slots <- s + 1; ctx.slot_tys <- ty :: ctx.slot_tys; + ctx.slot_names <- name :: ctx.slot_names; s +(* Shadowing is legal -- [(let [v 11] (let [v 22] ...))] is two slots, both + named [v] -- and the debug info has nowhere to put the distinction. Every + [!DILocalVariable] is scoped to the subprogram, because the typed IR has no + block structure for a [!DILexicalBlock] to be built from, so two variables + called [v] land in one flat scope and lldb answers [p v] with whichever it + finds first. Measured, not assumed: it answers with the *outer* one, so it + prints 11 while the body it is stopped in is computing with 22, and the + inner binding is not listed at all. + + That is the one outcome worse than printing [s3]: a name the debugger is + confident about and wrong about. So a repeat of a name already bound in this + function gets a suffix, and both bindings are then visible and unambiguous. + [~] is the reader's delimiter and cannot occur in a source symbol (the same + reason [destructure~nth] is spelled that way), so [v~2] is visibly the + compiler's doing and can never collide with something the programmer wrote. + + This is a way of not lying, not a way of being right: [v] is still the outer + binding everywhere, including inside the inner one's extent. Scoping the + variables properly means emitting a [!DILexicalBlock] per [Let] and moving + the [llvm.dbg.declare]s out of the entry block to the binding sites, which + needs block structure this IR does not carry. *) let bind ctx name bty ~assignable = - let slot = fresh_slot ctx bty in + let taken n = List.exists (fun s -> s = Some n) ctx.slot_names in + let name' = + if not (taken name) then name + else + let rec go k = + let c = Printf.sprintf "%s~%d" name k in + if taken c then go (k + 1) else c + in + go 2 + in + let slot = fresh_slot ~name:name' ctx bty in + (* [ctx.scope] keeps the *source* name: the suffix is a debug-info artifact + and resolving [v] must still find the innermost binding. *) ctx.scope <- (name, { slot; bty; assignable }) :: ctx.scope; slot @@ -573,7 +615,7 @@ and check_handler_bind ctx ?want loc clauses body = (* Its own context: a fresh frame, an empty scope, and no way to reach the enclosing one. *) let hctx = - { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; + { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; owner = "" } in (* The condition crosses as a pointer, because the handler runs while @@ -608,6 +650,7 @@ and check_handler_bind ctx ?want loc clauses body = ctx.env.lifted <- { Tast.name = fname; params = [ Types.Ptr ty ]; slots = Array.of_list (List.rev hctx.slot_tys); + snames = Array.of_list (List.rev hctx.slot_names); ret = Types.Unit; body = hbody; fdefers = []; fparent = Some ctx.owner; floc = c.Ast.hloc } :: ctx.env.lifted; @@ -1509,7 +1552,7 @@ let collect env (decls : Ast.decl list) = not check once no progress is left has a real error, so the last round is run without swallowing it. *) let infer (_, v) = - (check { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } v).Tast.ty in let pending = ref (List.rev !untyped) in @@ -1562,7 +1605,7 @@ let check_finite env = let check_fn env (fn : Ast.fn) : Tast.fn = let params, ret = Hashtbl.find env.fns fn.Ast.name in - let ctx = { env; ret; slots = 0; slot_tys = []; scope = []; defers = []; + let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = fn.Ast.name } in List.iter2 @@ -1632,12 +1675,13 @@ let check_fn env (fn : Ast.fn) : Tast.fn = in { Tast.name = fn.Ast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); + snames = Array.of_list (List.rev ctx.slot_names); (* The same defers again, for the transfer exit path §5 describes. The normal path has them spliced into [body] above. *) ret; body; fdefers = ctx.defers; fparent = None; floc = fn.Ast.nloc } let check_global env (d : Ast.decl) : Tast.global option = - let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } in match d.Ast.d with | Ast.Defvar (n, _, init) -> @@ -1744,10 +1788,12 @@ let program (decls : Ast.decl list) : Tast.program = fst (program_with_env decls (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing function — so the slots it needs are whatever its own [let]s allocate. *) -let expression env (e : Ast.expr) : Tast.expr * Types.t array = +let expression env (e : Ast.expr) : + Tast.expr * Types.t array * string option array = let ctx = - { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } in let t = check ctx e in - (t, Array.of_list (List.rev ctx.slot_tys)) + (t, Array.of_list (List.rev ctx.slot_tys), + Array.of_list (List.rev ctx.slot_names)) diff --git a/lib/dev.ml b/lib/dev.ml index 8a83abd..fac29e9 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -343,7 +343,9 @@ let eval t ~code ~origin = 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 } + (match Build.shared + ~opts:{ Build.default with Build.dev = true; + Build.debug = t.session.Session.debug } ~ir:c.Session.ir ~out () with | timing -> (match deliver t out with @@ -379,7 +381,9 @@ let eval_expr t ~code ~origin = 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 } + (match Build.shared + ~opts:{ Build.default with Build.dev = true; + Build.debug = t.session.Session.debug } ~ir:c.Session.ir ~out () with | _ -> (match deliver t out with @@ -943,7 +947,13 @@ let serve t fd = in go () -let start ~file ~sock = +(* [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 + build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg + 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 start ?(debug = 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 @@ -951,7 +961,7 @@ let start ~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 ~file in + let session, l = Session.create ~debug ~file () in let dir = Filename.concat (Filename.get_temp_dir_name ()) (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) @@ -964,9 +974,15 @@ let start ~file ~sock = 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. *) + (* 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 + 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 + before the first C-c C-c, the module's to follow the reload. *) ignore (Build.executable - ~opts:{ Build.default with Build.dev = true; Build.keep = true } + ~opts:{ Build.default with Build.dev = true; Build.keep = true; + Build.debug } ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); let host_ll = Filename.concat dir "host.ll" in (try diff --git a/lib/emit.ml b/lib/emit.ml index 372a445..455eb27 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1316,20 +1316,30 @@ let signature ~named (fn : Tast.fn) = visibility in a shared object is interposable: [@"flan.bump"] inside the module would resolve to the *host's* copy, so the installer would publish the function it was replacing and the reload would appear to do nothing. *) -(* The name a slot goes into the debug info under. The typed IR refers to - locals by index and nothing records what they were called -- [Check] knows, - in its scope list, and drops it. So a parameter gets the name the source - gave it, recovered by the driver and handed down in [pnames], and everything - else gets [s], which is the slot it actually is. A [let]-bound local - printing as [s4] is a real gap and it is named here rather than papered - over: fixing it means the typed IR carrying the name, which is a change to - [Tast]. *) -let slot_name ~pnames ~nparams i = - if i < nparams then - match List.nth_opt pnames i with - | Some n when n <> "" -> n - | _ -> Printf.sprintf "p%d" i - else Printf.sprintf "s%d" i +(* The name a slot goes into the debug info under. [Tast.fn.snames] carries the + source name of every slot the source named, parameters included, so that is + the answer wherever there is one. + + A slot with no name is one the compiler invented -- [dotimes]'s hidden + bound, the pair (min) and (max) evaluate their operands into -- and it keeps + [s], which is what it actually is. That is deliberate rather than a + fallback: a synthesized slot has no source name to print, and inventing a + plausible one would put a variable in the debugger that the programmer + cannot find in the file. [s4] is honest about being the frame's fourth slot. + + [snames] is indexed defensively because a driver may build a frame by + appending arrays ([Session]'s evaluation thunk does), and a short [snames] + should cost a name, not raise. *) +let slot_name ~pnames ~snames ~nparams i = + let named = if i < Array.length snames then snames.(i) else None in + match named with + | Some n when n <> "" -> n + | _ -> + if i < nparams then + match List.nth_opt pnames i with + | Some n when n <> "" -> n + | _ -> Printf.sprintf "p%d" i + else Printf.sprintf "s%d" i let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = let n = Array.length fn.Tast.slots in @@ -1387,7 +1397,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = dnode d (Printf.sprintf "!DILocalVariable(name: \"%s\"%s, scope: !%d, file: !%d, line: %d, type: !%d)" - (dstr (slot_name ~pnames ~nparams i)) arg sub file f.dline + (dstr (slot_name ~pnames ~snames:fn.Tast.snames ~nparams i)) + arg sub file f.dline (dty m d ty))) fn.Tast.slots) in diff --git a/lib/session.ml b/lib/session.ml index a10d3bb..62999f6 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -36,6 +36,13 @@ type t = { host : Tast.program; (* what the process was built from *) pkgs : Load.pkg list; (* alias, directory, names owned *) mutable thunks : int; (* expression evaluations so far *) + (* Whether the modules this session emits carry DWARF. It belongs to the + session rather than to each call because it has to match the process the + modules are loaded into: a redefinition with debug info, dlopened into a + host built without it, gives a debugger a second module to resolve names + against and nothing to line up the host's own frames with. Both ends are + set from one flag — see [Dev.start]. *) + debug : bool; } let fail = Loc.fail @@ -59,11 +66,11 @@ let rec same_const (a : Tast.expr) (b : Tast.expr) = && List.for_all2 same_const xs ys | _ -> false -let create ~file = +let create ?(debug = false) ~file () = let l = Load.program ~file (Parse.program (Reader.read_file file)) in let p, env = Check.program_with_env l.Load.decls in ({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs; - thunks = 0 }, l) + thunks = 0; debug }, l) (* Which package a file being edited belongs to, if any. @@ -346,7 +353,10 @@ let eval ?(origin = "") t src : change = program.Tast.globals) names in - let ir = Emit.redefinition ~dev:true ~known:(known t) ~consts program ~fns in + let ir = + Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~consts program + ~fns + in let allocates = List.exists (fun (g : Tast.global) -> not (known t g.Tast.gname)) @@ -418,7 +428,7 @@ let eval_expr ?(origin = "") t src : change = | [] -> fail Loc.unknown "nothing to evaluate" | _ :: f :: _ -> fail f.Form.loc "one expression at a time" in - let checked, base = Check.expression t.env (Parse.expr form) in + let checked, base, bnames = Check.expression t.env (Parse.expr form) in (* The thunk's frame starts at whatever [Check.expression] needed and grows as the walk finds slices in it, so the slots the renderer asks for are appended past [base] and collected here to size the frame below. *) @@ -443,7 +453,10 @@ let eval_expr ?(origin = "") t src : change = let name = Printf.sprintf "eval/%d" t.thunks in let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc; - slots = Array.append base (Array.of_list (List.rev !extra)) } + slots = Array.append base (Array.of_list (List.rev !extra)); + (* The expression's own [let]s keep their names; the slots [render] added + behind them are the walk's own scratch and have none to keep. *) + snames = Array.append bnames (Array.make (List.length !extra) None) } in (* Built against the program but never spliced into it: an evaluation is not a declaration, and adding one would leave the session carrying an eval/N @@ -454,6 +467,11 @@ let eval_expr ?(origin = "") t src : change = externs = t.program.Tast.externs @ externs } in let ir = - Emit.redefinition ~dev:true ~known:(known t) ~call:name program ~fns:[ name ] + (* The thunk gets debug info on the same flag as everything else. It is a + 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:[ name ] in { ir; names = []; fns = []; installs = true } diff --git a/lib/tast.ml b/lib/tast.ml index 0ae656a..ae713f3 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -117,6 +117,15 @@ type fn = { name : string; params : Types.t list; (* bound to slots 0 .. n-1, in order *) slots : Types.t array; (* the frame: one entry per slot *) + (* What the source called each slot, parallel to [slots]. [None] is a slot + the compiler made up and no one wrote a name for -- [dotimes]'s hidden + bound, the pair (min) and (max) evaluate their operands into, the slot a + tail expression goes through. Names are otherwise gone from this IR (see + the header); this is the one exception, and it exists so a debug build can + emit a [!DILocalVariable] that says [lo] where the source said [lo]. A + backend is free to ignore it entirely -- nothing is *resolved* through it, + and a slot is still only ever referred to by index. *) + snames : string option array; ret : Types.t; body : expr list; (* The defers again, innermost first. [body] already has them spliced onto diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 8240050..35b6e0a 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1364,11 +1364,11 @@ ERR@7 unexpected token: not the kind the caller was reading (* ptr+len, and shown as ptr+len — there is no owner and no capacity to hide, so two members are the whole truth about a string. *) ("name: \"string\", size: 128", "string"); - (* A let-bound local has no name to keep: the typed IR refers to - slots by index and [Check] drops what they were called, so it is - emitted as the slot it is. Asserted rather than left implicit, - because this is the one honest gap in the picture. *) - ("!DILocalVariable(name: \"s0\"", "a let-bound local, named by its slot"); + (* A let-bound local carries the name the source gave it. [Tast.fn] + records one per slot and [Check] fills it in at the binding, so + [(let [c ...)] is [c] in the debug info and not [s0] -- which is + what it used to be, and was the one honest gap in this picture. *) + ("!DILocalVariable(name: \"c\"", "a let-bound local, named by its source name"); ("!llvm.dbg.cu = ", "the compile unit is registered"); (* Without this LLVM discards every node above, silently. *) ("!{i32 2, !\"Debug Info Version\", i32 3}", "the module flag") ]; @@ -1396,6 +1396,40 @@ ERR@7 unexpected token: not the kind the caller was reading print_endline "FAIL the transfer channel appeared as a local variable" end; + (* The two rules about a name that is not simply the source's own. + + A slot the compiler invented has no source name and keeps [s]: + [dotimes] evaluates its bound once into a hidden slot, and calling that + something plausible would put a variable in the debugger that is not in + the file. [i] is the programmer's and is named; the bound is not. + + And a shadowed name is disambiguated. Every [!DILocalVariable] is scoped + to the subprogram — the typed IR has no block structure to build a + [!DILexicalBlock] from — so two slots both called [v] leave lldb + answering [p v] with whichever it finds first. Measured: it answers with + the outer one, and does not list the inner at all, so the debugger is + confident and wrong. [~] cannot occur in a source symbol, so [v~2] is + unambiguous and visibly the compiler's. The prelude shadows in + [split-next], so this rule is load-bearing for the library too. *) + let ir = + debug_ir "(defn spin [n i32] i32\n\ + \ (let [v 11]\n\ + \ (let [v 22]\n\ + \ (dotimes [i n] (set v (+ v i)))\n\ + \ v)))\n\ + (defn main [] i32 (spin 3))\n" + in + List.iter + (fun (needle, what) -> + if not (contains ir needle) then begin + incr failures; + Printf.printf "FAIL DWARF for %s\n wanted: %S\n" what needle + end) + [ ("!DILocalVariable(name: \"v\"", "the outer of two shadowed bindings"); + ("!DILocalVariable(name: \"v~2\"", "the inner one, disambiguated"); + ("!DILocalVariable(name: \"i\"", "a dotimes counter, which is the source's"); + ("!DILocalVariable(name: \"s4\"", "dotimes' hidden bound, which is not") ]; + (* LLVM's own verifier, over both entry points. String needles cannot see a DISubprogram the compile unit does not reach, or a call without a !dbg inside a function that has debug info — and that second one is a @@ -1568,7 +1602,13 @@ ERR@7 unexpected token: not the kind the caller was reading value the program put there. *) lldb_case "lldb: breakpoint, frames and locals" "programs/debug.flan" [ "flan.tick"; "at debug.flan:"; "flan.main at debug.flan:"; - "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5" ]; + "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5"; + (* And the let-bound local under its own name rather than [s0], which + is the gap this closes. Only the name is claimed here: a name + breakpoint stops on the function's first line, which is before the + [let] has stored anything, so the value at this point is whatever + the frame happened to hold. The value is pinned just below. *) + "(int) bump" ]; (* And the same, with the fields permuted. If the offsets were not following the declaration, the values would land on the wrong names here and nowhere else. *) @@ -1576,6 +1616,26 @@ ERR@7 unexpected token: not the kind the caller was reading "programs/debug-permuted.flan" [ "at debug-permuted.flan:"; "flan.main at debug-permuted.flan:"; "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5" ]; + (* The value, which the case above deliberately does not claim. Every + [!DILocalVariable] is scoped to the whole subprogram and carries the + function's own line, so a let-bound local is nominally in scope from + entry and reads as garbage until its binding runs. Breaking *after* + the binding is what makes the value load-bearing: [bump] is n+1 and n + is 41, so 42 is the only right answer, and a [!DILocalVariable] + attached to the wrong alloca prints something else. That is the check + that a name which is present is also not a lie. *) + let exe = debug_compile "programs/debug.flan" in + let _, text = + lldb_run exe + [ "breakpoint set --file debug.flan --line 20"; "run"; + "frame variable bump" ] + in + if not (contains text "(int) bump = 42") then begin + incr failures; + print_endline "FAIL lldb: a let-bound local's value after its binding"; + print_endline text + end; + (* A dev build routes every call through a cell, so the call site is an indirect call through a mutable global. The frame above it is still the Flan caller with its own line: the indirection is in how the diff --git a/test/test_agent.ml b/test/test_agent.ml index 9627b1b..557c33b 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -67,7 +67,7 @@ let () = through it rather than calling Emit directly is the point: it is what knows [tick] is a name the host has, so the module binds to its cell as a symbol instead of inventing a registry entry nobody publishes. *) - let t, l = Session.create ~file:"programs/agent.flan" in + let t, l = Session.create ~file:"programs/agent.flan" () in (* A dev build, because that is what has cells to install into and exports them. The agent's own C and its -lpthread come from the package. *) @@ -173,7 +173,7 @@ let () = and they differ, so a loop that always took the same restart fails. *) let bsock = tmp "break.sock" and bout = tmp "break.out" in (try Sys.remove bsock with Sys_error _ -> ()); - let bt, bl = Session.create ~file:"programs/break.flan" in + let bt, bl = Session.create ~file:"programs/break.flan" () in let bexe = tmp "break" in ignore (Build.executable ~opts:dev ~csrcs:bl.Load.csrcs ~lflags:bl.Load.lflags diff --git a/test/test_dev.ml b/test/test_dev.ml index d87df25..50ce32f 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -764,6 +764,87 @@ let () = end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ]; + (* --debug, and the half the IR cannot show. + + [test_session.ml] asserts that a debug session *emits* the metadata, + which is the unpassed-argument defect itself. It cannot see the other + half: [Build.shared] is what turns the flag into [-g] and [-O0] on the + module, and a daemon that dropped [Build.debug] from its opts would + still emit perfect IR and then compile it away — [llvm.dbg.declare] + describes an alloca and mem2reg deletes the alloca. So this goes to the + .so the daemon actually wrote and asks the object, not the text. + + The line table is the needle because it is what a breakpoint in a .flan + buffer resolves against, and it names the file the form was typed in + rather than any file on disk. *) + if Sys.command "command -v llvm-dwarfdump > /dev/null 2>&1" = 0 then begin + let gsock = tmp "dbg.sock" and gout = tmp "dbg.out" in + (try Sys.remove gsock with Sys_error _ -> ()); + let gfd = + Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let gpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-repl.flan"; "-s"; gsock; "--debug" |] + Unix.stdin gfd Unix.stderr + in + Unix.close gfd; + if not (await (fun () -> Sys.file_exists gsock)) then begin + fail "the --debug daemon never listened"; + (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect gsock in + let r = + request c + "(:op \"eval\" :code \"(defn step [] i64 (let [n (i64 3)] (set ticks (+ ticks n)) ticks))\" :file \"/tmp/dbg.flan\")" + in + if status r <> "ok" then + fail "a --debug daemon refused an ordinary redefinition: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else begin + (* The daemon builds into /tmp/flan-dev-, one module per eval, + and never reuses a name — dlopen caches by path. The first is + m1.so. *) + let so = + Filename.concat + (Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "flan-dev-%d" gpid)) + "m1.so" + in + if not (Sys.file_exists so) then + fail "the --debug daemon left no module at %s" so + else begin + let dump = tmp "dbg.dwarf" in + let code = + Sys.command + (Printf.sprintf "llvm-dwarfdump --debug-line %s > %s 2>&1" + (Filename.quote so) (Filename.quote dump)) + in + let text = + if code <> 0 then "" + else In_channel.with_open_bin dump In_channel.input_all + in + (try Sys.remove dump with Sys_error _ -> ()); + let has hay needle = + let n = String.length needle and h = String.length hay in + let rec go i = + i + n <= h && (String.sub hay i n = needle || go (i + 1)) + in + n > 0 && go 0 + in + if not (has text "dbg.flan") then + fail + "a --debug daemon's module carries no line table for the form's \ + file, so a line breakpoint would stay pending across C-c C-c" + end + end; + (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] gpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ] + end; + 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" diff --git a/test/test_session.ml b/test/test_session.ml index b2b8281..c5da50b 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -24,7 +24,7 @@ let checked_program file = (Load.program ~file (Parse.program (Reader.read_file file))).Load.decls let refuses ?(file = "programs/reload.flan") name src reason = - let t, _ = Session.create ~file in + let t, _ = Session.create ~file () in match Session.eval t src with | _ -> fail "%s was accepted" name | exception Loc.Error (_, msg) -> @@ -70,7 +70,7 @@ let () = "changes layout"; (* An ordinary redefinition, and what the session works out about it. *) - let t, _ = Session.create ~file:"programs/reload.flan" in + let t, _ = Session.create ~file:"programs/reload.flan" () in let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 5)) counter)" in if not c.Session.installs then fail "a redefined function had nothing to install"; if c.Session.fns <> [ "bump" ] then @@ -83,6 +83,40 @@ let () = if has c.Session.ir "flan_dev_cell" then fail "a name the host has went through the registry"; + (* DWARF in a redefinition module, which is a property of the session and + not of the call. [Emit.redefinition] has taken a ~debug argument all + along and was tested with it; what was missing was anyone passing it, so + every body installed by C-c C-c lost its debug info in a running process. + The defect was one unpassed argument, so the test is that the argument + arrives — asserted on the emitted text, which is the only place it shows. + + Both directions matter. A session that always emitted debug info would + force -O0 on every reloaded body ([Build.shared] does that, and must), + which would change the frame time of the one function being iterated on. + Off unless asked for is the behaviour, so off is asserted too. *) + let dt, _ = Session.create ~debug:true ~file:"programs/reload.flan" () in + let dc = + Session.eval dt + "(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))" + in + if not (has dc.Session.ir "!DILocalVariable(name: \"step\"") then + fail "a debug session's redefinition carries no name for its local"; + if not (has dc.Session.ir "!DISubprogram(name: \"bump\"") then + fail "a debug session's redefinition carries no subprogram"; + let pt, _ = Session.create ~file:"programs/reload.flan" () in + let pc = + Session.eval pt + "(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))" + in + if has pc.Session.ir "!DILocalVariable" then + fail "a plain session's redefinition carries debug info it was not asked for"; + + (* The same for an expression evaluation, which takes the other path out of + the session and so can lose the flag on its own. *) + let ec = Session.eval_expr dt "(+ counter 1)" in + if not (has ec.Session.ir "!DISubprogram") then + fail "a debug session's eval thunk carries no debug info"; + (* A form that does not check must leave the session exactly as it was. This is the one that decides whether a REPL survives a typo. *) (match Session.eval t "(defn bump [] i64 nonsense)" with @@ -141,7 +175,7 @@ let () = (* A file with imports, re-evaluated whole — the C-c C-k case. The session keeps the *expanded* declarations, so the package's names are replaced in place rather than appended a second time and rejected as duplicates. *) - let t, _ = Session.create ~file:"../sand.flan" in + let t, _ = Session.create ~file:"../sand.flan" () in let src = In_channel.with_open_bin "../sand.flan" In_channel.input_all in (match Session.eval t src with | c -> @@ -157,7 +191,7 @@ let () = importer and written nowhere in the file, so the path is the only thing that can decide it — which is why it is derived here and not sent by the editor. *) - let t, _ = Session.create ~file:"../sand.flan" in + let t, _ = Session.create ~file:"../sand.flan" () in (match Session.eval ~origin:"../vendor/agent/agent.flan" t "(defn poll [] i32 (poll-raw))" @@ -172,7 +206,7 @@ let () = member of a directory, so matching on the directory alone would answer "not a package" — and the failure is the silent one above: the form splices as a bare [step] and the running program keeps the one it had. *) - let t2, _ = Session.create ~file:"programs/sand-headless.flan" in + let t2, _ = Session.create ~file:"programs/sand-headless.flan" () in (match Session.eval ~origin:"../sand.flan" t2 "(defn step [] Unit (do))" with | c -> if c.Session.fns <> [ "sand/step" ] then @@ -194,7 +228,7 @@ let () = must not take a registry slot either — there are 4096 of those and an expression evaluated in a loop would exhaust them. A module that publishes a body can never say this; its whole purpose is to leave a pointer. *) - let t, _ = Session.create ~file:"programs/reload.flan" in + let t, _ = Session.create ~file:"programs/reload.flan" () in let e = Session.eval_expr t "(+ 1 2)" in if not (has e.Session.ir "@flan_reload_transient") then fail "an expression's module did not declare itself unloadable";