From 6b9d1fa64451cd9be76c0e8c60e6baf0867516bc Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 06:58:06 +0700 Subject: [PATCH] A cast of NaN or an infinity to an integer says so by name, on both backends --- lib/emit.ml | 22 ++++++++++++++++++++-- lib/prelude.ml | 4 +++- lib/x86.ml | 22 ++++++++++++++++++++++ runtime/flan_rt.c | 17 ++++++++++++++++- test/programs/arith-condition.flan | 3 ++- test/programs/arith.flan | 6 ++++++ test/test_acceptance.ml | 19 +++++++++++++++---- 7 files changed, 84 insertions(+), 9 deletions(-) diff --git a/lib/emit.ml b/lib/emit.ml index f6af7bbc..9cf3a25f 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1517,6 +1517,8 @@ let arith_rem_zero = 1 let arith_div_overflow = 2 let arith_rem_overflow = 3 let arith_cast_range = 4 +let arith_cast_nan = 5 +let arith_cast_inf = 6 (* ArithError's fields are i64 and an operand may be narrower, so every operand is widened on the way into the condition — signed or not according @@ -1668,11 +1670,27 @@ let check_cast f ~guard loc (src : Types.fkind) (k : Types.ikind) v = ins f "%s = fcmp olt double %s, %s" b v (dbl hi_f); let ok = fresh f in ins f "%s = and i1 %s, %s" ok a b; + (* NaN and the infinities are named rather than reported as out of range: + they are not values that overshot the type, they have no integer at + all. Worked out on the cold path, so the guard is still two compares. *) signal_block f loc ~guard ok (fun id nn -> + let nan = fresh f in + ins f "%s = fcmp uno double %s, %s" nan v v; + let pinf = fresh f in + ins f "%s = fcmp oeq double %s, %s" pinf v (dbl infinity); + let ninf = fresh f in + ins f "%s = fcmp oeq double %s, %s" ninf v (dbl neg_infinity); + let inf = fresh f in + ins f "%s = or i1 %s, %s" inf pinf ninf; + let c1 = fresh f in + ins f "%s = select i1 %s, i32 %d, i32 %d" c1 inf arith_cast_inf + arith_cast_range; + let code = fresh f in + ins f "%s = select i1 %s, i32 %d, i32 %s" code nan arith_cast_nan c1; ins f - "call void @flan_arith_error(ptr %s, i64 %d, i32 %d, i64 %Ld, i64 %Ld, \ + "call void @flan_arith_error(ptr %s, i64 %d, i32 %s, i64 %Ld, i64 %Ld, \ ptr %s)" - id nn arith_cast_range lo_i hi_i xfer_param) + id nn code lo_i hi_i xfer_param) end (* [at] is strict: the last valid index is len - 1. *) diff --git a/lib/prelude.ml b/lib/prelude.ml index ee7e83e9..f8deb3ff 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -123,9 +123,11 @@ let source = {flan| ;; 0 (/ a 0) 1 (% a 0) ;; 2 (/ min -1) 3 (% min -1) ;; 4 a float to integer cast whose value does not fit +;; 5 a float to integer cast of NaN +;; 6 a float to integer cast of an infinity ;; ;; `lhs` and `rhs` are the two operands for codes 0 through 3 and the -;; destination type's representable range for code 4 — the violated condition +;; destination type's representable range for codes 4 through 6 — the violated condition ;; written as a range, which is what flan_slice_promise_error already does ;; with BoundsError's fields. Two meanings over two fields rather than two ;; condition types, so that a handler writes one clause and not five. The diff --git a/lib/x86.ml b/lib/x86.ml index b01553ff..2a16a639 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -2812,8 +2812,30 @@ and check_cast f (loc : Loc.t) (src : Types.fkind) (k : Types.ikind) = ucomis f.b ~f64 ~a:1 ~c:xmm0; jcc_lbl f.b ~cc:cc_a ok; lbl f.b bad; + (* Which code, on the cold path: NaN and the infinities are named rather + than reported as out of range. xmm0 still holds the value here. *) + let call = new_label f "nofitcall" and notnan = new_label f "notnan" + and isinf = new_label f "isinf" in imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_range); store_int f.b ~src:rax ~mm:(Frame so) ~size:8; + ucomis f.b ~f64 ~a:xmm0 ~c:xmm0; + jcc_lbl f.b ~cc:cc_np notnan; + imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_nan); + store_int f.b ~src:rax ~mm:(Frame so) ~size:8; + jmp_lbl f.b call; + lbl f.b notnan; + let kpinf = float_const f infinity ~f64 + and kninf = float_const f neg_infinity ~f64 in + fload f.b ~dst:1 ~mm:(Sym (kpinf, 0)) ~f64; + ucomis f.b ~f64 ~a:xmm0 ~c:1; + jcc_lbl f.b ~cc:cc_e isinf; + fload f.b ~dst:1 ~mm:(Sym (kninf, 0)) ~f64; + ucomis f.b ~f64 ~a:xmm0 ~c:1; + jcc_lbl f.b ~cc:cc_ne call; + lbl f.b isinf; + imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_inf); + store_int f.b ~src:rax ~mm:(Frame so) ~size:8; + lbl f.b call; imm_into f ~reg:rax lo_i; store_int f.b ~src:rax ~mm:(Frame sa) ~size:8; imm_into f ~reg:rax hi_i; diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 00a9ddef..5c91b6c6 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -969,7 +969,9 @@ enum { FLAN_ARITH_REM_ZERO = 1, FLAN_ARITH_DIV_OVERFLOW = 2, FLAN_ARITH_REM_OVERFLOW = 3, - FLAN_ARITH_CAST_RANGE = 4 + FLAN_ARITH_CAST_RANGE = 4, + FLAN_ARITH_CAST_NAN = 5, + FLAN_ARITH_CAST_INF = 6 }; typedef struct { int32_t op; int64_t lhs, rhs; } flan_arith_cond; @@ -1005,6 +1007,19 @@ static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op, op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs, (long long)rhs); break; + /* NaN and the infinities did not overshoot the range: no integer is + * their value, whatever the type. Saying "does not fit" reads as too big. */ + case FLAN_ARITH_CAST_NAN: + fprintf(stderr, + "%.*s: this value is NaN, which has no integer value to cast to\n", + (int)loclen, (const char *)loc); + break; + case FLAN_ARITH_CAST_INF: + fprintf(stderr, + "%.*s: this value is infinite, which has no integer value to cast " + "to\n", + (int)loclen, (const char *)loc); + break; default: fprintf(stderr, "%.*s: this value does not fit the integer type it is cast to, " diff --git a/test/programs/arith-condition.flan b/test/programs/arith-condition.flan index 62ba1381..78bd2019 100644 --- a/test/programs/arith-condition.flan +++ b/test/programs/arith-condition.flan @@ -180,7 +180,8 @@ ;; NaN fails both halves of the range test, which is deliberate: a NaN ;; cast to an integer is exactly as undefined as a value out of range, - ;; and an unordered comparison would have waved it through. + ;; and an unordered comparison would have waved it through. Its code is + ;; 5, which names NaN, rather than 4, which says it overshot the range. (cast-frame (/ (f64 0.0) (f64 0.0))) (show "op" (i64 op)) diff --git a/test/programs/arith.flan b/test/programs/arith.flan index 71b747c4..9a9d0601 100644 --- a/test/programs/arith.flan +++ b/test/programs/arith.flan @@ -76,6 +76,12 @@ ;; double there, which agree because every bound is a power of two and is ;; exact in both. (= n 9) (print (i32 wide)) + ;; NaN and the infinities have no integer value at all, so the message + ;; names them rather than a range they did not overshoot. An f32 source + ;; for each too, since the two backends test it at different widths. + (= 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)))) :else (println "?")) 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 58a8cf4e..3b5bfcdb 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2543,8 +2543,8 @@ let () = no overflow case because it has no most-negative value, and a float division by zero, which is an infinity and is a defined answer this language has no business refusing. *) - let arith ?opt () = - let exe = compile ?opt "programs/arith.flan" in + let arith ?opt ?x86 () = + let exe = compile ?opt ?x86 "programs/arith.flan" in let traps name arg reason = let code, text = run exe (Some arg) in if code <> 134 @@ -2587,7 +2587,7 @@ let () = would have waved it through into an fptosi that is as undefined for a NaN as it is for 1e300. *) traps "NaN cast to an integer" "7" - "does not fit the integer type it is cast to"; + "this value is NaN, which has no integer value to cast to"; (* One width down, and this is the case the two backends disagreed about *silently* rather than both dying: x86 loaded the operands sign-extended into 64-bit registers, divided there and truncated on @@ -2604,10 +2604,21 @@ let () = and this is the row that says so rather than the comment. *) traps "an f32 too large for an i32" "9" "which holds [-2147483648 2147483647]"; + (* NaN and the infinities are named: they did not overshoot a range, + they have no integer value at all. *) + traps "an infinity cast to an integer" "10" + "this value is infinite, which has no integer value to cast to"; + traps "an f32 negative infinity cast to a u8" "11" + "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"; (try Sys.remove exe with Sys_error _ -> ()) in arith (); arith ~opt:"-O0" (); + (* The x86 backend picks the code with its own instructions, so the three + named cases are asserted there as well as in the survey. *) + arith ~x86:true (); (* The release build drops the guards. Asserted on the IR and not by running an unchecked program, for the reason the bounds case gives: an @@ -2646,7 +2657,7 @@ let () = op 2\nlhs -9223372036854775808\nrhs -1\nop 3\n\ cast 3\ncast -3\n\ op 4\nlhs -9223372036854775808\nrhs 9223372036854775807\nop 4\n\ - cast8 12\nlhs -128\nrhs 127\nop 4\n\ + cast8 12\nlhs -128\nrhs 127\nop 5\n\ lit 4611686018427387903\nu 14\n\ frames 4\nskipped 8\ncleaned 12\n" in