From ed8dbbcd622bf20b3034cce6052e7028ae00d014 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 11:15:52 +0700 Subject: [PATCH] A handler-bind clause runs with only the handlers outside its own form in force, and a stale call in main's running loop stays listed until the callee changes back or the program re-runs The first is CLHS 9.1.4.1: a clause that signalled the condition it handles used to re-enter itself until the stack ran out. The stale list now names a lifted clause by the function it is written in, and BUILT.md's cost line is measured against master. --- docs/BUILT.md | 21 +++++++-- emacs/MANUAL.md | 7 +++ emacs/flan.el | 20 ++++++-- lib/dev.ml | 8 ++-- lib/session.ml | 74 +++++++++++++++++++++++------- runtime/flan_rt.c | 22 +++++++-- test/programs/dev-stale.flan | 10 ++++ test/programs/handler-reentry.flan | 46 +++++++++++++++++++ test/test_acceptance.ml | 10 ++++ test/test_dev.ml | 35 +++++++++++++- test/test_session.ml | 55 ++++++++++++++++++++-- 11 files changed, 269 insertions(+), 39 deletions(-) create mode 100644 test/programs/handler-reentry.flan diff --git a/docs/BUILT.md b/docs/BUILT.md index 2303bd9a..692a80e1 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -1494,7 +1494,16 @@ symbol, with its call sites — callee, the signature it had when the body was c host program and each accepted module replaces the bodies it compiled. After an evaluation, `stale_sites` is every recorded site whose callee's signature in the new program is not the one recorded, and it rides on the reply as `:stale`; the editor puts each in `*flan-diagnostics*`. Recompiling a caller replaces its record and drops it from the -list. +list. A site is named by the declaration its body belongs to, so a call in a handler clause lifted out of `step` is +`step`'s. + +**Except in `main`.** Recompiling a function changes what its *next* call runs, and `main` is not called again while +the program runs: its loop is the activation the stale call is in. So while the program runs, a stale site in `main` +is flagged `:running`, and when `main` is recompiled the body it started with is kept in `Session.live` and stays on +the list until a re-run (`Session.rerun`) — the editor's sentence then says to change the callee back or re-run, +since evaluating `main` again cannot help. A re-run enters `main` through its cell and so reaches the new body. Any +other function the program never leaves has the same property and is not tracked: the dev shadow stack could say +which bodies are live, but the x86 backend pushes no frames onto it. **A stale caller's source may no longer check**, and that must not refuse the form that changed the callee: `(scale ticks)` after `scale` gained a parameter is an arity error in a body nobody is recompiling. So `Check` has a @@ -1513,10 +1522,12 @@ compiled bodies like any other and are listed by their own file and line, the ca importer included. The prelude has no stale callers to list, because a session cannot redefine a prelude function at all — the form is refused as a second definition. -A release build has no cells, so it has neither the word nor the compare. Measured on a 200M-call loop of a one-line -function, dev build, both sides with three-word cells so the difference is the compare alone: x86 median 2.91 s -against 2.59 s without it (about 1.6 ns a call); LLVM `-O2` median 0.32 s against 0.39 s — the checked build ran faster -in all nine rounds, which is most likely code layout and was not investigated. +A release build has no cells, so it has neither the word nor the compare. Measured against master's compiler on a +200M-call loop of a one-line function, dev build, with `perf stat` counting user-mode events because wall time on a +shared machine moved by more than the difference: x86 runs 5 more instructions a call (13.0G to 14.0G) and about 2 more +cycles (median 9.23G to 9.49G); LLVM `-O2` runs 2 more instructions a call (2.6G to 3.0G) and *fewer* cycles (median +1.24G to 1.04G), consistently across rounds — a layout effect, not investigated. Wall time at the fastest of nine runs: +x86 2.03 s to 2.27 s, LLVM 0.30 s to 0.26 s. ### The agent — dev loop step 3 diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 8ad4a05a..20077d46 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -849,6 +849,13 @@ Evaluating `(defn scale [x i64 k i64] i64 (* x k))` installs the new `scale` and names `step` as a stale caller. The next call from `step` stops on `StaleCall`; evaluating `step` again, calling `(scale ticks 3)`, clears it. +A call in `main` is the exception to that fix. While the program runs, it is +inside the `main` it started with, and that body never returns to be called +again, so evaluating `main` again does not reach the loop it is in. The listing +says so for each such call, and the program keeps stopping there until `scale` +is defined with the old signature again or the program is re-run with `M-x +flan-rerun`. The same holds for any function the program never leaves. + A function value taken before the change keeps the body it was taken from and goes on computing what it did. A value taken by a stale caller after the change stops where it is taken. diff --git a/emacs/flan.el b/emacs/flan.el index 94c7c210..b8250d82 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -2355,11 +2355,21 @@ of the tenth name tells you neither how many there were nor which." (defun flan--stale-message (site) "The sentence for SITE, one entry of a reply's `:stale' list." - (let ((callee (plist-get site :callee))) - (format "this call to %s was compiled for %s, and %s is defined as %s. \ -Evaluate %s again to compile it against the new definition." - callee (plist-get site :compiled) callee (plist-get site :current) - (plist-get site :caller)))) + (let ((callee (plist-get site :callee)) + (compiled (plist-get site :compiled))) + (concat + (format "this call to %s was compiled for %s, and %s is defined as %s. " + callee compiled callee (plist-get site :current)) + (if (plist-get site :running) + ;; `main' is the one caller no evaluation can reach: the program is + ;; inside the body it started with and never calls it again. + (format "It is in %s, which is still running the body it started \ +with, so evaluating %s again does not reach it. Define %s with %s again, or \ +re-run the program (M-x flan-rerun)." + (plist-get site :caller) (plist-get site :caller) callee + compiled) + (format "Evaluate %s again to compile it against the new definition." + (plist-get site :caller)))))) (defun flan--report-stale (stale) "Log every call site in STALE, a reply's `:stale' list. diff --git a/lib/dev.ml b/lib/dev.ml index 63b89854..cfd8a419 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -874,11 +874,12 @@ let stale_field (ss : Session.stale list) = (List.map (fun (x : Session.stale) -> Printf.sprintf - "(:loc %s :caller %s :callee %s :compiled %s :current %s)" + "(:loc %s :caller %s :callee %s :compiled %s :current %s%s)" (Wire.quote (Loc.to_string x.Session.at)) (Wire.quote x.Session.caller) (Wire.quote x.Session.target) (Wire.quote x.Session.compiled) - (Wire.quote x.Session.current)) + (Wire.quote x.Session.current) + (if x.Session.running then " :running t" else "")) ss) ] let eval t ~code ~origin ~pause = @@ -904,7 +905,7 @@ let eval t ~code ~origin ~pause = let refused msg = Session.restore t.session before; error msg in if now = Gone then error gone else - match Session.eval ~origin ?pause t.session code with + match Session.eval ~origin ?pause ~running:(not parked_now) t.session code with | c when not c.Session.installs -> (* Accepted into the session and nothing to send: a declaration the program already has, with no body and no new storage. Saying "ok" and @@ -3330,6 +3331,7 @@ let rerun t = let stopped_in_park = liveness t = Parked && at_break in (match Program.rerun ~stopped:at_break () with | Ok () -> + Session.rerun t.session; (* The park this session was explaining is over, so the park after it gets the explanation again — see [install_note]. Cleared here as well as in [eval] because a run can start and finish with nothing diff --git a/lib/session.ml b/lib/session.ml index 0832d298..82b3637d 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -53,6 +53,11 @@ type stale = { compiled : string; (* the signature it was compiled for *) current : string; (* the signature the function has now *) at : Loc.t; + (* True when the call is in [main] and the program is running: the + activation it is in is [main]'s loop, which never returns to be called + again, so compiling [main] again cannot reach it. Changing the callee + back or re-running the program does. *) + running : bool; } type t = { @@ -96,6 +101,11 @@ type t = { modules are accepted — so it is what was *compiled*, which after a signature change is not what [program] would check to. *) mutable built : built SM.t; + (* The bodies of [main], and of the clauses lifted out of it, as the + running activation was compiled — kept when [main] is compiled again + while the program runs, because the loop the program is in is still the + old one and nothing re-enters it until a re-run. Emptied by [rerun]. *) + mutable live : built SM.t; } let fail = Loc.fail @@ -152,23 +162,30 @@ let record_built env (p : Tast.program) (fns : Tast.fn list) m = it was compiled for, in source order. A callee [p] does not have is skipped rather than reported: nothing could have been installed under it since, so the cell still holds what the site was compiled against. *) -let stale_sites built (p : Tast.program) : stale list = +let stale_sites ?(live = SM.empty) ?(running = false) built (p : Tast.program) : + stale list = let sigs = Hashtbl.create 64 in List.iter (fun (f : Tast.fn) -> Hashtbl.replace sigs f.Tast.name (Emit.sig_text f.Tast.params f.Tast.ret)) p.Tast.fns; - SM.fold - (fun caller b acc -> - List.fold_left - (fun acc (st : site) -> - match Hashtbl.find_opt sigs st.callee with - | Some now when not (String.equal now st.csig) -> - { caller; target = st.callee; compiled = st.csig; current = now; - at = st.sloc } :: acc - | _ -> acc) - acc b.sites) - built [] + (* Named by the declaration a body belongs to: a clause lifted out of + [step] is [step]'s call, and a generic's copy is the generic's. *) + let from ~kept m acc = + SM.fold + (fun _ b acc -> + let running = kept || (running && String.equal b.owner "main") in + List.fold_left + (fun acc (st : site) -> + match Hashtbl.find_opt sigs st.callee with + | Some now when not (String.equal now st.csig) -> + { caller = b.owner; target = st.callee; compiled = st.csig; + current = now; at = st.sloc; running } :: acc + | _ -> acc) + acc b.sites) + m acc + in + from ~kept:true live (from ~kept:false built []) |> List.sort (fun a b -> match String.compare a.at.Loc.file b.at.Loc.file with | 0 -> Loc.before a.at b.at @@ -227,7 +244,7 @@ let create ?(debug = false) ?(x86 = false) ~file () = that buffer. [macro_union] keeps the left. *) macros = Load.macro_union (own_macros forms) l.Load.macros; thunks = 0; debug; x86; - built = record_built env p p.Tast.fns SM.empty }, l) + built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l) (* What a macro may call, for the same reason [macros] is held: an evaluation parses one form with no import in sight, and a package macro whose body @@ -615,20 +632,26 @@ type held = { (* And what the process was compiled with, which an acceptance moves too: a module that never arrived compiled nothing. *) hbuilt : built SM.t; + hlive : built SM.t; } let held t = { hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros; - hbuilt = t.built } + hbuilt = t.built; hlive = t.live } let restore t h = t.decls <- h.hdecls; t.program <- h.hprogram; t.env <- h.henv; t.macros <- h.hmacros; - t.built <- h.hbuilt + t.built <- h.hbuilt; + t.live <- h.hlive -let eval ?(origin = "") ?pause t src : change = +(* A re-run calls [main] through its cell, so the body it enters is the + newest one and no older activation is left running. *) +let rerun t = t.live <- SM.empty + +let eval ?(origin = "") ?pause ?(running = true) t src : change = let forms = Reader.read_all ~file:origin src in Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () -> (* Through [Load] like any other source, so an evaluated (import ...) means @@ -1082,18 +1105,35 @@ let eval ?(origin = "") ?pause t src : change = program.Tast.fns in let built = record_built env program rebuilt t.built in + (* [main]'s running activation is the body the program started with, and + compiling [main] again does not reach it: the loop it is in never + returns to be called again. So while the program runs, the body it was + started with is kept, and its stale sites stay on the list. *) + let live = + if not running then t.live + else + List.fold_left + (fun live (f : Tast.fn) -> + match SM.find_opt f.Tast.name t.built with + | Some b when String.equal b.owner "main" + && not (SM.mem f.Tast.name live) -> + SM.add f.Tast.name b live + | _ -> live) + t.live rebuilt + in t.macros <- !macros; t.decls <- decls; t.program <- program; t.env <- env; t.built <- built; + t.live <- live; (* [run_thunk] counts: a form that is only a (defclass ...) already installs its constructor, but a module carrying nothing but the registration still has something for the program to run. *) { ir; x86 = t.x86; names; fns; installs = fns <> [] || allocates || consts <> [] || run_thunk <> None; - stale = stale_sites built program } + stale = stale_sites ~live ~running built program } (* ── Evaluating an expression ──────────────────────────────────────── *) diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 60121854..36ad3679 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -72,10 +72,22 @@ void flan_handler_pop(flan_handler *h) { * * A handler that transfers stops the walk. The remaining handlers are for a * signal that is still looking for someone; this one has been answered. */ +/* While a clause runs, the handlers in force are the ones that were in force + * when its handler-bind was established — the frames below it — and not the + * whole stack. That is Common Lisp's rule (CLHS 9.1.4.1; SBCL's + * %handler-bind rebinds *handler-clusters* to the rest of the list around + * each call), and without it a clause that signals the condition it handles + * reaches itself again, and again, until the stack runs out. The stack is put + * back afterwards whether or not the clause transferred: a transfer's target + * can be a restart-case inside the handler-bind's own body, whose frame does + * not pop this handler on the way there. */ void flan_signal(uint32_t type_id, void *condition, void *xfer) { - for (flan_handler *h = handlers; h != NULL; h = h->prev) + flan_handler *saved = handlers; + for (flan_handler *h = saved; h != NULL; h = h->prev) if (h->type_id == type_id) { + handlers = h->prev; h->fn(condition, xfer, h->env); + handlers = saved; if (*(void **)xfer != NULL) return; } } @@ -1126,9 +1138,11 @@ void flan_stale_call(const char *site, const char *callee, const char *want, rt_flush_out(); fprintf(stderr, "%s: this call to %s was compiled for %s, and %s is defined as %s. " - "Evaluate the function this call is in again, so that it is " - "compiled against the new definition.\n", - site, callee, want, callee, now); + "Evaluating the function this call is in again fixes its next call. " + "A function that is still running, such as main's loop, is never " + "called again: define %s with %s again, or run the program " + "again.\n", + site, callee, want, callee, now, callee, want); rt_die(); } diff --git a/test/programs/dev-stale.flan b/test/programs/dev-stale.flan index d04bc628..f95f798c 100644 --- a/test/programs/dev-stale.flan +++ b/test/programs/dev-stale.flan @@ -34,3 +34,13 @@ (restart-case (step) (skip-frame [] 0))) 0) + +;;; A stale call inside a handler-bind clause that handles StaleCall. The body's +;;; call to [scale] signals, the clause runs, and the clause's own call to +;;; [scale] signals again — which reaches the handlers outside this +;;; handler-bind and not the clause itself, so it stops in the break buffer +;;; rather than recursing until the stack runs out. The clause is a lifted +;;; function, and the stale list names it as [guarded]. +(defn guarded [] i64 + (handler-bind [(StaleCall [c] (set seen (scale 1)))] + (scale 5))) diff --git a/test/programs/handler-reentry.flan b/test/programs/handler-reentry.flan new file mode 100644 index 00000000..3a5b89dc --- /dev/null +++ b/test/programs/handler-reentry.flan @@ -0,0 +1,46 @@ +;;;; A handler-bind clause that signals the condition it is handling. +;;;; +;;;; While a clause runs, the handlers in force are the ones that were in force +;;;; when its handler-bind was established (CLHS 9.1.4.1). So the inner clause's +;;;; own bad index reaches the *outer* clause, once, and not the inner one +;;;; again — which used to recurse until the stack ran out. +;;;; +;;;; The second half is the other order: after the inner clause has run and +;;;; declined, the handler it belongs to is in force again for the next signal. + +(defonce hits i64) +(def grid [4 i32] [1 2 3 4]) + +(defn bad [i i32] i32 (at grid i)) + +(defn nested [] i64 + (restart-case + (handler-bind [(BoundsError [c] (set hits (+ hits 100)) (invoke-restart 'outer))] + (restart-case + (handler-bind [(BoundsError [c] + (set hits (+ hits 1)) + (bad 9) + (invoke-restart 'inner))] + (bad 7)) + (inner [] 0))) + (outer [] 0)) + hits) + +(defn again [] i64 + (set hits 0) + (restart-case + (handler-bind [(BoundsError [c] (set hits (+ hits 1)) (invoke-restart 'out))] + (handler-bind [(BoundsError [c] (set hits (+ hits 10)))] + (bad 5) + 0)) + (out [] 0)) + (restart-case + (handler-bind [(BoundsError [c] (set hits (+ hits 1000)) (invoke-restart 'out))] + (bad 6)) + (out [] 0)) + hits) + +(defn main [] i32 + (println (nested)) + (println (again)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 6ced8956..7cda52a1 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -916,6 +916,16 @@ let () = outputs "conditions" "programs/conditions.flan" conditions_out; outputs ~opt:"-O0" "conditions, -O0" "programs/conditions.flan" conditions_out; outputs ~dev:true "conditions, dev" "programs/conditions.flan" conditions_out; + (* A clause that signals what it handles reaches the handlers outside its + own handler-bind and not itself (CLHS 9.1.4.1), and its handler is in + force again once it has declined. It used to recurse until the stack + ran out. *) + let reentry_out = "101\n1011\n" in + outputs "handler re-entry" "programs/handler-reentry.flan" reentry_out; + outputs ~dev:true "handler re-entry, dev" "programs/handler-reentry.flan" + reentry_out; + outputs ~x86:true "handler re-entry, --x86" "programs/handler-reentry.flan" + reentry_out; (* restart-case and invoke-restart, §3 to §6: the transfer itself. A fall-through with nothing handling it, a clause reached from two frames down, the defer in between running on the way out, an inner frame diff --git a/test/test_dev.ml b/test/test_dev.ml index 03285fcb..f238cfe5 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -6645,7 +6645,8 @@ let () = fail "--%s: a signature change was refused: %s" backend (said r) else begin let locs = stale_locs r in - if not (at 23 locs && at 26 locs && List.length locs = 2) then + if not (at 23 locs && at 26 locs && at 45 locs && at 46 locs + && List.length locs = 4) then fail "--%s: the reply named the stale callers %s" backend (String.concat ", " locs); if not (await ~ms:20000 stopped) then @@ -6686,7 +6687,8 @@ let () = fail "--%s: recompiling the stale caller: %s" backend (said r) else begin let locs = stale_locs r in - if not (at 26 locs && List.length locs = 1) then + if not (at 26 locs && not (at 23 locs) && List.length locs = 3) + then fail "--%s: after recompiling step the stale list is %s" backend (String.concat ", " locs) end; @@ -6737,6 +6739,35 @@ let () = "(:op \"restart\" :name \"abandon-evaluation\")"); if not (await ~ms:20000 (fun () -> not (stopped ()))) then fail "--%s: the abandoned evaluation never let go" backend + end; + (* A stale call inside a clause handling StaleCall. The + clause's handler is not in force while the clause runs, + so its own stale call reaches the break loop once, + rather than the clause again until the stack runs out. *) + let r = + request c + "(:op \"eval-expr\" :code \"(guarded)\" \ + :file \"programs/dev-stale.flan\")" + in + if status r <> "error" then + fail "--%s: a stale call inside a handler answered: %s" + backend (said r) + else if not (await ~ms:20000 stopped) then + fail "--%s: a stale call inside a handler never stopped" backend + else begin + (match + Wire.string_field (request c "(:op \"break\")") "site" + with + | Some site when contains_sub site "dev-stale.flan:45:" -> () + | Some site -> + fail "--%s: the stale call in the clause stopped at %s" + backend site + | None -> fail "--%s: the clause's stale call has no :site" backend); + ignore + (request c + "(:op \"restart\" :name \"abandon-evaluation\")"); + if not (await ~ms:20000 (fun () -> not (stopped ()))) then + fail "--%s: the abandoned clause never let go" backend end end end diff --git a/test/test_session.ml b/test/test_session.ml index 456cd8ce..eeae392c 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -95,7 +95,11 @@ let () = in let want = [ ("step", "scale", "[i64] i64", "[i64 i64] i64", 23); - ("pick", "scale", "[i64] i64", "[i64 i64] i64", 26) ] + ("pick", "scale", "[i64] i64", "[i64 i64] i64", 26); + (* The clause's call is named for the function it is written in, + not for the lifted function it became. *) + ("guarded", "scale", "[i64] i64", "[i64 i64] i64", 45); + ("guarded", "scale", "[i64] i64", "[i64 i64] i64", 46) ] in if named <> want then fail "the stale callers were %s" @@ -110,7 +114,9 @@ let () = with | c -> (match c.Session.stale with - | [ x ] when x.Session.caller = "pick" -> () + | [ a; b; c ] when a.Session.caller = "pick" + && b.Session.caller = "guarded" + && c.Session.caller = "guarded" -> () | l -> fail "after recompiling step the stale callers were %s" (String.concat ", " @@ -123,7 +129,7 @@ let () = (match Session.eval t "(defn lonely [x i64] i64 (+ x 1))" with | c -> if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale - <> [ "pick" ] + <> [ "pick"; "guarded"; "guarded" ] then fail "an unrelated evaluation lost track of the stale caller" | exception Loc.Error { Loc.dmsg = m; _ } -> fail "an evaluation after a signature change was refused: %s" m); @@ -141,6 +147,49 @@ let () = | exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing a signature back was refused: %s" m)); + (* A stale call in [main] is one that evaluating [main] again cannot fix + while the program runs: its loop is the activation the call is in, and + it never returns to be called again. So the site is flagged, and when + [main] is compiled again the body the program started with stays on the + list until a re-run. With the program parked, compiling [main] again is + an ordinary fix. *) + (let t, _ = Session.create ~file:"programs/dev-stale.flan" () in + let mains (c : Session.change) = + List.filter_map + (fun (x : Session.stale) -> + if x.Session.caller = "main" then Some x.Session.running else None) + c.Session.stale + in + let main_src = + "(defn main [] i32 (agent/start \"/tmp/x.sock\") \ + (dotimes [i 6000] (agent/wait 5) (restart-case (step 1) (skip-frame [] 0))) 0)" + in + (match Session.eval t "(defn step [x i64] i64 (set seen (scale x)) seen)" with + | c -> + if mains c <> [ true ] then fail "a stale call in main was not flagged as running" + | exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing step: %s" m); + (match Session.eval t main_src with + | c -> + if mains c <> [ true ] then + fail "recompiling main while it runs cleared its stale call" + | exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling main: %s" m); + Session.rerun t; + (match Session.eval t "(defn lonely [x i64] i64 (+ x 2))" with + | c -> if mains c <> [] then fail "a re-run did not clear main's stale call" + | exception Loc.Error { Loc.dmsg = m; _ } -> fail "after a re-run: %s" m)); + (let t, _ = Session.create ~file:"programs/dev-stale.flan" () in + ignore + (Session.eval ~running:false t "(defn step [x i64] i64 (set seen (scale x)) seen)"); + match + Session.eval ~running:false t + "(defn main [] i32 (dotimes [i 3] (restart-case (step 1) (skip-frame [] 0))) 0)" + with + | c -> + if List.exists (fun (x : Session.stale) -> x.Session.caller = "main") + c.Session.stale + then fail "recompiling main while parked left it stale" + | exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling a parked main: %s" m); + (* What a tolerated caller's failed check made is taken back, generic copies included, so a body in the same form that needs the same copy gets one generated for it rather than a cached name. *)