fix JIT bug in `fl->fx'

For the case that the argument is unboxed.

Closes PR 12240

collects/tests/racket/optimize.rktl

@@ -1628,6 +1628,21 @@
                (lambda () (apply values (make-list (add1 (random 1)) '(99))))
              (chaperone-procedure car (lambda (v) v)))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; check `fl->fx' on unboxed argument:
+
+(test 1 (lambda (x) (fl->fx (fl/ (fl- x 0.0) 1.0))) 1.0)
+(test 1 (lambda (x) (inexact->exact (fl/ (fl- x 0.0) 1.0))) 1.0)
+(err/rt-test (let ([f (lambda (x) (fl->fx (fl/ (fl- x 0.0) 1.0)))])
+               (set! f f)
+               (f 1e100))
+             ;; make sure that exception reports actual bad argument, and
+             ;; not some bad argument due to the fact that the original
+             ;; was unboxed:
+             (lambda (exn)
+               (regexp-match #rx"1e[+]?100" (exn-message exn))))
+(test (inexact->exact 1e100) (lambda (x) (inexact->exact (fl/ (fl- x 0.0) 1.0))) 1e100)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/racket/src/jit.h

@@ -246,7 +246,7 @@ struct scheme_jit_common_record {
   void *list_ref_code, *list_tail_code;
   void *finish_tail_call_code, *finish_tail_call_fixup_code;
   void *module_run_start_code, *module_exprun_start_code, *module_start_start_code;
-  void *box_flonum_from_stack_code;
+  void *box_flonum_from_stack_code, *box_flonum_from_reg_code;
   void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
   void *wcm_code, *wcm_nontail_code;
   void *apply_to_list_tail_code, *apply_to_list_code, *apply_to_list_multi_ok_code;

src/racket/src/jitarith.c

@@ -405,13 +405,14 @@ static int generate_double_arith(mz_jit_state *jitter, Scheme_Object *rator,
 /* Unless unboxed, first arg is in JIT_R1, second in JIT_R0.
    If unboxed in push/pop mode, first arg is pushed before second.
    If unboxed in direct mode, first arg is in JIT_FPR0+depth
-    and second is in JIT_FPR1+depth (which is backward). */
+    and second is in JIT_FPR1+depth (which is backward). 
+   Unboxed implies unsafe unless arith == ARITH_INEX_EX. */
 {
 #if defined(INLINE_FP_OPS) || defined(INLINE_FP_COMP)
   GC_CAN_IGNORE jit_insn *ref8, *ref9, *ref10, *refd, *refdt, *refs = NULL, *refs2 = NULL;
   int no_alloc = unboxed_result, need_post_pop = 0;
 
-  if (!unsafe_fl) {
+  if (!unsafe_fl && !unboxed) {
     /* Maybe they're doubles */
     __START_TINY_JUMPS__(1);
     if (two_args) {
@@ -561,6 +562,8 @@ static int generate_double_arith(mz_jit_state *jitter, Scheme_Object *rator,
           /* to check whether it fits in a fixnum, we
              need to convert back and check whether it
              is the same */
+          if (unboxed)
+            jit_movr_d_fppush(fpr1+1, fpr1); /* for slow path */
           jit_extr_l_d_fppush(fpr0, JIT_R1);
           __START_TINY_JUMPS__(1);
           refs = jit_bantieqr_d_fppop(jit_forward(), fpr0, fpr1);
@@ -571,6 +574,10 @@ static int generate_double_arith(mz_jit_state *jitter, Scheme_Object *rator,
           __START_TINY_JUMPS__(1);
           refs2 = jit_bner_l(jit_forward(), JIT_R1, JIT_R2);
           __END_TINY_JUMPS__(1);
+#ifndef DIRECT_FPR_ACCESS
+          if (unboxed)
+            jit_roundr_d_l_fppop(JIT_R1, fpr2); /* slow path won't be needed */
+#endif
         }
         jit_lshi_l(JIT_R0, JIT_R1, 1);
         jit_ori_l(JIT_R0, JIT_R0, 0x1);
@@ -691,11 +698,13 @@ static int generate_double_arith(mz_jit_state *jitter, Scheme_Object *rator,
     /* No, they're not both doubles, or slow path is needed
        for some other reason. */
     __START_TINY_JUMPS__(1);
+    if (!unboxed) {
       if (two_args) {
         mz_patch_branch(ref8);
         mz_patch_branch(ref10);
       }
       mz_patch_branch(ref9);
+    }
     if (refs)
       mz_patch_branch(refs);
     if (refs2)
@@ -948,7 +957,7 @@ int scheme_generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
 
     generate_double_arith(jitter, rator, arith, cmp, reversed, !!rand2, 0,
                           &refd, &refdt, for_branch, branch_short, 
-                          (arith == 15) ? (unsafe_fl > 0) : 1, 
+                          (arith == ARITH_INEX_EX) ? (unsafe_fl > 0) : 1, 
                           args_unboxed, jitter->unbox);
     CHECK_LIMIT();
     ref3 = NULL;
@@ -957,6 +966,9 @@ int scheme_generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
 
     if ((arith == ARITH_INEX_EX) && (unsafe_fl < 1)) {
       /* need a slow path */
+      if (args_unboxed) {
+        (void)jit_calli(sjc.box_flonum_from_reg_code);
+      }
       generate_arith_slow_path(jitter, rator, &ref, &ref4, for_branch, orig_args, reversed, arith, 0, 0);
       /* assert: !ref4, since not for_branch */
       jit_patch_movi(ref, (_jit.x.pc));

src/racket/src/jitcommon.c

@@ -1943,6 +1943,25 @@ static int common5(mz_jit_state *jitter, void *_data)
     mz_epilog(JIT_R2);
   }
 
+  /* *** box_flonum_from_reg_code *** */
+  /* JIT_FPR2 (reg-based) or JIT_FPR0 (stack-based) has value */
+  {
+    sjc.box_flonum_from_reg_code = jit_get_ip().ptr;
+
+    mz_prolog(JIT_R2);
+
+    JIT_UPDATE_THREAD_RSPTR();
+
+#ifdef DIRECT_FPR_ACCESS
+    jit_movr_d(JIT_FP0, JIT_FP2);
+#endif
+
+    scheme_generate_alloc_double(jitter, 1);
+    CHECK_LIMIT();
+    
+    mz_epilog(JIT_R2);
+  }
+
   /* *** fl1_code *** */
   /* R0 has argument, V1 has primitive proc */
   {