diff --git a/FIX.org b/FIX.org index 8822689..6804dfd 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. @@ -806,3 +813,48 @@ script already has SURVEY_FLAGS, which hands the same extra flags to both sides, and both sides do accept -O0 — and something that walks the two prim match arms mechanically rather than relying on somebody reading them side by side, which is how this gap survived. Neither is queued. + +* 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 +Written when the watermark fix had not landed; both are merged now, so what +holds is this. The park's [flan_dyn_root_reset] preserves the dyn globals' +permanent roots — it cuts the stack back to [roots_base], the watermark +[flan_dyn_root_globals_end] recorded. A re-run's [flan_dyn_root_globals_begin] +empties the stack outright, the emitted main re-pushes every global's root, +and [_end] re-records the base, so push-exactly-once holds via the bracket +rather than via anything the guarded startup does. The guarded startup +skipping its stores on a re-run is safe against all of that because the +pushes take the global's slot address, never its value, and they sit before +the startup call on both backends — nothing in the bracket depends on an +initialiser having run. diff --git a/lib/dev.ml b/lib/dev.ml index 715b0e7..5df19ab 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/lib/emit.ml b/lib/emit.ml index 1ae652e..fa64ebd 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3247,25 +3247,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 51439f5..ab12671 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -4012,7 +4012,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 = @@ -4033,10 +4033,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 @@ -4420,11 +4429,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 @@ -4434,8 +4443,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 @@ -4494,7 +4503,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..8ce6091 --- /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 100] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index ec3d175..77cdd24 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -4750,6 +4750,105 @@ let () = [ dsock; dout ]) [ "llvm"; "x86" ]; + (* ── 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