JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 12:12:40 +07:00
parent 73dfaacbc8
commit 23b144178a
7 changed files with 110 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
emacs/flan-cnr.el
View File

@ -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))

2
emacs/test-flan-cider.el
View File

@ -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

44
lib/emit.ml
View File

@ -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

29
lib/x86.ml
View File

@ -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

14
runtime/flan_dev.c
View File

@ -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;

21
test/test_dev.ml
View File

@ -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 ", "

16
vendor/agent/flan_agent.c vendored
View File

@ -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;