(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:
parent
2155c41465
commit
786656dfee
17
lib/x86.ml
17
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;
|
||||
|
||||
27
spike/x86/p4-convention.flan
Normal file
27
spike/x86/p4-convention.flan
Normal 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
46
spike/x86/p5-core.flan
Normal 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)
|
||||
Loading…
x
Reference in New Issue
Block a user