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

The x86 backend describes its frames in every build, and converts a u64 to and from a float as LLVM does

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 10:43:20 +07:00
commit 12c3d07acf
6 changed files with 189 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
TODO.org
View File

@ -1099,9 +1099,12 @@ build included, reaches =emit_globals_init= as =Emit.startup_plan='s
straight into their symbol are =Tast.const_init= ones, which neither transfer
nor read anything. Nothing to change.
** TODO A u64 converted to f64 is signed on x86
=(f64 (u64 18446744073709551615))= prints =1.84467e+19= under LLVM and =-1= under
=--x86=, with a literal or a run-time =u64= alike.
** DONE A u64 converted to f64 is signed on x86
CLOSED: [2026-09-25]
=--x86= converts =u64= to and from =f64= and =f32= the way LLVM's =uitofp= and
=fptoui= do: the halve-and-double sequence one way, subtract 2^63 and set the top
bit the other, ties rounding to even. =test/programs/u64-float.flan= runs on both
backends. A cast that misses =u64='s range reports it as =[0 18446744073709551615]=.
** DONE An aggregate built in place never reads its own destination
CLOSED: [2026-09-25]
@ -1130,10 +1133,12 @@ so a =declare-c= wrapper leaning on the courtesy is already backend-dependent as
well as slice-dependent. The contract is pointer and length, and nothing promised
otherwise.
** NEXT Frame descriptions are gated on --debug
Decided 2026-09-25: emit the x86 backend's =.cfi= directives in every build. No runtime cost; the lane measures the =.eh_frame= size it adds.
They are correct in every build and free at runtime, and a release build is where
a crash would most want them. One =if= in three places.
** DONE Frame descriptions are gated on --debug
CLOSED: [2026-09-25]
The x86 backend emits its =.cfi= directives in every build, redefinition modules
included, so an unwinder never has to guess at a Flan frame. Cost: about 40 bytes
of =.eh_frame= and =.eh_frame_hdr= per function, 2 KB on =json.flan='s 210 KB
binary.
** WAIT A !DILexicalBlock per Let
Decided 2026-09-25: waits until Flan is debugged in gdb or lldb; the break buffer, which reads the shadow stack, already answers correctly.

105
lib/x86.ml
View File

@ -1333,6 +1333,7 @@ let option_lay f (t : Types.t) =
let cc_e = 4 and cc_ne = 5
let cc_b = 2 and cc_ae = 3 and cc_be = 6 and cc_a = 7
let cc_l = 12 and cc_ge = 13 and cc_le = 14 and cc_g = 15
let cc_s = 8
let int_cc ~signed (p : Tast.prim) =
match p, signed with
@ -3419,9 +3420,29 @@ and cast f (a : Tast.expr) (target : Types.t) dst =
cvtss2sd f.b ~dst:xmm0 ~src:xmm0;
fstore f.b ~src:xmm0 ~mm:(lmem f dst ~scratch:r11) ~f64:(f64_of dst_t)
| false, true ->
let f64 = f64_of dst_t in
load_loc f ~reg:rax l src_t;
cvtsi2f f.b ~f64:(f64_of dst_t) ~dst:xmm0 ~src:rax;
fstore f.b ~src:xmm0 ~mm:(lmem f dst ~scratch:r11) ~f64:(f64_of dst_t)
if src_t = Types.Int Types.U64 then begin
(* [cvtsi2sd] reads the register as signed, so a u64 with the top bit
set is halved first and doubled after. The bit shifted out is ORed
back into the lowest one, which keeps the halved value from landing
exactly on a tie it was not on, so the one rounding the conversion
does is the rounding of the whole value. *)
let big = new_label f "u2fbig" and done_ = new_label f "u2fdone" in
test_rr f.b ~a:rax ~c:rax;
jcc_lbl f.b ~cc:cc_s big;
cvtsi2f f.b ~f64 ~dst:xmm0 ~src:rax;
jmp_lbl f.b done_;
lbl f.b big;
mov_rr f.b ~dst:rcx ~src:rax;
shr_imm f.b ~dst:rcx ~n:1;
and_imm f.b ~dst:rax 1;
or_rr f.b ~dst:rcx ~src:rax;
cvtsi2f f.b ~f64 ~dst:xmm0 ~src:rcx;
farith f.b ~op:0x58 ~f64 ~dst:xmm0 ~src:xmm0;
lbl f.b done_
end else cvtsi2f f.b ~f64 ~dst:xmm0 ~src:rax;
fstore f.b ~src:xmm0 ~mm:(lmem f dst ~scratch:r11) ~f64
| true, false ->
fload f.b ~dst:xmm0 ~mm:(lmem f l ~scratch:r11) ~f64:(f64_of src_t);
(* [cvttsd2si] answers a fixed "integer indefinite" for a value out of
@ -3431,7 +3452,24 @@ and cast f (a : Tast.expr) (target : Types.t) dst =
(match src_t, dst_t with
| Types.Float sk, Types.Int k -> check_cast f a.Tast.loc sk k
| _ -> ());
cvttf2si f.b ~f64:(f64_of src_t) ~dst:rax ~src:xmm0;
let f64 = f64_of src_t in
if dst_t = Types.Int Types.U64 then begin
(* [cvttsd2si] answers only for the signed range, so a value at 2^63 or
above has 2^63 taken off before the conversion and the top bit set
after it. A NaN compares unordered and takes the first branch. *)
let big = new_label f "f2ubig" and done_ = new_label f "f2udone" in
fload f.b ~dst:1 ~mm:(Sym (float_const f (ldexp 1.0 63) ~f64, 0)) ~f64;
ucomis f.b ~f64 ~a:xmm0 ~c:1;
jcc_lbl f.b ~cc:cc_ae big;
cvttf2si f.b ~f64 ~dst:rax ~src:xmm0;
jmp_lbl f.b done_;
lbl f.b big;
farith f.b ~op:0x5c ~f64 ~dst:xmm0 ~src:1;
cvttf2si f.b ~f64 ~dst:rax ~src:xmm0;
imm_into f ~reg:rcx Int64.min_int;
xor_rr f.b ~dst:rax ~src:rcx;
lbl f.b done_
end else cvttf2si f.b ~f64 ~dst:rax ~src:xmm0;
store_loc f ~reg:rax dst dst_t
(* ── Call frame information ──────────────────────────────────────────── *)
@ -3454,12 +3492,8 @@ and cast f (a : Tast.expr) (target : Types.t) dst =
the return address is column 16 and the CIE already says it is at
[cfa-8].
Emitted only in a [--debug] build, so that a release build's assembly stays
byte-for-byte what it was. That is a conservative call rather than a
principled one: this description is correct in every build, and a release
build is where an unwind through a crash would most want it. What stops it
from being unconditional today is only that nothing measures the [.eh_frame]
it would add. *)
Emitted in every build, [--debug] or not. It costs nothing at run time,
and a release build is where an unwind through a crash most wants it. *)
let cfi_after_push b = text b "\t.cfi_def_cfa_offset 16\n\t.cfi_offset 6, -16\n"
let cfi_after_mov b = text b "\t.cfi_def_cfa_register 6\n"
let cfi_after_leave b = text b "\t.cfi_def_cfa 7, 8\n"
@ -3711,7 +3745,6 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
column even when it is on the same line, so it gets a row of its own, and
two rows are what let a debugger put a breakpoint after the prologue
rather than on it. *)
let cfi = match dw with None -> false | Some _ -> true in
let sub =
match dw with
| None -> None
@ -4069,9 +4102,9 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
% 16 == 0 at every call site below is a property of that one rounded sub rather \
than an invariant each case has to keep.";
push_r pb rbp;
if cfi then cfi_after_push pb;
cfi_after_push pb;
mov_rr pb ~dst:rbp ~src:rsp;
if cfi then cfi_after_mov pb;
cfi_after_mov pb;
let n = frame_bytes f in
if n > 0 then sub_imm pb ~dst:rsp n;
(match sret_at with
@ -4184,7 +4217,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
load_scalar f ~reg:(if is_float fn.Tast.ret then xmm0 else rax)
~off:f.retval fn.Tast.ret;
leave f.b;
if cfi then cfi_after_leave f.b;
cfi_after_leave f.b;
ret f.b;
flush pb;
flush f.b;
@ -4206,7 +4239,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
if hidden then Buffer.add_string out (Printf.sprintf "\t.hidden\t%s\n" sym);
Buffer.add_string out (Printf.sprintf "\t.type\t%s, @function\n" sym);
Buffer.add_string out (sym ^ ":\n");
if cfi then Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out (Buffer.contents pb.out);
Buffer.add_string out (Buffer.contents f.b.out);
(* One past the last byte, which is what [DW_AT_high_pc] and the line
@ -4217,7 +4250,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
| Some s -> Buffer.add_string out (s.send ^ ":\n")
| None -> ());
(match dw with Some d -> d.dcur <- None | None -> ());
if cfi then Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out (Printf.sprintf "\t.size\t%s, . - %s\n\n" sym sym);
Buffer.contents out, Buffer.contents f.rodata
@ -4254,7 +4287,7 @@ let init_sym = asm_sym (Mangle.sym ".init-globals")
the loader put them in, the program's own end of the transfer channel is a
null cell on this frame, and the exit goes through [flan_exit] because
stdout is a FILE* and something has to flush it. *)
let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false)
let emit_main ?(ann = false) ?(startup = false) ?(gc = false)
?(dyn_globals = []) (md : Emit.m) (fn : Tast.fn) =
let b = create () in
bnote ann b
@ -4266,9 +4299,9 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false)
and something has to flush it. The ud2 at the end is unreachable — flan_exit does \
not return.";
push_r b rbp;
if cfi then cfi_after_push b;
cfi_after_push b;
mov_rr b ~dst:rbp ~src:rsp;
if cfi then cfi_after_mov b;
cfi_after_mov b;
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
@ -4380,9 +4413,9 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false)
it leaves through [flan_exit] and the [ud2] after that is unreachable.
The rbp rule therefore holds to the last byte, which is what a backtrace
out of anything [main] called needs. *)
if cfi then Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out (Buffer.contents b.out);
if cfi then Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out "\t.size\tmain, . - main\n\n";
Buffer.contents out
@ -4409,7 +4442,7 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) =
Buffer.contents out
let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns
let emit_globals_init ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns
(globals : Tast.global list) =
let b = create () in
let f =
@ -4454,9 +4487,9 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~ex
end;
let pb = create () in
push_r pb rbp;
if cfi then cfi_after_push pb;
cfi_after_push pb;
mov_rr pb ~dst:rbp ~src:rsp;
if cfi then cfi_after_mov pb;
cfi_after_mov pb;
let n = frame_bytes f in
if n > 0 then sub_imm pb ~dst:rsp n;
(* No caller hands this one a channel, so it gets a null cell of its own and
@ -4467,16 +4500,16 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~ex
store_int pb ~src:rax ~mm:(Frame f.xfer_off) ~size:8;
lbl f.b f.retlbl;
leave f.b;
if cfi then cfi_after_leave f.b;
cfi_after_leave f.b;
ret f.b;
flush pb; flush f.b;
let out = Buffer.create 512 in
Buffer.add_string out
(Printf.sprintf "\t.type\t%s, @function\n%s:\n" sym sym);
if cfi then Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out "\t.cfi_startproc\n";
Buffer.add_string out (Buffer.contents pb.out);
Buffer.add_string out (Buffer.contents f.b.out);
if cfi then Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out "\t.cfi_endproc\n";
Buffer.add_string out (Printf.sprintf "\t.size\t%s, . - %s\n\n" sym sym);
Buffer.contents out, Buffer.contents f.rodata
@ -4832,7 +4865,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
in
let computed, init_flags, init_body = Emit.startup_plan md p.Tast.globals in
let ginit, gr =
emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns
emit_globals_init ~ann:annotate ~sym:data_sym md ~externs ~fns
constants
in
Buffer.add_string text ginit;
@ -4840,7 +4873,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
let startup = computed <> [] in
if startup then begin
let t, r =
emit_globals_init ~cfi:debug ~ann:annotate ~body:init_body ~sym:init_sym
emit_globals_init ~ann:annotate ~body:init_body ~sym:init_sym
md ~externs ~fns computed
in
Buffer.add_string text t;
@ -4849,7 +4882,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
(match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with
| Some fn ->
Buffer.add_string text
(emit_main ~cfi:debug ~ann:annotate ~startup ~gc:(Emit.uses_dyn p)
(emit_main ~ann:annotate ~startup ~gc:(Emit.uses_dyn p)
~dyn_globals:
(List.filter_map
(fun (g : Tast.global) ->
@ -5217,7 +5250,9 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
end;
let pb = create () in
push_r pb rbp;
cfi_after_push pb;
mov_rr pb ~dst:rbp ~src:rsp;
cfi_after_mov pb;
let n = frame_bytes f in
if n > 0 then sub_imm pb ~dst:rsp n;
xor_rr pb ~dst:rax ~src:rax;
@ -5226,17 +5261,18 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
store_int pb ~src:rax ~mm:(Frame f.xfer_off) ~size:8;
lbl f.b f.retlbl;
leave f.b;
cfi_after_leave f.b;
ret f.b;
flush pb;
flush f.b;
Buffer.add_string text
"\t.globl\tflan_reload_install\n\
\t.type\tflan_reload_install, @function\n\
flan_reload_install:\n";
flan_reload_install:\n\t.cfi_startproc\n";
Buffer.add_buffer text pb.out;
Buffer.add_buffer text f.b.out;
Buffer.add_string text
"\t.size\tflan_reload_install, . - flan_reload_install\n\n";
"\t.cfi_endproc\n\t.size\tflan_reload_install, . - flan_reload_install\n\n";
(* An expression evaluation compiles to a function with nowhere to be called
from, so the module says so and the agent runs it once -- after the
install, on the game thread, so it sees both the bodies this module just
@ -5252,7 +5288,9 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
| Some fn ->
let cb = create () in
push_r cb rbp;
cfi_after_push cb;
mov_rr cb ~dst:rbp ~src:rsp;
cfi_after_mov cb;
sub_imm cb ~dst:rsp 16;
xor_rr cb ~dst:rax ~src:rax;
store_int cb ~src:rax ~mm:(Frame (-8)) ~size:8;
@ -5260,15 +5298,16 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
xor_rr cb ~dst:rax ~src:rax;
call_sym cb (fsym fn);
leave cb;
cfi_after_leave cb;
ret cb;
flush cb;
Buffer.add_string text
"\t.globl\tflan_reload_call\n\
\t.type\tflan_reload_call, @function\n\
flan_reload_call:\n";
flan_reload_call:\n\t.cfi_startproc\n";
Buffer.add_buffer text cb.out;
Buffer.add_string text
"\t.size\tflan_reload_call, . - flan_reload_call\n\n");
"\t.cfi_endproc\n\t.size\tflan_reload_call, . - flan_reload_call\n\n");
Buffer.add_buffer rodata f.rodata;
let out = Buffer.create 8192 in
Buffer.add_buffer out text;

16
runtime/flan_rt.c
View File

@ -1020,11 +1020,19 @@ static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op,
"to\n",
(int)loclen, (const char *)loc);
break;
/* An unsigned type's range starts at zero and a signed one's below it, so
* the lower bound says how to read the upper one: u64's is all ones. */
default:
fprintf(stderr,
"%.*s: this value does not fit the integer type it is cast to, "
"which holds [%lld %lld]\n",
(int)loclen, (const char *)loc, (long long)lhs, (long long)rhs);
if (lhs == 0)
fprintf(stderr,
"%.*s: this value does not fit the integer type it is cast to, "
"which holds [0 %llu]\n",
(int)loclen, (const char *)loc, (unsigned long long)rhs);
else
fprintf(stderr,
"%.*s: this value does not fit the integer type it is cast to, "
"which holds [%lld %lld]\n",
(int)loclen, (const char *)loc, (long long)lhs, (long long)rhs);
break;
}
rt_die();

3
test/programs/arith.flan
View File

@ -82,6 +82,9 @@
(= n 10) (print (i32 (/ (f64 1.0) (f64 0.0))))
(= n 11) (print (u8 (/ (f32 -1.0) (f32 0.0))))
(= n 12) (print (i32 (/ (f32 0.0) (f32 0.0))))
;; A u64 destination, whose upper bound is all ones and is printed as
;; the unsigned number it is.
(= n 13) (print (u64 (* huge 1e-280)))
:else (println "?"))
0))

65
test/programs/u64-float.flan Normal file
View File

@ -0,0 +1,65 @@
;;;; Conversions between the unsigned integers and the floats, across the top
;;;; half of u64's range, where the value does not fit a signed register. Both
;;;; backends print the same lines. Each case is written twice: once through a
;;;; global, so the conversion happens at run time, and once on a literal.
;;;;
;;;; A float is printed by converting it back to an integer, because the
;;;; printed float has six digits and every case here differs past the sixth.
(defonce top u64 18446744073709551615) ; 2^64 - 1
(defonce half1 u64 9223372036854775809) ; 2^63 + 1
(defonce tie0 u64 9223372036854776832) ; 2^63 + 1024, a tie that rounds down to even
(defonce tie1 u64 9223372036854778880) ; 2^63 + 3072, a tie that rounds up to even
(defonce above u64 9223372036854776833) ; 2^63 + 1025, just past a tie
(defonce small u64 12345)
(defonce ftie0 u64 9223372586610589696) ; 2^63 + 2^39, an f32 tie that rounds down
(defonce fup u64 9223372586610589697) ; 2^63 + 2^39 + 1
(defonce ftie1 u64 9223373686122217472) ; 2^63 + 3*2^39, an f32 tie that rounds up
(defonce u32top u32 4294967295)
(defonce d63 f64 9223372036854775808.0) ; 2^63
(defonce dmax f64 18446744073709549568.0) ; the largest f64 below 2^64
(defonce dbelow f64 9223372036854774784.0) ; the largest f64 below 2^63
(defonce d15 f64 1.5e19)
(defonce dsmall f64 7.9)
(defonce s63 f32 9223372036854775808.0)
(defonce smax f32 18446742974197923840.0) ; the largest f32 below 2^64
(defonce d32 f64 4294967295.0)
(defonce d3e9 f64 3e9)
(defn main [] i32
;; u64 to f64.
(println (f64 top))
(println (u64 (* (f64 top) 0.5)))
(println (u64 (f64 half1)))
(println (u64 (f64 tie0)))
(println (u64 (f64 tie1)))
(println (u64 (f64 above)))
(println (u64 (f64 small)))
(println (f64 (u64 18446744073709551615)))
(println (u64 (f64 (u64 9223372036854778880))))
;; u64 to f32.
(println (u64 (* (f32 top) (f32 0.5))))
(println (u64 (f32 ftie0)))
(println (u64 (f32 fup)))
(println (u64 (f32 ftie1)))
(println (u64 (f32 small)))
(println (u64 (f32 (u64 9223372586610589697))))
;; u32 to both.
(println (u64 (f64 u32top)))
(println (u64 (f32 u32top)))
;; f64 and f32 to u64.
(println (u64 d63))
(println (u64 dmax))
(println (u64 dbelow))
(println (u64 d15))
(println (u64 dsmall))
(println (u64 s63))
(println (u64 smax))
(println (u64 18446744073709549568.0))
(println (u64 (f32 1.5e19)))
;; f64 to u32.
(println (u32 d32))
(println (u32 d3e9))
(println (u32 4294967295.0))
0)

25
test/test_acceptance.ml
View File

@ -2639,6 +2639,8 @@ let () =
"this value is infinite, which has no integer value to cast to";
traps "an f32 NaN cast to an integer" "12"
"this value is NaN, which has no integer value to cast to";
traps "a float too large for a u64" "13"
"which holds [0 18446744073709551615]";
(try Sys.remove exe with Sys_error _ -> ())
in
arith ();
@ -2772,6 +2774,29 @@ let () =
outputs ~x86:true
"an aggregate that reads its destination sees the old value, --x86"
"programs/self-read.flan" self_read_out;
(* Conversions between u64 and the floats across the top half of u64's
range, where [cvtsi2sd] and [cvttsd2si] read the register as signed:
x86 answered -1 for (f64 (u64 18446744073709551615)). The expected
lines are what LLVM's [uitofp] and [fptoui] give, ties included. *)
let u64_float_out =
"1.84467e+19\n9223372036854775808\n9223372036854775808\n\
9223372036854775808\n9223372036854779904\n9223372036854777856\n\
12345\n1.84467e+19\n9223372036854779904\n9223372036854775808\n\
9223372036854775808\n9223373136366403584\n9223374235878031360\n\
12345\n9223373136366403584\n4294967295\n4294967296\n\
9223372036854775808\n18446744073709549568\n9223372036854774784\n\
15000000000000000000\n7\n9223372036854775808\n\
18446742974197923840\n18446744073709549568\n15000000520515485696\n\
4294967295\n3000000000\n4294967295\n"
in
outputs "u64 and the floats convert across the whole range"
"programs/u64-float.flan" u64_float_out;
outputs ~opt:"-O0"
"u64 and the floats convert across the whole range, -O0"
"programs/u64-float.flan" u64_float_out;
outputs ~x86:true
"u64 and the floats convert across the whole range, --x86"
"programs/u64-float.flan" u64_float_out;
(* ── Packages: the link follows the program ────────────────────────
A package's C and linker arguments used to come with the import,