(at a i) on the left of a set has to reach the array

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.
This commit is contained in:
Joseph Ferano 2026-09-13 15:03:41 +07:00
parent 2155c41465
commit 786656dfee
3 changed files with 89 additions and 1 deletions

View File

@ -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;

View File

@ -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)

46
spike/x86/p5-core.flan Normal file
View File

@ -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)