From 63fb5c629c3e76205cb53ba75c06de72533e83b4 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 18:45:35 +0700 Subject: [PATCH] The other backend runs the class thunk too, and now something says so MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The migration transcript runs on x86, because that is what flan dev takes unasked. What is backend-specific about any of this is one thing — whether the registration thunk reaches the runtime at all — and the evidence for LLVM was that the IR contained the call, which is emission and not execution. x86.ml's own header claimed for some time that it did not emit flan_reload_call, which is exactly the kind of sentence not to trust twice. So: the same program under flan dev --llvm, one instance, one slot added, and the four answers that say the migration happened. Short on purpose — everything past the thunk is flan_dyn.c's, and flan_dyn.c does not know who called it. --- FIX.org | 21 ++++++++++---- test/test_dev.ml | 73 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 6 deletions(-) diff --git a/FIX.org b/FIX.org index bc8fb6a..8bacfb5 100644 --- a/FIX.org +++ b/FIX.org @@ -2645,12 +2645,21 @@ this is available there at any price. use-after-free and as nothing at all in the checked build. - ~test_dev.ml~, "a class redefined under its own instances": a real daemon over ~test/programs/dev-classes.flan~, instances pushed into a dyn global - by ~C-x C-e~ thunks, then four ~C-c C-c~ class redefinitions with the - program's own heap answering between them — gained slot nil, kept slot - kept, count right, *a generic still dispatching after the migration*, an - untouched instance migrating on its own first touch, a lost slot gone, the - third generation, the tag surviving, an unchanged redefinition migrating - nothing, and a raw-~put~ key dropped by the next real one. + by ~C-x C-e~ thunks, then five ~C-c C-c~ evaluations of the class — four + of which change the slot list — with the program's own heap answering + between them: gained slot nil, kept slot kept, count right, *a generic + still dispatching after the migration*, an untouched instance migrating on + its own first touch, a lost slot gone, the third generation, the tag + surviving, the one unchanged re-evaluation migrating nothing, and a + raw-~put~ key dropped by the next real redefinition. +- And the same protocol once more against a ~flan dev --llvm~ daemon. The + block above runs on x86, which is what ~flan dev~ takes unasked; the subset + under LLVM is the part that is backend-specific — whether the registration + thunk reaches the runtime at all — and everything past that point is + flan_dyn.c's, which does not know who called it. Written because + ~x86.ml~'s header had claimed for some time that it did *not* emit + ~flan_reload_call~, which is exactly the kind of sentence not to trust + twice. - ~test_session.ml~: a slot added and a slot removed both accepted, the module carrying ~flan_dyn_class_def~ and ~flan_reload_call~ and the packed slot list, an unchanged class registering anyway, the refusal when a diff --git a/test/test_dev.ml b/test/test_dev.ml index d02b7b3..7d086c9 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -5484,6 +5484,79 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ msock; mout ]; + (* ── The same thing through the other backend ─────────────────── + The block above runs on x86, because that is what [flan dev] takes + when nobody says. The registration a redefined class carries rides + the [flan_reload_call] thunk, which both backends emit and the agent + finds by [dlsym] either way — and "both backends emit it" is a + sentence [x86.ml]'s own header got wrong for long enough to be worth + not trusting a second time. So the shortest subset that would notice: + one instance, one slot added, and the three answers that say the + migration happened. + + Short on purpose. What is backend-specific is the thunk reaching the + runtime at all; everything the block above pins beyond that is + flan_dyn.c's, and flan_dyn.c does not know which backend called + it. *) + let lsock2 = tmp "migrate-llvm.sock" and lout2 = tmp "migrate-llvm.out" in + (try Sys.remove lsock2 with Sys_error _ -> ()); + let lfd2 = Unix.openfile lout2 [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let lpid2 = + Unix.create_process flan + [| flan; "dev"; "programs/dev-classes.flan"; "-s"; lsock2; "--llvm" |] + Unix.stdin lfd2 Unix.stderr + in + Unix.close lfd2; + if not (listening ~pid:lpid2 lsock2) then begin + fail "the LLVM migration daemon %s (%S)" !listen_why + (In_channel.with_open_bin lout2 In_channel.input_all); + (try Unix.kill lpid2 Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect lsock2 in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + let value r = Option.value ~default:"" (Wire.string_field r "value") in + let ask code = + request c + (Printf.sprintf + "(:op \"eval-expr\" :code %S :file \"programs/dev-classes.flan\")" + code) + in + let holds what code = + let r = ask code in + if status r <> "ok" then fail "llvm: %s: %s" what (said r) + else if value r <> "1" then + fail "llvm: %s answered %S (%s)" what (value r) code + in + let started () = status (ask "(do (push instances (point 3 4)) 1)") = "ok" in + if not (await started) then + fail "the LLVM migration daemon never reached a frame boundary" + else begin + let r = + request c + "(:op \"eval\" :code \"(defclass point [x y z])\" \ + :file \"programs/dev-classes.flan\")" + in + if status r <> "ok" then + fail "llvm: adding a slot to a class: %s" (said r) + else begin + holds "a gained slot is nil through the LLVM backend" + "(if (= (get (at instances 0) :z) nil) 1 0)"; + holds "a kept slot keeps its value through the LLVM backend" + "(if (= (get (at instances 0) :x) 3) 1 0)"; + holds "the slot count through the LLVM backend" + "(if (= (len (at instances 0)) 3) 1 0)"; + holds "a generic still dispatches through the LLVM backend" + "(if (= (area (at instances 0)) 12) 1 0)" + end + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill lpid2 Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] lpid2) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ lsock2; lout2 ]; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; bsock; bout ]; Test_support.report ~label:"dev" ()