From 23b144178a130710e7a216711a6a6729a9bcfa39 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 12:12:40 +0700 Subject: [PATCH] A dev build's frame records the call it is in, so a backtrace names the call each caller is making and the expression the innermost one stopped at --- emacs/flan-cnr.el | 4 ++-- emacs/test-flan-cider.el | 2 +- lib/emit.ml | 44 ++++++++++++++++++++++++++++++++++----- lib/x86.ml | 29 +++++++++++++++++++++++--- runtime/flan_dev.c | 14 +++++++++++++ test/test_dev.ml | 21 ++++++++++++------- vendor/agent/flan_agent.c | 16 +++++++++++++- 7 files changed, 110 insertions(+), 20 deletions(-) diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 5a206ed7..86391aca 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -630,8 +630,8 @@ puts the likely culprit on top." "the stop"))) (defun flan-cnr-visit () - "Visit the source of the frame, or of the stop, on this line. -A frame's location is where its function is written; the stop's is the + "Visit the source of the frame, the restart or the stop on this line. +A frame's location is where it is: the call it is in, or for the innermost the expression that stopped." (interactive) (let ((loc (get-text-property (point) 'flan-cnr-loc)) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index bd21ad90..ffc7442a 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -1338,7 +1338,7 @@ would be overwritten. Look again and re-do the edit") (flan-cnr-toggle-prelude) (test-flan--check "and P hides them again" (not (string-match-p "0: > pause" (buffer-string)))) - ;; RET on a frame goes to where its function is written. + ;; RET on a frame goes to its location. (goto-char (point-min)) (search-forward " 2: > main") (save-window-excursion diff --git a/lib/emit.ml b/lib/emit.ml index 03a6645d..3beca398 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -197,8 +197,12 @@ module Rt = struct [ "name", Ptr; "namelen", I64; "loc", Ptr; "loclen", I64; "nslots", I32; "slots_fp", I32; "refs_fp", I32 ] } + (* [at] is the call this frame is in: the site of the last Flan call it + made, as a NUL-terminated file:line:col, stored after the arguments and + before the call. Null until the first. *) let flanframe = - { sname = "flanframe"; fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr ] } + { sname = "flanframe"; + fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr ] } let align_up n a = (n + a - 1) / a * a @@ -1623,6 +1627,18 @@ let fi_bytes m s = id (String.length s) (escape s)); id, String.length s +(* A call site for a frame's [at], NUL-terminated because it is one pointer + stored per call and the reader takes its length. Counted on [m.nfi] for + [fi_bytes]' reason: the frame naming it is popped before the module could + go, and the break loop copies the text. *) +let fi_cstring m s = + let id = Printf.sprintf "@\".fi.%d\"" m.nfi in + m.nfi <- m.nfi + 1; + Buffer.add_string m.strs + (Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\\00\"\n" + id (String.length s + 1) (escape s)); + id + (* What the two ends compare about a frame's slots, since neither can see the other. Same idea as a restart frame's [rsig_id], and for the same reason: a frame on the stack was compiled from *some* body, the session holds @@ -2263,8 +2279,8 @@ and value_at f (e : Tast.expr) : string = | Tast.Call (name, args) -> (match Hashtbl.find_opt f.md.externs name with | Some sym -> extern_call f e.Tast.ty ("@" ^ sym) args - | None -> call f e.Tast.ty name args) - | Tast.CallPtr (callee, args) -> call_ptr f e.Tast.ty callee args + | None -> call ~at:e.Tast.loc f e.Tast.ty name args) + | Tast.CallPtr (callee, args) -> call_ptr ~at:e.Tast.loc f e.Tast.ty callee args | Tast.Do body -> block f body | Tast.Let (bs, body) -> List.iter @@ -2656,9 +2672,22 @@ and body_of f flan = p end -and call f ret flan args = +(* A dev build's frame records the call it is making, after the arguments — + which may make calls of their own — and before the call itself, so a + backtrace names the call each caller is in and two calls to one function + from one caller are two different lines. One store; nothing in a release + build. *) +and mark_call f at = + match f.frame with + | None -> () + | Some _ -> + let id = fi_cstring f.md (Loc.to_string at) in + ins f "store ptr %s, ptr %%frame.a" id + +and call ?at f ret flan args = let vs = map_lr (fun (a : Tast.expr) -> let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in + Option.iter (mark_call f) at; (* The cell is loaded *after* the arguments, so a redefinition that lands between two calls still cannot land in the middle of one. *) let callee = body_of f flan in @@ -2674,7 +2703,7 @@ and call f ret flan args = written in and the order a reader expects; the direct case is the other way round for a reason that does not apply here (there is no cell to keep out of the middle of an argument list). *) -and call_ptr f ret callee args = +and call_ptr ?at f ret callee args = let c = value f callee in (* A [(Fn ...)] is two words and both are taken before the arguments are evaluated: an argument may itself make a function value, and the two @@ -2693,6 +2722,7 @@ and call_ptr f ret callee args = in let vs = map_lr (fun (a : Tast.expr) -> let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in + Option.iter (mark_call f) at; call_through f ?env ret code vs (* The code address behind one of the three [fnref]s, which is the same string @@ -3927,6 +3957,10 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = (Rt.index Rt.flanframe "slots"); Printf.sprintf "store ptr %s, ptr %%frame.s" (match f.slotv with Some v -> v | None -> "null"); + Printf.sprintf + "%%frame.a = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d" + (Rt.index Rt.flanframe "at"); + "store ptr null, ptr %frame.a"; "store ptr %frame, ptr @flan_frame_head" ]; f.frame <- Some prev; (* The parameters are bound before the body starts, so they are recorded diff --git a/lib/x86.ml b/lib/x86.ml index 1e83315a..c51d96d2 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -1056,6 +1056,16 @@ let fninfo f (fn : Tast.fn) ~nslots = fn) ])); l +(* A frame's [at]: [fi_bytes] with the NUL [Emit.fi_cstring] writes, since + the reader takes the length. *) +let fi_cstring f s = + let l = rodata_label f in + Buffer.add_string f.rodata (Printf.sprintf "\t.align 1\n%s:\n" l); + if String.length s > 0 then + Buffer.add_string f.rodata (Printf.sprintf "\t.byte %s\n" (escape_bytes s)); + Buffer.add_string f.rodata "\t.byte 0x00\n"; + l + (* A signal site's [flan_condesc], [emit.ml]'s [condesc] spelled for this backend: the name and the sentence through [string_const], which counts them, because a handler may carry their addresses away; the chain and the @@ -1793,7 +1803,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | None -> (* A dev build calls through the cell so that a redefinition reaches every existing call site; a release build names the symbol. *) - call_flan f + call_flan f ~at:e.Tast.loc ~target:(if f.md.Emit.dev then `Cell (csym name) else `Sym (fsym name)) ~args ~rty:t dst) | Tast.CallPtr (callee, args) -> @@ -1807,7 +1817,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr Types.Unit)) | _ -> None in - call_flan f ?env ~target:(`Loc c) ~args ~rty:t dst + call_flan f ?env ~at:e.Tast.loc ~target:(`Loc c) ~args ~rty:t dst | Tast.Do body -> block f body dst t | Tast.Let (bs, body) -> List.iter @@ -2912,7 +2922,7 @@ and ret_loc f = if is_agg f.fret then Lp (f.sret_off, 0) else Lf f.retval integer or SSE sequence, every aggregate by pointer, a hidden [sret] in the first integer register when the result is an aggregate, and the transfer channel last of all. *) -and call_flan f ?env ~target ~args ~rty dst = +and call_flan f ?env ?at ~target ~args ~rty dst = let vals = List.map (fun (a : Tast.expr) -> eval f a, a.Tast.ty) args in let callee = match target with @@ -2939,6 +2949,15 @@ and call_flan f ?env ~target ~args ~rty dst = the position is argued. *) let tail = match env with None -> [] | Some a -> [ a ] in ignore (emit_args f (head @ body @ chan @ tail)); + (* The call this frame is making, for a backtrace — [Emit.mark_call]. After + the arguments, which may make calls of their own, and through [r11], + which no argument is in. *) + (match f.dframe, at with + | Some fr, Some at -> + lea f.b ~dst:r11 ~mm:(Sym (fi_cstring f (Loc.to_string at), 0)); + store_int f.b ~src:r11 + ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "at")) ~size:8 + | _ -> ()); (* The cell is loaded *after* the arguments, and [emit.ml] has the same as a load-bearing comment: a redefinition that lands between two calls still must not land in the middle of one. [r11] is scratch and no argument @@ -4028,6 +4047,10 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) store_int f.b ~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "slots")) ~size:8; + xor_rr f.b ~dst:rax ~src:rax; + store_int f.b + ~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "at")) + ~size:8; lea f.b ~dst:rax ~mm:(Frame fr); store_int f.b ~src:rax ~mm:(lmem f head ~scratch:r11) ~size:8; (* The parameters are bound before the body starts, so they are recorded diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index bbd914eb..70812575 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -1039,6 +1039,12 @@ typedef struct flan_frame { * with no named slot, and in a release build there is no frame at all. * Read through [flan_dev_frame_slot], which is where the bound is checked. */ void **slots; + /* The call this frame is in: the site of the last Flan call it made, + * NUL-terminated, stored after the arguments and before the call. NULL + * until its first. Stale in the innermost frame, which may have returned + * from that call since — which is why [flan_dev_frame_at_loc] is read for + * the outer frames only. */ + const char *at; } flan_frame; /* The compiler names this symbol directly. A redefinition module reaches it @@ -1088,6 +1094,14 @@ const char *flan_dev_frame_loc(const void *frame, int64_t *len) { return f->info->loc; } +/* Where the frame is: the call it is in, or NULL when it has made none. */ +const char *flan_dev_frame_at_loc(const void *frame, int64_t *len) { + const flan_frame *f = frame; + if (f == NULL || f->at == NULL) { *len = 0; return NULL; } + *len = (int64_t)strlen(f->at); + return f->at; +} + int32_t flan_dev_frame_nslots(const void *frame) { const flan_frame *f = frame; return (f == NULL || f->info == NULL) ? 0 : f->info->nslots; diff --git a/test/test_dev.ml b/test/test_dev.ml index 3323c1ba..a6c5b4b8 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -968,14 +968,17 @@ let () = (Option.value ~default:(status r) (Wire.string_field r "message")) else begin match frames r with - | [ ("fetch", floc, "program"); ("main", _, "program") ] -> + | [ ("fetch", floc, "program"); ("main", mloc, "program") ] -> (* Absolute and pointing into the program's own source, for the same reason [defs] is: an editor is not in this process's working directory. It comes off the frame, not off this end's session, so a redefined body reports where the *installed* one is written. *) if String.length floc = 0 || floc.[0] <> '/' then - fail "a frame's location is not absolute: %s" floc + fail "a frame's location is not absolute: %s" floc; + (* And an outer frame is at the call it is in, not at its defn. *) + if not (contains_sub mloc "dev-break.flan:40:10") then + fail "main's frame is at %s, not at its call to fetch" mloc | fs -> fail "backtrace of a stopped program: %s" (String.concat ", " @@ -5819,12 +5822,14 @@ let () = if status r <> "ok" then fail "x86 backtrace: %s" (said r) else (match frames with - | [ ("look", l0, "program"); ("main", _, "program") ] -> - (* The location travels in the frame's own descriptor, so a wrong - one is a descriptor built from the wrong function rather than a - cosmetic slip. *) - if not (contains_sub l0 "dev-locals.flan:14") then - fail "x86 backtrace put look at %S" l0 + | [ ("look", l0, "program"); ("main", l1, "program") ] -> + (* Where each frame is: the innermost at the (error ...) that + stopped it, and main at its call to [look] — the store each + call makes into its caller's frame, on this backend. *) + if not (contains_sub l0 "dev-locals.flan:35:13") then + fail "x86 backtrace put look at %S" l0; + if not (contains_sub l1 "dev-locals.flan:46:10") then + fail "x86 backtrace put main at %S" l1 | _ -> fail "x86 backtrace: %s" (String.concat ", " diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 0eb7defc..520b308d 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -318,6 +318,7 @@ extern int32_t flan_dev_frame_count(void); extern void *flan_dev_frame_at(int32_t i); extern const char *flan_dev_frame_name(const void *frame, int64_t *len); extern const char *flan_dev_frame_loc(const void *frame, int64_t *len); +extern const char *flan_dev_frame_at_loc(const void *frame, int64_t *len); extern int32_t flan_dev_frame_nslots(const void *frame); extern int32_t flan_dev_frame_slotsig(const void *frame); extern int32_t flan_dev_frame_refsig(const void *frame); @@ -773,7 +774,20 @@ static int snap_push(int resumable, void *cond) { const char *nm, *lc; if (fr == NULL) break; nm = flan_dev_frame_name(fr, &nl); - lc = flan_dev_frame_loc(fr, &ll); + /* Where the frame *is*, not where its function is written: the break + * site for the innermost, which is the expression that stopped, and the + * call each outer frame is in — so two calls to one function from one + * caller are two lines. The innermost frame's recorded call may be one + * it has since returned from, so it is not used there. Either falls back + * to the function's own location when there is nothing better. */ + lc = NULL; + ll = 0; + if (i == 0 && s->sitelen > 0) { + lc = s->site; + ll = s->sitelen; + } else if (i > 0) + lc = flan_dev_frame_at_loc(fr, &ll); + if (lc == NULL || ll <= 0) lc = flan_dev_frame_loc(fr, &ll); if (nl < 0) nl = 0; if (ll < 0) ll = 0; if ((int64_t)s->fused + nl + ll + 2 > FRAME_TEXT) break;