From 931cf860c37d68a4bb1111ade564337eca7537bf Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 11:16:37 +0700 Subject: [PATCH 1/2] A defvar's initialiser runs once, so its value survives a re-run --- lib/emit.ml | 106 ++++++++++++++++++++++++++++++----- lib/x86.ml | 35 ++++++++---- test/programs/dev-rerun.flan | 49 ++++++++++++++++ 3 files changed, 166 insertions(+), 24 deletions(-) create mode 100644 test/programs/dev-rerun.flan diff --git a/lib/emit.ml b/lib/emit.ml index 08afc7c..308bd90 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3238,25 +3238,105 @@ let emit_global m ?(hidden = false) (g : Tast.global) = link's. *) let startup_sym = fname ".init-globals" -let emit_startup m ?(hidden = false) (globals : Tast.global list) = - match +(* The startup function runs once per *process* in a release build, because a + release build's [main] is entered once. The dev daemon's re-run enters it + again: [flan_merged_park] waits for [program_asked] and the loop around it + calls [flan_program_main] from the top, so every line of [main] above runs a + second time, this call included. + + What that must mean is decided by the defining form, not by the daemon. A + [defvar] is Common Lisp's [defvar]: its initialiser runs only if the + variable is not already initialised, so its value survives a re-run — which + is what the daemon has always promised ("the globals are as it left them") + and what a plain zeroed [defvar] already got for free, since .bss is + untouched by a second call. A computed one used to be the exception, wiped + back to its initial value every re-run. A [defconst] is a constant and the + question does not arise for it: it is the linker's image on one backend and + a constructor's stores on the other, and neither is reached from here. + + So each computed initialiser guards itself with a flag of its own. Per + global and not per startup function, because the rule belongs to the form: + a global whose initialiser is added by a later build, or a future form that + *does* recompute, decides its own case without the other globals' having to + agree. + + Dev builds only. A release build has no re-run to guard against and pays + nothing — the body below is then the bare store it always was, byte for + byte. The flag is a global of its own rather than a sentinel value in the + variable, because there is no value a [defvar] cannot hold. + + Writing the flag *after* the store is safe rather than merely tidy: + [Check.no_transfer_in_init] refuses a signal or a restart out of an + initialiser, so nothing leaves the guarded branch between the two. *) +let init_flag n = ".init-once." ^ n + +(* The computed globals, the flags that guard them, and the body of the + startup function — built here so that the two backends cannot disagree + about any of the three. [flags] is empty in a release build. *) +let startup_plan m (globals : Tast.global list) = + let computed = List.filter (fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit)) globals - with - | [] -> false - | computed -> - (* One store per global and nothing else: the initialiser itself was lifted - into a function of its own, so this frame holds no slots and the [let] a - programmer wrote inside an initialiser has a frame of its own to live - in. *) - let body = + in + let flags = + if not m.dev then [] + else List.map (fun (g : Tast.global) -> - { Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit); - ty = Types.Unit; loc = g.Tast.ginit.Tast.loc }) + { Tast.gname = init_flag g.Tast.gname; gty = Types.Bool; + ginit = + { Tast.e = Tast.Bool false; ty = Types.Bool; + loc = g.Tast.ginit.Tast.loc }; + gconst = false; gfolded = false }) computed - in + in + (* Registered so that [place] and the x86 backend's [lower] can find a + flag's type the same way they find any other global's. Not added to the + program's own [globals] list: nothing the programmer wrote names one, and + the daemon's [globals] op answers from the program. *) + List.iter + (fun (g : Tast.global) -> Hashtbl.replace m.globals g.Tast.gname g.Tast.gty) + flags; + let body = + List.map2 + (fun (g : Tast.global) (flag : Tast.global option) -> + let loc = g.Tast.ginit.Tast.loc in + let store = + { Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit); + ty = Types.Unit; loc } + in + match flag with + | None -> store + | Some f -> + let mark = + { Tast.e = + Tast.Set + (Tast.Pglobal f.Tast.gname, + { Tast.e = Tast.Bool true; ty = Types.Bool; loc }); + ty = Types.Unit; loc } + in + { Tast.e = + Tast.If + ({ Tast.e = Tast.Global f.Tast.gname; ty = Types.Bool; loc }, + { Tast.e = Tast.Unit; ty = Types.Unit; loc }, + { Tast.e = Tast.Do [ store; mark ]; ty = Types.Unit; loc }); + ty = Types.Unit; loc }) + computed + (if flags = [] then List.map (fun _ -> None) computed + else List.map (fun f -> Some f) flags) + in + (computed, flags, body) + +let emit_startup m ?(hidden = false) (globals : Tast.global list) = + match startup_plan m globals with + | [], _, _ -> false + | computed, flags, body -> + (* One guarded store per global and nothing else: the initialiser itself + was lifted into a function of its own, so this frame holds no slots and + the [let] a programmer wrote inside an initialiser has a frame of its + own to live in. *) + List.iter (emit_global m ~hidden) flags; emit_fn m ~hidden { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; ret = Types.Unit; body; fdefers = []; fparent = None; diff --git a/lib/x86.ml b/lib/x86.ml index ecfae3c..a09af1f 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3964,7 +3964,7 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) = Buffer.contents out -let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs ~fns +let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns (globals : Tast.global list) = let b = create () in let f = @@ -3985,10 +3985,19 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs let cell = ptmp f in f.xfer_off <- ptmp f; f.xfer_lbl <- new_label f "gxfer"; - List.iter - (fun (g : Tast.global) -> - scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0)))) - globals; + (* Two shapes, and the second is the computed initialisers in a dev build: + [Emit.startup_plan] builds their stores as expressions so that the guard + it wraps each one in — see its own note, and [Emit.emit_startup] on the + LLVM side — is the same guard on both backends rather than two that have + to be kept in step. The constant image below is unguarded stores into + their symbols, exactly as it was. *) + (match body with + | Some es -> List.iter (fun (e : Tast.expr) -> scoped f (fun () -> lower f e sink)) es + | None -> + List.iter + (fun (g : Tast.global) -> + scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0)))) + globals); (* Nothing has established a handler or a restart by the time either of these runs — one of them is a constructor and the other is the first call [main] makes — so a transfer out of an initialiser has nowhere to go and @@ -4372,11 +4381,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) function: see the two symbols' own note. The split is total — [Tast.const_init] is what [emit.ml] asks to decide which globals it can write into the object — so every global is written exactly once. *) - let constants, computed = - List.partition - (fun (g : Tast.global) -> Tast.const_init g.Tast.ginit) + let constants = + List.filter (fun (g : Tast.global) -> Tast.const_init g.Tast.ginit) p.Tast.globals in + let computed, init_flags, init_body = Emit.startup_plan md p.Tast.globals in let ginit, gr = emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns constants @@ -4386,8 +4395,8 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) let startup = computed <> [] in if startup then begin let t, r = - emit_globals_init ~cfi:debug ~ann:annotate ~sym:init_sym md ~externs ~fns - computed + emit_globals_init ~cfi:debug ~ann:annotate ~body:init_body ~sym:init_sym + md ~externs ~fns computed in Buffer.add_string text t; Buffer.add_string rodata r @@ -4446,7 +4455,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) (asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker)); if dev then Buffer.add_string out (emit_cells p); - Buffer.add_string out (emit_globals_data md p.Tast.globals); + (* The program's globals, and then — in a dev build only — one zeroed byte + per computed initialiser, which is the flag [Emit.startup_plan] guards it + with. Zeroed is what "has not run yet" is, and .bss is what a re-run does + not touch. *) + Buffer.add_string out (emit_globals_data md (p.Tast.globals @ init_flags)); Buffer.add_string out "\n\t.section\t.rodata\n"; Buffer.add_buffer out rodata; (* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out diff --git a/test/programs/dev-rerun.flan b/test/programs/dev-rerun.flan new file mode 100644 index 0000000..94ce033 --- /dev/null +++ b/test/programs/dev-rerun.flan @@ -0,0 +1,49 @@ +;;;; What a re-run does to a global, which is decided by the form that +;;;; defined it and not by the daemon. +;;;; +;;;; A [defvar] is Common Lisp's [defvar]: its initialiser runs only if the +;;;; variable is not already initialised, so its value survives a re-run. A +;;;; plain zeroed one always did — .bss is untouched by a second entry into +;;;; main — and a computed one did not, because the startup function [main] +;;;; calls ran again from the top and stored the initial value back over +;;;; whatever the last run had left. A [defconst] is a constant and the +;;;; question does not arise. +;;;; +;;;; So each line printed below is a claim about one of those cases, and the +;;;; run number is the first of them: [runs] is computed, so before the fix it +;;;; counted 1, 1, 1. +(import agent "vendor:agent") + +(defconst base i64 40) + +;; Computed, and the whole reproduction: the initialiser is a call, so it is +;; lifted into the startup function rather than written into the image. +(defn start [] i64 base) + +(defvar counter i64 (start)) + +;; Zero-valued, which needs no startup at all and must keep needing none. +(defvar zeroed i64) + +;; A computed dyn global: the map is built by a function, rooted before the +;; startup function runs, and mutated by every run. Its contents have to +;; survive a re-run for the same reason [counter]'s value does, and its root +;; has to survive collection either way. +(defn table [] dyn {:runs 0}) + +(defvar state dyn (table)) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-rerun-fallback.sock") + (set counter (+ counter 1)) + (set zeroed (+ zeroed 2)) + (put state :runs (+ (get state :runs) 1)) + (print "counter ") (print counter) (println "") + (print "zeroed ") (print zeroed) (println "") + (print "runs ") (print (get state :runs)) (println "") + (print "base ") (print base) (println "") + ;; Long enough for a client to be served, short enough to park well inside + ;; any watchdog — dev-macro.flan's clock, for its reason. + (dotimes [i 200] + (agent/wait 5)) + 0) From da40dc2de26f2812408b07fe3c568e75c6040798 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 11:30:58 +0700 Subject: [PATCH 2/2] The rule a re-run follows is written down, and a test fails without it --- FIX.org | 51 +++++++++++++++++++ lib/dev.ml | 9 ++++ test/programs/dev-rerun.flan | 2 +- test/test_dev.ml | 99 ++++++++++++++++++++++++++++++++++++ 4 files changed, 160 insertions(+), 1 deletion(-) diff --git a/FIX.org b/FIX.org index 1e50077..7cdcf79 100644 --- a/FIX.org +++ b/FIX.org @@ -39,6 +39,13 @@ whether it accepts one. Globals are NOT reset between runs. That is the CL/Clojure semantics asked for: the process never died, so a second (main) sees what the first one left. +Held for a zeroed global from the day this merged, and did not hold for a +computed one until 2026-09-20: re-entering main re-entered the startup function +that runs the computed initialisers, so every [defvar] with a call in it was +stored back over what the last run had left. Fixed by giving each computed +initialiser a guard of its own rather than by changing what a re-run does — +see "Per-form initialisation semantics on re-run" below. + ** 2. C-x C-e on a top-level form — QUEUED behind 1 Same file as 1 (emacs/flan.el), so it waits rather than merging by hand. No design questions; the note specifies it. @@ -656,3 +663,47 @@ immutability, and the discipline of planning a shape ahead of time that comes with it. The plan is to write imperative Flan as it stands and see whether the parens still grate once that variable is gone. Revisit this once that evidence exists. + +* Per-form initialisation semantics on re-run, decided 2026-09-20 +The defining form is the contract, and the daemon does not have a policy about +globals at all. + +- [defvar] is Common Lisp's [defvar]: its initialiser runs only if the variable + is not already initialised. Its value therefore survives a re-run, which is + what the daemon has always promised in its own words — "the globals are as + the last run left them" — and what a zeroed one already got for free, since + .bss is untouched by a second entry into main. +- [defconst] is a constant and the question does not arise: it is the linker's + image on one backend and a constructor's stores on the other, and a re-run + reaches neither. +- If the language grows a [def]-style form that re-evaluates, that form + recomputes on every run. None exists today and none was invented for this; + the rule is written so that adding one is a new case and not a revision. + +A re-run may therefore re-enter the startup function as freely as it re-enters +anything else. Each initialiser guards itself: [Emit.startup_plan] gives every +computed global a flag of its own — zeroed in .bss, set after the store — and +wraps the store in a test of it. Per global rather than per startup function, +because the rule belongs to the form; dev builds only, so a release build's +.ll and .s are byte for byte what they were, which was measured on both +backends rather than argued. + +Verified against a live daemon on both backends with +[test/programs/dev-rerun.flan]: a computed i64 counts 41, 42, 43, 44 across +four runs where it counted 41, 41, 41, 41 before; a computed dyn map keeps the +mutations every run made to it; a zeroed [defvar] still accumulates; a +[defconst] is untouched. The block in test_dev.ml that pins it fails on the +pre-fix compiler in exactly the two computed cases and in neither of the other +two, which is the other half of the claim. + +** The interaction with the park's root reset, not fixed here +[flan_merged_park] calls [flan_dyn_root_reset], which clears the collector's +whole root stack, the dyn globals' permanent roots included — and the emitted +main re-pushes them on the way in. So push-exactly-once holds today *because* +of the reset, and this lane deliberately leaves both halves alone. + +The lane fixing the reset to preserve the globals' roots has to guard the +pushes in the same change: preserved roots plus an unguarded main is a +duplicate root per re-run. Guarding the pushes here instead would have been +strictly worse — a guarded push against today's reset leaves the dyn globals +unrooted for the whole of the second run. diff --git a/lib/dev.ml b/lib/dev.ml index a3bba1a..12e61fa 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -2555,6 +2555,15 @@ let abort t = is a thing you ask for by hand, in one evaluation, and it cannot be had back the other way round if this zeroed by default. + Nothing here does the keeping, and that is deliberate: a re-run re-enters + [flan_program_main] from the top, the startup function that runs the + computed initialisers included, and what each of those does the second time + is decided by the form that defined the global. A [defvar] is CL's, so its + initialiser runs only if the variable is not already initialised — + [Emit.startup_plan] emits the flag that makes that true, and FIX.org's entry + of 2026-09-20 is the rule. This op says what it sees rather than arranging + for it. + The state is asked twice — here, to say something useful about [Gone], and again inside [Program.rerun], which is the answer that counts. The C does its test and its signal under one lock, so the window between them that this diff --git a/test/programs/dev-rerun.flan b/test/programs/dev-rerun.flan index 94ce033..8ce6091 100644 --- a/test/programs/dev-rerun.flan +++ b/test/programs/dev-rerun.flan @@ -44,6 +44,6 @@ (print "base ") (print base) (println "") ;; Long enough for a client to be served, short enough to park well inside ;; any watchdog — dev-macro.flan's clock, for its reason. - (dotimes [i 200] + (dotimes [i 100] (agent/wait 5)) 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index 7d8e3f4..efb5260 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -4644,6 +4644,105 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ xsock2; xout2; msock; mout ]; + (* ── What a re-run does to a global ───────────────────────────────── *) + + (* The rule is the defining form's: a [defvar] is Common Lisp's, so its + initialiser runs only if the variable is not already initialised and its + value survives a re-run. A zeroed one always did — .bss is untouched by + a second entry into [main] — and a computed one did not, because the + startup function [main] calls ran again from the top and stored the + initial value back over what the last run had left. + [Emit.startup_plan] guards each computed initialiser with a flag of its + own; this is the claim that guard exists for. + + On the default backend, which is x86 and merged, because that is what + the dev loop takes unasked and the guard is emitted by the two backends + from one shared body. Three re-runs and not one: a guard that ran the + initialiser every *other* time would pass a single re-run. + + [programs/dev-rerun.flan] prints one line per case per run, and the + whole assertion is the fourth run's four lines: [counter] computed and + incremented four times, [zeroed] uncomputed and incremented four times, + a computed dyn map whose contents were mutated four times, and a + [defconst] that no run can have changed. *) + let rsock = tmp "rerun.sock" and rout = tmp "rerun.out" in + (try Sys.remove rsock with Sys_error _ -> ()); + let rfd = + Unix.openfile rout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let rpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-rerun.flan"; "-s"; rsock |] + Unix.stdin rfd Unix.stderr + in + Unix.close rfd; + if not (listening ~pid:rpid rsock) then begin + fail "the re-run daemon %s (%S)" !listen_why + (In_channel.with_open_bin rout In_channel.input_all); + (try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect rsock in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + (* [describe] is what drains the program's stdout into [output], so the + park is asked for rather than slept through and the lines are there + to read the moment it is parked. *) + let parked () = + match Wire.field (request c "(:op \"describe\")") "parked" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + let printed s = contains_sub (Buffer.contents output) s in + if not (await ~ms:20000 parked) then + fail "the re-run fixture never parked (%S)" + (In_channel.with_open_bin rout In_channel.input_all); + if not (printed "counter 41") then + fail "the first run printed %S" (Buffer.contents output); + for _ = 1 to 3 do + let r = request c "(:op \"rerun\")" in + if status r <> "ok" then fail "rerun: %s" (said r); + if not (await ~ms:20000 parked) then + fail "a re-run never parked (%S)" + (In_channel.with_open_bin rout In_channel.input_all) + done; + let want = + [ (* A computed [defvar], which is the whole bug: 41 on the first run + and one more on each of the three after it. *) + "counter 44"; + (* An uncomputed one, which survived before this and still does. *) + "zeroed 8"; + (* A computed dyn global, mutated by every run: its value survives + and so does the mutation, which is the map still being the map the + first run built. *) + "runs 4"; + (* And a [defconst], which no run can have changed. *) + "base 40" ] + in + List.iter + (fun s -> + if not (printed s) then + fail "after three re-runs the program never printed %S: %S" s + (Buffer.contents output)) + want; + (* Read back rather than only printed, because the two can differ: a + printed line is what the run computed, and this is what the global + holds now. *) + let r = + request c + "(:op \"eval-expr\" :code \"counter\" :file \"programs/dev-rerun.flan\")" + in + (match Wire.string_field r "value" with + | Some "44" -> () + | v -> + fail "counter reads back as %S after three re-runs" + (Option.value ~default:(status r) v)); + ignore (request c "(:op \"close\")"); + (try Unix.close c with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] rpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ rsock; rout ]; + (* ── A daemon whose editor was killed ─────────────────────────────── *) (* The defect FIX.org recorded and PDEATHSIG does not reach: an editor that