From 786656dfee00969d933805ca976919ce313c5fc4 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 15:03:41 +0700 Subject: [PATCH] (at a i) on the left of a set has to reach the array MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The corpus sweep found it, and it found it the way item 15 said this work fails: array-ctor.flan crashed, and the assembly around the crash read correctly. (set (.x (at pts 0)) 1.5) went through lvalue, lvalue had no case for At, and the fallback evaluates — so the store landed in a copy of the element and the array kept its zeros. emit.ml has this as addr's own At case. One line here, and the program matches the LLVM build. Two more programs beside the fizz: one for the internal calling convention the fizz does not touch at all — a struct argument, a struct return through the hidden pointer, f32 in the SSE half, eight integer arguments so two go on the stack, and a slice by pointer — and one for the rest of the core: a global with an initialiser, recursion, break, continue, the bitwise family, unsigned shifts and the conversions both ways. Both agree with LLVM. al is now zero at every call this backend makes, including the three in main that were reaching flan_rt_init, flan_argv and flan_exit without it. Inert on a fixed callee; the point is that there is no exception to the rule to remember. --- lib/x86.ml | 17 ++++++++++++- spike/x86/p4-convention.flan | 27 +++++++++++++++++++++ spike/x86/p5-core.flan | 46 ++++++++++++++++++++++++++++++++++++ 3 files changed, 89 insertions(+), 1 deletion(-) create mode 100644 spike/x86/p4-convention.flan create mode 100644 spike/x86/p5-core.flan diff --git a/lib/x86.ml b/lib/x86.ml index 799e171..4a84ba5 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -898,6 +898,12 @@ and lvalue f (e : Tast.expr) : loc = | Tast.Global n -> Lg (gsym n, 0) | Tast.Deref x -> let p = eval f x in Lp (off_of p, 0) | Tast.Field (x, i) -> field_loc f (lvalue f x) x.Tast.ty i + (* [(at a i)] denotes a location, and the source writes through it: + [(set (.x (at pts 0)) 1.5)] has to reach the array and not a copy of one + of its elements. [emit.ml] gets this from [addr]'s own [At] case; without + it here the store lands in a temporary and the program is quietly + wrong. *) + | Tast.Prim (Tast.At, [ a; i ]) -> element f (lvalue f a) a.Tast.ty i | _ -> eval f e and field_loc f (base : loc) (ty : Types.t) i = @@ -1149,7 +1155,10 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = | Tast.Exit, [ a ] -> call_rt f ~sym:"flan_exit" ~args:[ a ] ~rty:Types.Unit sink; ud2 f.b - | Tast.Argv, [] -> addr_into f ~reg:rdi dst; call_sym f.b "flan_argv" + | Tast.Argv, [] -> + addr_into f ~reg:rdi dst; + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_argv" | Tast.SizeOf ty, [] -> imm_into f ~reg:rax (Int64.of_int (sizeof f.md ty)); store_loc f ~reg:rax dst t @@ -1399,6 +1408,10 @@ let emit_main (md : Emit.m) (fn : Tast.fn) = push_r b rbp; mov_rr b ~dst:rbp ~src:rsp; sub_imm b ~dst:rsp 48; + (* [al] is zero at every call this backend makes, variadic or not — see + [call_native]. Setting it here too costs two bytes and keeps the rule + without an exception, which is worth more than the two bytes. *) + xor_rr b ~dst:rax ~src:rax; call_sym b "flan_rt_init"; let xfer = -8 and argv = -32 in xor_rr b ~dst:rax ~src:rax; @@ -1407,6 +1420,7 @@ let emit_main (md : Emit.m) (fn : Tast.fn) = | [] -> lea b ~dst:rdi ~mm:(Frame xfer) | [ _ ] -> lea b ~dst:rdi ~mm:(Frame argv); + xor_rr b ~dst:rax ~src:rax; call_sym b "flan_argv"; lea b ~dst:rdi ~mm:(Frame argv); lea b ~dst:rsi ~mm:(Frame xfer) @@ -1415,6 +1429,7 @@ let emit_main (md : Emit.m) (fn : Tast.fn) = 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; + xor_rr b ~dst:rax ~src:rax; call_sym b "flan_exit"; ud2 b; flush b; diff --git a/spike/x86/p4-convention.flan b/spike/x86/p4-convention.flan new file mode 100644 index 0000000..58ca7f0 --- /dev/null +++ b/spike/x86/p4-convention.flan @@ -0,0 +1,27 @@ +;; The internal calling convention, which the fizz program does not touch at +;; all: an aggregate argument, an aggregate return, a float in the SSE half, +;; and more integer arguments than there are registers for. + +(defstruct V3 [x f32 y f32 z f32]) + +(defn scale [v V3 k f32] V3 + (V3 {.x (* (.x v) k) .y (* (.y v) k) .z (* (.z v) k)})) + +(defn sum3 [v V3] f32 + (+ (+ (.x v) (.y v)) (.z v))) + +(defn eight [a i64 b i64 c i64 d i64 e i64 f i64 g i64 h i64] i64 + (+ (+ (+ a b) (+ c d)) (+ (+ e f) (+ g h)))) + +(defn taglen [s [u8]] i64 + (i64 (len s))) + +(defn main [] i32 + (let [v (V3 {.x 1.0 .y 2.0 .z 3.0}) + w (scale v 2.0)] + (print (sum3 v)) (println "") + (print (sum3 w)) (println "") + (print (eight 1 2 3 4 5 6 7 8)) (println "") + (print (taglen (bytes "hello"))) (println "") + (print (.z w)) (println "")) + 0) diff --git a/spike/x86/p5-core.flan b/spike/x86/p5-core.flan new file mode 100644 index 0000000..e540f5a --- /dev/null +++ b/spike/x86/p5-core.flan @@ -0,0 +1,46 @@ +;; The rest of the core: a global with an initialiser, recursion, break and +;; continue, the bitwise family, unsigned arithmetic and shifts, and the +;; conversions in both directions. + +(defvar counter i64 0) + +(defconst limit i32 6) + +(defn fib [n i64] i64 + (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) + +(defn main [] i32 + (print (fib 20)) (println "") + + (let [i 0] + (while (< i 100) + (set i (+ i 1)) + (when (= i 7) (break))) + (print i) (println "")) + + (let [j 0 seen 0] + (while (< j 10) + (set j (+ j 1)) + (when (= (% j 2) 0) (continue)) + (set seen (+ seen j))) + (print seen) (println "")) + + (dotimes [k limit] + (set counter (+ counter (i64 k)))) + (print counter) (println "") + + (let [a (bit-xor (u32 0x0F0F0F0F) (u32 0xFFFFFFF)) + b (u32 0x0F0F0F0F)] + (print (bit-or a b)) (println "") + (print (bit-and a b)) (println "") + (print (bit-xor a (u32 65535))) (println "") + (print (>> a 4)) (println "") + (print (<< b 4)) (println "")) + + (let [x (i32 -9)] + (print (/ x 2)) (println "") + (print (% x 2)) (println "") + (print (f64 x)) (println "") + (print (i32 (f64 3.9))) (println "") + (print (f32 1.5)) (println "")) + 0)