diff --git a/FIX.org b/FIX.org index 9c87d8e2..35c940a2 100644 --- a/FIX.org +++ b/FIX.org @@ -6305,3 +6305,51 @@ value is a null pointer, which is the one zero that is not a value the type can have. But "a table of function pointers" is exactly what CFn is for, and that objection is about ZII rather than about capture — an (Option (CFn ...)) field is already legal and is the shape that works. Its own item. +* main is an ordinary cell-routed call in a dev build, 2026-09-20 + +DISCUSS.org's "main cannot actually be redefined" was right, and this is the +fix. A dev build gives every Flan function an indirection cell and routes +every call through it (~Emit.body_of~), which is what makes a C-c C-c +redefinition reach the call sites that already exist. The emitted C ~main~ +was the one exception on both backends: it called the Flan-level ~main~ by +symbol. So ~flan_program_main~ — what M-x flan-rerun re-enters — ran the body +~main~ had at the initial build for the life of the process, however many +times ~main~ had been redefined since. Redefining ~main~ compiled, installed, +reported ok, and changed nothing observable. + +Both backends, one shape. ~Emit.emit_main~ loads ~@"flan.cell.main"~ and +calls through the loaded pointer; ~X86.emit_main~ does the same as +~call_flan~'s ~`Cell~ target does — ~mov r11, cell(%rip)~ then ~call *%r11~, +one load rather than two because ~emit_cells~ defines the cell in the same +object and ~emit_main~ is only ever a whole program's. Both are gated on +~md.dev~, so a release build keeps the direct call: ~flan emit~ and ~flan emit +--x86~ are byte-identical to the base on arith.flan, dev-rerun.flan and +sand.flan. The load is after the arguments, for the reason ~call~ gives at +its own: a redefinition that lands between two calls must not land inside +one. The cell is ~.data~/~global ptr~ initialised to the body this build +compiled, so the first run enters exactly what it entered before this existed, +and the defvar init-once and dyn-root brackets in ~main~ are untouched. + +Verified against real daemons on both backends, three generations each: +~main~ redefined over the socket to print "generation 2", 3 and 4, with a +~rerun~ between, and the program printed each of them in turn. The same +transcript on the base binary prints "generation 1" six times. +~test/programs/dev-main-redef.flan~ and a row in ~test/test_dev.ml~ pin it on +both backends. + +** The off-by-one that is left, and it is not in the emitters +A body delivered while the program is parked installs at the program's next +frame boundary — ~flan_merged_park~ drains the agent ring only when +~program_poll~ is set, and a plain redefine (unlike ~eval-expr~) does not set +it. A re-run's first frame boundary is already inside ~main~, so the re-run +that follows a delivery enters the body the cell held when it started, and the +delivery it installs is what the *next* re-run enters. Every generation does +run — that is the fix — but one re-run later than the person who pressed the +key expects, and a redefined ~main~ that polls nothing installs nothing at +all. + +Closing it is one call: drain the ring in ~flan_merged_park~ before it breaks +out on ~program_asked~, so a re-run installs what is queued and then enters +~main~. That is ~lib/dev.ml~, which another lane holds, so it is written down +here rather than done. The test row asserts the behaviour as it is, with the +extra re-run spelled out. diff --git a/lib/emit.ml b/lib/emit.ml index 8181c726..e2ea9841 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -4231,9 +4231,26 @@ let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast. "%slice %args" end in + (* [main] is called the way [body_of] calls every other Flan function: a + release build names the symbol, a dev build loads the indirection cell. + Without the cell this one call site kept the body [main] had at the + initial build, so a redefined [main] took effect at every call in the + program except the entry point's — and the dev daemon's re-run, which + re-enters this function as [flan_program_main], re-ran the old body. + [main] is one of [p.Tast.fns], so a dev build defines its cell above + initialised to the body compiled here; the first run therefore calls + exactly what it called before this existed. The load is after the + arguments, for the reason [call] gives at its own. *) + let callee = + if not m.dev then fname "main" + else begin + Buffer.add_string b + (Printf.sprintf " %%mainfn = load ptr, ptr %s\n" (cellname "main")); + "%mainfn" + end + in Buffer.add_string b - (Printf.sprintf " %%r = call %s %s(%s)\n" (ll fn.Tast.ret) - (fname "main") + (Printf.sprintf " %%r = call %s %s(%s)\n" (ll fn.Tast.ret) callee (if args = "" then "ptr " ^ xfer_param else args ^ ", ptr " ^ xfer_param)); (* Flushing matters: stdout is a FILE* and the acceptance test reads it. *) Buffer.add_string b " call void @flan_exit(i32 "; diff --git a/lib/x86.ml b/lib/x86.ml index b1c52d1c..8344bec7 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -4299,7 +4299,27 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false) lea b ~dst:rdi ~mm:(Frame argv); lea b ~dst:rsi ~mm:(Frame xfer) | _ -> unsupported "main takes at most one parameter"); - call_sym b (fsym "main"); + (* Through the indirection cell in a dev build, exactly as [call_flan]'s + [`Cell] target does, and to the symbol in a release build. [emit.ml]'s + [emit_main] has the same split and the same reason: without it this one + call site kept the body [main] had at the initial build, so a redefined + [main] reached every call in the program except the entry point's — and + the re-run the dev daemon performs, which re-enters this function as + [flan_program_main], re-ran the old body. + + One load and not two: [emit_cells] defines the cell in this same object, + so its address is a pc-relative displacement rather than a GOT slot, and + [emit_main] is only ever a whole program's. [r11] is scratch and no + argument register, so this cannot disturb the arguments placed above. *) + if md.Emit.dev then begin + bnote ann b + "The indirection cell. A dev build enters the program through it rather than \ + through the symbol, so that a main redefined while the process runs is what the \ + next re-run enters."; + load_int b ~dst:r11 ~mm:(Sym (csym "main", 0)) ~size:8 ~signed:false; + call_r b r11 + end + else call_sym b (fsym "main"); if Types.equal fn.Tast.ret (Types.Int Types.I32) then mov_rr b ~dst:rdi ~src:rax else xor_rr b ~dst:rdi ~src:rdi; diff --git a/test/programs/dev-main-redef.flan b/test/programs/dev-main-redef.flan new file mode 100644 index 00000000..1d3ce148 --- /dev/null +++ b/test/programs/dev-main-redef.flan @@ -0,0 +1,19 @@ +;;;; main, redefined while the program is parked, and re-entered. +;;;; +;;;; Every call a dev build makes goes through an indirection cell, which is +;;;; what makes a C-c C-c redefinition reach the call sites that already +;;;; exist. The emitted C [main] used to be the one exception: it called the +;;;; Flan-level [main] by symbol, so the body the daemon re-enters on a +;;;; [rerun] was always the body [main] had at the initial build, however many +;;;; times [main] itself had been redefined. +;;;; +;;;; So this fixture is deliberately almost empty: what it prints is the +;;;; question, and every later generation of it arrives over the socket. +(import agent "vendor:agent") + +(defn main [] i32 + (agent/start "/tmp/flan-dev-main-redef-fallback.sock") + (println "generation 1") + (dotimes [i 40] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index 8626993e..816fe207 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -6271,6 +6271,119 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ dsock; dout ]) [ ("x86", [||]); ("llvm", [| "--llvm" |]) ]; + (* ── A redefined main is the main a re-run enters ──────────────────── *) + + (* The entry point used to be the one call site a redefinition could not + reach. A dev build routes every call through an indirection cell so + that C-c C-c lands on the sites that already exist, and the emitted C + [main] called the Flan-level [main] by symbol instead — so + [flan_program_main], which is what a re-run re-enters, ran the body + [main] had at the initial build for the life of the process. Redefining + [main] compiled, installed, reported ok, and changed nothing anyone + could observe. Both backends, because both emit their own [main] and + the direct call was in both. + + Three generations and not one: a cell that were stored into once — or a + run that happened to pick up the newest module rather than the one + installed before it — would pass on a single redefinition. Each + generation prints a line naming itself, so the assertion is on what the + program said and not on what the daemon replied. + + The run a redefinition first shows up in is the one *after* the re-run + that follows it, and that is deliberate here rather than glossed: a + body delivered while the program is parked installs at the program's + next frame boundary, and a re-run's first frame boundary is already + inside [main]. So the re-run that follows the delivery enters the body + the cell held when it started, and the delivery it just installed is + what the next one enters. The extra re-run at the end is that + off-by-one written out — without it the fourth generation would never + be entered at all. FIX.org has what would close the gap. *) + List.iter + (fun backend -> + let msock = tmp ("mainredef" ^ backend ^ ".sock") + and mout = tmp ("mainredef" ^ backend ^ ".out") in + (try Sys.remove msock with Sys_error _ -> ()); + let mfd = + Unix.openfile mout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let mpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-main-redef.flan"; "-s"; msock; + "--" ^ backend |] + Unix.stdin mfd Unix.stderr + in + Unix.close mfd; + if not (listening ~pid:mpid msock) then begin + fail "the main-redefinition daemon (--%s) %s" backend !listen_why; + (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect msock in + let said r = + Option.value ~default:(status r) (Wire.string_field r "message") + in + let parked () = + match Wire.field (request c "(:op \"describe\")") "parked" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + (* This session's share of the output and not the whole buffer: + the two backends run the same fixture and print the same lines, + so the second would find the first's and assert nothing. *) + let start = Buffer.length output in + let mine () = + Buffer.sub output start (Buffer.length output - start) + in + let printed s = contains_sub (mine ()) s in + let rerun_and_park why = + let r = request c "(:op \"rerun\")" in + if status r <> "ok" then fail "--%s: rerun (%s): %s" backend why + (said r) + else if not (await ~ms:20000 parked) then + fail "--%s: the program did not park again (%s)" backend why + in + if not (await ~ms:20000 parked) then + fail "the main-redefinition fixture (--%s) never parked (%S)" + backend (In_channel.with_open_bin mout In_channel.input_all) + else begin + if not (printed "generation 1") then + fail "--%s: the first run printed %S" backend (mine ()); + (* The redefinitions keep the fixture's polling loop, because a + body delivered while parked is installed by a poll and a + generation that stopped polling would be the last one that + could ever be replaced. *) + for gen = 2 to 4 do + let r = + request c + (Printf.sprintf + "(:op \"eval\" :code \"(defn main [] i32 (println \ + \\\"generation %d\\\") (dotimes [i 40] (agent/wait 5)) \ + 0)\" :file \"programs/dev-main-redef.flan\")" + gen) + in + if status r <> "ok" then + fail "--%s: redefining main (generation %d): %s" backend gen + (said r); + rerun_and_park (Printf.sprintf "generation %d" gen) + done; + rerun_and_park "the last generation"; + List.iter + (fun gen -> + let want = Printf.sprintf "generation %d" gen in + if not (printed want) then + fail + "--%s: main was redefined three times and the program \ + never printed %S: %S" + backend want (mine ())) + [ 2; 3; 4 ] + end; + ignore (request c "(:op \"close\")"); + (try Unix.close c with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] mpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ msock; mout ]) + [ "llvm"; "x86" ]; (* ── A daemon whose editor was killed ─────────────────────────────── *)