JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A redefined function that takes and returns a struct, on both backends

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 23:12:43 +07:00
parent 188e6bc72f
commit 8ae77db92c
3 changed files with 266 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
test/programs/reload-agg-v2.flan Normal file
View File

@ -0,0 +1,69 @@
;;;; The aggregate case across the reload boundary, v2.
;;;;
;;;; The same four signatures with different arithmetic, so that the host's
;;;; un-rebuilt `outer' printing a different number can only mean its call
;;;; sites followed four redefined bodies that take and return structs.
;;;;
;;;; The `defstruct' blocks are byte-identical to v1's and must stay that way.
;;;; Layout is computed per module, so a field reordered here would make the
;;;; host and the module disagree about offsets — a real bug, but one wearing
;;;; this test's clothes, and it would be indistinguishable in the transcript
;;;; from the convention mismatch the fixture exists to detect.
;;;;
;;;; The four `weigh' functions are changed and the change must be dead text: a
;;;; module declares a sibling rather than defining it, so each call has to
;;;; land on the host's copy. With the bodies identical nothing at run time
;;;; would notice a module that grew its own; multiplied by ten, it is the
;;;; difference between 1611 and 12411 in the first term alone.
;;;;
;;;; Nothing here introduces a name the host was not built with. X86.redefinition
;;;; refuses those by name — that is the registry path, and it is item 1 of
;;;; HANDOFF-x86-redef.md's "what remains" rather than anything to do with
;;;; aggregates.
(defstruct Pair [a i64 b i64])
(defstruct Quad [a i64 b i64 c i64 d i64])
(defstruct Duo [x f64 y f64])
(defstruct Mix [n i64 z f64])
(defvar counter i64)
(defn weigh-pair [p Pair] i64 (+ (.a p) (* 30 (.b p))))
(defn weigh-quad [q Quad] i64
(+ (+ (.a q) (* 30 (.b q))) (+ (* 50 (.c q)) (* 70 (.d q)))))
(defn weigh-duo [d Duo] i64 (+ (i64 (.x d)) (* 30 (i64 (.y d)))))
(defn weigh-mix [m Mix] i64 (+ (.n m) (* 30 (i64 (.z m)))))
(defn step-pair [p Pair] Pair
(println "a2")
(set counter (+ counter 10))
(Pair {.a (+ (.a p) 10) .b (+ (.b p) (* 2 (weigh-pair p)))}))
(defn step-quad [q Quad] Quad
(Quad {.a (+ (.a q) 10) .b (+ (.b q) 20) .c (+ (.c q) 30)
.d (+ (.d q) (* 2 (weigh-quad q)))}))
(defn step-duo [d Duo] Duo
(Duo {.x (+ (.x d) 10.0) .y (+ (.y d) (f64 (* 2 (weigh-duo d))))}))
(defn step-mix [m Mix] Mix
(Mix {.n (+ (.n m) 10) .z (+ (.z m) (f64 (* 2 (weigh-mix m))))}))
(defn sum-pair [p Pair] i64 (+ (.a p) (* 100 (.b p))))
(defn sum-quad [q Quad] i64
(+ (+ (.a q) (* 100 (.b q))) (+ (* 10000 (.c q)) (* 1000000 (.d q)))))
(defn sum-duo [d Duo] i64 (+ (i64 (.x d)) (* 100 (i64 (.y d)))))
(defn sum-mix [m Mix] i64 (+ (.n m) (* 100 (i64 (.z m)))))
(defn outer [] i64
(let [p (step-pair (Pair {.a 1 .b 2}))
q (step-quad (Quad {.a 1 .b 2 .c 3 .d 4}))
d (step-duo (Duo {.x 1.0 .y 2.0}))
m (step-mix (Mix {.n 1 .z 2.0}))]
(+ (+ (sum-pair p) (sum-quad q)) (+ (sum-duo d) (sum-mix m)))))

101
test/programs/reload-agg.flan Normal file
View File

@ -0,0 +1,101 @@
;;;; The aggregate case across the reload boundary, v1 (HANDOFF-x86-redef.md,
;;;; item 4).
;;;;
;;;; `reload.flan' proves that a redefined body is reached; every signature in
;;;; it is scalar. That is the half of the reload primitive the two backends
;;;; cannot disagree about. `lib/x86.ml' licenses its own calling convention on
;;;; the grounds that a dev build is compiled entirely by it and a release
;;;; build entirely by LLVM, and the conventions agree on every scalar and
;;;; disagree on every aggregate — here each goes by pointer with a hidden
;;;; sret, while LLVM classifies per eightbyte. So a redefined function taking
;;;; or returning a struct is the case that would expose a mismatch, and it is
;;;; the case nothing measured. This fixture is that case.
;;;;
;;;; No `main': the host is test/reload_host.c, unchanged, which links this and
;;;; then dlopens rebuilt copies. Everything aggregate happens *inside* Flan,
;;;; between the host's compiled-once call site and the redefined body. The C
;;;; boundary stays scalar on purpose — that is where the two conventions are
;;;; required to agree, and it is not what is under test.
;;;;
;;;; Four struct shapes, because SysV treats them four different ways and
;;;; x86.ml treats all four the same:
;;;;
;;;; Pair two eightbytes, both INTEGER — SysV passes it in rdi:rsi and
;;;; returns it in rax:rdx. Diverges from x86.ml in both directions.
;;;; Quad thirty-two bytes, so MEMORY — SysV copies the argument onto the
;;;; stack, where x86.ml passes a pointer. The *return* is a hidden
;;;; pointer in the first integer register for SysV too, so that half
;;;; of the matrix may well coincide; it is covered because assuming
;;;; which half coincides is exactly the kind of argument this fixture
;;;; exists to replace with a measurement.
;;;; Duo two SSE eightbytes — xmm0:xmm1.
;;;; Mix one INTEGER and one SSE — rax and xmm0, a third pattern again.
;;;;
;;;; Every field is weighted by position in the answer — a + 100b + 10000c —
;;;; rather than summed. A symmetric sum would print the right number under a
;;;; convention mismatch that merely permuted the fields, which is the way a
;;;; test like this passes while proving nothing.
(defstruct Pair [a i64 b i64])
(defstruct Quad [a i64 b i64 c i64 d i64])
(defstruct Duo [x f64 y f64])
(defstruct Mix [n i64 z f64])
;;; The state that has to survive a reload, written by a loaded module rather
;;; than by the host: a redefinition declares it external, so the store lands
;;; on the host's copy and not on a private one.
(defvar counter i64)
;;; The other direction. These are never redefined, so a module reaches each
;;; one through its cell and hands it an aggregate — module to host, where the
;;; four `step' functions below are host to module. Each is also a tripwire:
;;; v2 changes all four, and since a module declares a sibling rather than
;;; defining it, that changed text must be dead. A module that grew its own
;;; copy prints a visibly different number.
(defn weigh-pair [p Pair] i64 (+ (.a p) (* 3 (.b p))))
(defn weigh-quad [q Quad] i64
(+ (+ (.a q) (* 3 (.b q))) (+ (* 5 (.c q)) (* 7 (.d q)))))
(defn weigh-duo [d Duo] i64 (+ (i64 (.x d)) (* 3 (i64 (.y d)))))
(defn weigh-mix [m Mix] i64 (+ (.n m) (* 3 (i64 (.z m)))))
;;; The four redefined bodies. Each takes an aggregate and returns one, so a
;;; single call crosses the boundary in both directions at once.
(defn step-pair [p Pair] Pair
(println "a1")
(set counter (+ counter 1))
(Pair {.a (+ (.a p) 1) .b (+ (.b p) (weigh-pair p))}))
(defn step-quad [q Quad] Quad
(Quad {.a (+ (.a q) 1) .b (+ (.b q) 2) .c (+ (.c q) 3)
.d (+ (.d q) (weigh-quad q))}))
(defn step-duo [d Duo] Duo
(Duo {.x (+ (.x d) 1.0) .y (+ (.y d) (f64 (weigh-duo d)))}))
(defn step-mix [m Mix] Mix
(Mix {.n (+ (.n m) 1) .z (+ (.z m) (f64 (weigh-mix m)))}))
;;; The reducers the host itself calls, so that what crosses back into C is an
;;; integer and the transcript is exact.
(defn sum-pair [p Pair] i64 (+ (.a p) (* 100 (.b p))))
(defn sum-quad [q Quad] i64
(+ (+ (.a q) (* 100 (.b q))) (+ (* 10000 (.c q)) (* 1000000 (.d q)))))
(defn sum-duo [d Duo] i64 (+ (i64 (.x d)) (* 100 (i64 (.y d)))))
(defn sum-mix [m Mix] i64 (+ (.n m) (* 100 (i64 (.z m)))))
;;; The call site that has to follow a reload: compiled once, into the host,
;;; and never rebuilt. If a redefined `step-pair' runs when the host calls
;;; this, the cell is doing its job — and doing it for a signature the two
;;; conventions disagree about.
(defn outer [] i64
(let [p (step-pair (Pair {.a 1 .b 2}))
q (step-quad (Quad {.a 1 .b 2 .c 3 .d 4}))
d (step-duo (Duo {.x 1.0 .y 2.0}))
m (step-mix (Mix {.n 1 .z 2.0}))]
(+ (+ (sum-pair p) (sum-quad q)) (+ (sum-duo d) (sum-mix m)))))

96
test/test_reload.ml
View File

@ -252,6 +252,102 @@ let () =
| _ -> fail "x86 redefinition accepted a name the host does not have"
| exception X86.Unsupported _ -> ());
(* The aggregate case, which is the whole reason X86.redefinition exists
rather than an --x86 host dlopening what Emit.redefinition made.
Everything above this point is scalar, and scalars are the half of the
calling convention the two backends cannot disagree about. They disagree
on every aggregate: x86.ml passes each one by pointer and returns it
through a hidden sret, LLVM classifies per eightbyte. So a redefined
function taking or returning a struct is the case that would expose a
mismatch, and until now the claim that an --x86 host plus --x86 modules
is same-convention-by-construction was an argument rather than a
measurement.
programs/reload-agg.flan crosses the boundary in four shapes at once —
two integer eightbytes, thirty-two bytes of MEMORY, two SSE eightbytes,
and one of each — because SysV treats those four differently and this
backend treats them identically, so a single shape would measure a
quarter of the disagreement and read like all of it. Each `step' takes
an aggregate and returns one, so a single call crosses in both
directions, and each calls a `weigh' the module does not define, which
hands an aggregate the other way.
Both backends run the same fixture and are compared against the same
transcript. The LLVM row is not decoration: a wrong expected number
would otherwise be indistinguishable from a backend that is right, and
two independently-built agreements on one string are what rule that
out. *)
let a1 = checked "programs/reload-agg.flan" in
let a2 = checked "programs/reload-agg-v2.flan" in
let agg_known =
let names =
List.map (fun (f : Tast.fn) -> f.Tast.name) a1.Tast.fns
@ List.map (fun (g : Tast.global) -> g.Tast.gname) a1.Tast.globals
in
fun n -> List.exists (String.equal n) names
in
let agg_fns = [ "step-pair"; "step-quad"; "step-duo"; "step-mix" ] in
(* The arithmetic, derived rather than observed, because a number read off
a run is a record of what happened and not a statement of what should:
v1 Pair {1,2} -> weigh 1+3*2 = 7, so {2, 2+7} and 2 + 100*9 = 902
Quad {1,2,3,4} -> weigh (1+6)+(15+28) = 50, so {2,4,6,54} and
2 + 400 + 60000 + 54000000 = 54060402
Duo {1,2} -> weigh 7, so {2.0, 9.0} and 902
Mix {1,2} -> weigh 7, so {2, 9.0} and 902
total 54063108
v2 Pair -> weigh is still the *host's* 7, so {11, 2+14} and 1611
Quad -> weigh still 50, so {11,22,33,104} and
11 + 2200 + 330000 + 104000000 = 104332211
Duo -> {11.0, 16.0} and 1611
Mix -> {11, 16.0} and 1611
total 104337044
1611 rather than 12411 in the first term is the tripwire: v2's text for
`weigh-pair' multiplies by thirty, and a module that grew its own copy
of a sibling rather than reaching the host's through a cell would say
so here. `counter' is stepped from inside the redefined body, by one in
v1 and by ten in v2, so 1 + 1 + 10 = 12 is the host's global being
written by three different bodies in turn. *)
let agg_want =
"a1\nhost 54063108\na1\nafter1 54063108\na2\nafter2 104337044\n\
counter 12\n"
in
let agg_run label opts mkmod =
let h = tmp ("agg-host-" ^ label) in
ignore
(Build.executable ~opts ~csrcs:[ "reload_host.c" ] ~lflags:[ "-ldl" ]
a1 ~out:h);
let m1 = mkmod a1 ("agg-" ^ label ^ "-1.so") in
let m2 = mkmod a2 ("agg-" ^ label ^ "-2.so") in
let o = tmp ("agg-out-" ^ label) and e = tmp ("agg-err-" ^ label) in
let code =
Sys.command
(Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote h)
(Filename.quote m1) (Filename.quote m2) (Filename.quote o)
(Filename.quote e))
in
let text = In_channel.with_open_bin o In_channel.input_all in
if code <> 0 || text <> agg_want then
fail "%s aggregate reload\n got: %S (exit %d)\n wanted: %S"
label text code agg_want;
List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
[ h; m1; m2; o; e ]
in
agg_run "llvm" dev (fun q name ->
let o = tmp name in
let ir = Emit.redefinition ~dev:true ~known:agg_known q ~fns:agg_fns in
ignore (Build.shared ~opts:dev ~ir ~out:o ());
o);
agg_run "x86" x86 (fun q name ->
let o = tmp name in
let asm =
X86.redefinition ~checks:true ~dev:true ~known:agg_known q ~fns:agg_fns
in
ignore (Build.shared_x86 ~opts:x86 ~asm ~out:o ());
o);
(* The layout-drift guard, which needs a process of its own because what it
does is abort one. [extra] does not exist in the host: v3 introduced it
at run time, so flan_dev.c allocated its storage and recorded its size,