add flreal-part', flimag-part', `make-flrectangular', and unsafe variants

collects/racket/flonum.rkt

@@ -8,4 +8,5 @@
          fl= fl< fl<= fl> fl>= flmin flmax
          ->fl fl->exact-integer
          flvector? flvector make-flvector 
-         flvector-length flvector-ref flvector-set!)
+         flvector-length flvector-ref flvector-set!
+         flreal-part flimag-part make-flrectangular)

collects/scribblings/reference/numbers.scrbl

@@ -1026,6 +1026,18 @@ Like @racket[inexact->exact], but constrained to consume an
 integer.}
 
 
+@deftogether[(
+@defproc[(make-flrectangular [a inexact-real?] [b inexact-real?]) 
+         (and/c complex? inexact? (not/c real?))]
+@defproc[(flreal-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+@defproc[(flimag-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+)]{
+
+Like @racket[make-rectangular], @racket[real-part], and
+@racket[imag-part], but both parts of the complex number must be
+inexact.}
+
+
 @subsection{Flonum Vectors}
 
 A @deftech{flvector} is like a @tech{vector}, but it holds only

collects/scribblings/reference/unsafe.scrbl

@@ -148,6 +148,18 @@ For @tech{flonums}: Unchecked (potentially) versions of
 @scheme[flsqrt]. Currently, some of these bindings are simply aliases
 for the corresponding safe bindings.}
 
+
+@deftogether[(
+@defproc[(unsafe-make-flrectangular [a inexact-real?] [b inexact-real?]) 
+         (and/c complex? inexact? (not/c real?))]
+@defproc[(unsafe-flreal-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+@defproc[(unsafe-flimag-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+)]{
+
+For @tech{flonums}: Unchecked versions of @racket[make-flrectangular],
+@racket[flreal-part], and @racket[flimag-part].}
+
+
 @deftogether[(
 @defproc[(unsafe-fx->fl [a fixnum?]) inexact-real?]
 @defproc[(unsafe-fl->fx [a inexact-real?]) fixnum?]

collects/tests/racket/optimize.rktl

@@ -3,8 +3,8 @@
 
 (Section 'optimization)
 
-(require scheme/flonum
+(require racket/flonum
-         scheme/fixnum
+         racket/fixnum
          compiler/zo-parse)
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -12,8 +12,8 @@
 ;; Check JIT inlining of primitives:
 (parameterize ([current-namespace (make-base-namespace)]
 	       [eval-jit-enabled #t])
-  (namespace-require 'scheme/flonum)
+  (namespace-require 'racket/flonum)
-  (namespace-require 'scheme/fixnum)
+  (namespace-require 'racket/fixnum)
   (let* ([check-error-message (lambda (name proc)
 				(unless (memq name '(eq? not null? pair?
 							 real? number? boolean? 
@@ -507,13 +507,17 @@
 
     (un 1 'real-part 1+2i)
     (un 105 'real-part 105)
+    (un-exact 10.0 'flreal-part 10.0+7.0i)
     (un 2 'imag-part 1+2i)
     (un-exact 0 'imag-part 106)
     (un-exact 0 'imag-part 106.0)
+    (un-exact 7.0 'flimag-part 10.0+7.0i)
 
     (bin 1+2i 'make-rectangular 1 2)
     (bin-exact 1.0+2.0i 'make-rectangular 1 2.0)
     (bin-exact 1.0+2.0i 'make-rectangular 1.0 2)
+    (bin-exact 1.0+0.5i 'make-rectangular 1.0 1/2)
+    (bin-exact 0.75+2.0i 'make-rectangular 3/4 2.0)
     (bin-exact 1 'make-rectangular 1 0)
     (bin-exact 1.0 'make-rectangular 1.0 0)
 
@@ -999,27 +1003,27 @@
                 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ x 10))))))))))))))
 
 (let ([check (lambda (proc arities non-arities)
-               (test-comp `(module m scheme/base
+               (test-comp `(module m racket/base
                              (define f ,proc)
                              (print (procedure? f)))
-                          `(module m scheme/base
+                          `(module m racket/base
                              (define f ,proc)
                              (print #t)))
                (for-each
                 (lambda (a)
-                  (test-comp `(module m scheme/base
+                  (test-comp `(module m racket/base
                                 (define f ,proc)
                                 (print (procedure-arity-includes? f ,a)))
-                             `(module m scheme/base
+                             `(module m racket/base
                                 (define f ,proc)
                                 (print #t))))
                 arities)
                (for-each
                 (lambda (a)
-                  (test-comp `(module m scheme/base
+                  (test-comp `(module m racket/base
                                 (define f ,proc)
                                 (print (procedure-arity-includes? f ,a)))
-                             `(module m scheme/base
+                             `(module m racket/base
                                 (define f ,proc)
                                 (print #f))))
                 non-arities))])

collects/tests/racket/unsafe.rktl

@@ -184,6 +184,10 @@
   (test-bin +nan.0 'unsafe-flmax +nan.0 2.1)
   (test-bin +nan.0 'unsafe-flmax 2.1 +nan.0)
 
+  (test-bin 1.7+45.0i 'unsafe-make-flrectangular 1.7 45.0)
+  (test-un 3.5 'unsafe-flreal-part 3.5+4.6i)
+  (test-un 4.6 'unsafe-flimag-part 3.5+4.6i)
+
   ;; test unboxing:
   (test-tri 9.0 '(lambda (x y z) (unsafe-fl+ (unsafe-fl- x z) y)) 4.5 7.0 2.5)
   (test-tri 9.0 '(lambda (x y z) (unsafe-fl+ y (unsafe-fl- x z))) 4.5 7.0 2.5)

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,16 @@
+Version 5.0.0.5
+Added flreal-part, flimag-part, make-flrectangular, and unsafe
+ variants
+
+Version 5.0.0.4
+Added chaperone-evt
+
+Version 5.0.0.3
+identifier-prune-to-source-module
+
+Version 5.0.0.2
+Added `fl->eact-integer', `fl->fx', and `unsafe-fl->fx'
+
 Version 5.0.0.1
 Changed `apply' binding to enable lower-level optimizations
 

src/racket/src/cstartup.inc

@@ -1,13 +1,13 @@
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,52,51,0,0,0,1,0,0,10,0,13,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,53,51,0,0,0,1,0,0,10,0,13,0,
-22,0,27,0,34,0,38,0,51,0,55,0,58,0,65,0,72,0,77,0,82,
+22,0,27,0,40,0,47,0,51,0,55,0,58,0,65,0,72,0,77,0,82,
 0,88,0,102,0,116,0,119,0,125,0,129,0,131,0,142,0,144,0,158,0,
 165,0,187,0,189,0,203,0,14,1,43,1,54,1,65,1,75,1,111,1,144,
 1,177,1,236,1,46,2,124,2,190,2,195,2,215,2,106,3,126,3,177,3,
 243,3,128,4,14,5,66,5,89,5,168,5,0,0,109,7,0,0,69,35,37,
 109,105,110,45,115,116,120,29,11,11,68,104,101,114,101,45,115,116,120,64,99,
-111,110,100,66,108,101,116,114,101,99,63,97,110,100,72,112,97,114,97,109,101,
+111,110,100,72,112,97,114,97,109,101,116,101,114,105,122,101,66,108,101,116,114,
-116,101,114,105,122,101,63,108,101,116,62,111,114,66,100,101,102,105,110,101,66,
+101,99,63,97,110,100,63,108,101,116,62,111,114,66,100,101,102,105,110,101,66,
 117,110,108,101,115,115,64,108,101,116,42,64,119,104,101,110,65,113,117,111,116,
 101,29,94,2,14,68,35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,
 37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115,116,120,
@@ -16,7 +16,7 @@
 109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73,100,101,
 102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,218,81,0,0,95,
 159,2,16,36,36,159,2,15,36,36,159,2,15,36,36,16,20,2,4,2,2,
-2,6,2,2,2,7,2,2,2,8,2,2,2,5,2,2,2,10,2,2,2,
+2,5,2,2,2,7,2,2,2,8,2,2,2,6,2,2,2,10,2,2,2,
 9,2,2,2,11,2,2,2,12,2,2,2,13,2,2,97,37,11,8,240,218,
 81,0,0,93,159,2,15,36,37,16,2,2,3,161,2,2,37,2,3,2,2,
 2,3,96,38,11,8,240,218,81,0,0,16,0,96,11,11,8,240,218,81,0,
@@ -28,7 +28,7 @@
 249,22,71,2,18,248,22,98,201,12,27,248,22,73,248,22,147,4,196,28,248,
 22,79,193,20,15,159,37,36,37,28,248,22,79,248,22,73,194,248,22,72,193,
 249,22,140,4,80,158,39,36,251,22,81,2,17,248,22,72,199,249,22,71,2,
-6,248,22,73,201,11,18,16,2,101,10,8,32,8,31,8,30,8,29,8,28,
+7,248,22,73,201,11,18,16,2,101,10,8,32,8,31,8,30,8,29,8,28,
 16,4,11,11,2,19,3,1,8,101,110,118,49,50,56,51,55,16,4,11,11,
 2,20,3,1,8,101,110,118,49,50,56,51,56,93,8,224,226,81,0,0,95,
 9,8,224,226,81,0,0,2,2,27,248,22,73,248,22,147,4,196,28,248,22,
@@ -84,13 +84,13 @@
 36,36,20,105,159,36,16,0,16,1,33,33,10,16,5,2,11,89,162,8,44,
 37,53,9,223,0,33,34,36,20,105,159,36,16,1,2,3,16,0,11,16,5,
 2,13,89,162,8,44,37,53,9,223,0,33,35,36,20,105,159,36,16,1,2,
-3,16,0,11,16,5,2,6,89,162,8,44,37,53,9,223,0,33,36,36,20,
+3,16,0,11,16,5,2,7,89,162,8,44,37,53,9,223,0,33,36,36,20,
 105,159,36,16,1,2,3,16,1,33,37,11,16,5,2,9,89,162,8,44,37,
 56,9,223,0,33,38,36,20,105,159,36,16,1,2,3,16,1,33,39,11,16,
 5,2,8,89,162,8,44,37,58,9,223,0,33,42,36,20,105,159,36,16,1,
-2,3,16,0,11,16,5,2,5,89,162,8,44,37,53,9,223,0,33,44,36,
+2,3,16,0,11,16,5,2,6,89,162,8,44,37,53,9,223,0,33,44,36,
 20,105,159,36,16,1,2,3,16,0,11,16,5,2,12,89,162,8,44,37,54,
-9,223,0,33,45,36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,7,
+9,223,0,33,45,36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,5,
 89,162,8,44,37,55,9,223,0,33,46,36,20,105,159,36,16,1,2,3,16,
 0,11,16,5,2,4,89,162,8,44,37,58,9,223,0,33,47,36,20,105,159,
 36,16,1,2,3,16,1,33,49,11,16,5,2,10,89,162,8,44,37,54,9,
@@ -99,7 +99,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 2024);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,52,65,0,0,0,1,0,0,8,0,21,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,53,65,0,0,0,1,0,0,8,0,21,0,
 26,0,43,0,58,0,76,0,92,0,102,0,120,0,140,0,156,0,174,0,205,
 0,234,0,0,1,14,1,20,1,34,1,39,1,49,1,57,1,85,1,117,1,
 123,1,168,1,213,1,237,1,20,2,22,2,188,2,22,4,63,4,136,5,222,
@@ -400,7 +400,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 6245);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,52,9,0,0,0,1,0,0,10,0,16,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,53,9,0,0,0,1,0,0,10,0,16,0,
 29,0,44,0,58,0,72,0,86,0,128,0,0,0,57,1,0,0,69,35,37,
 98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,35,37,117,
 116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114,107,11,29,
@@ -420,7 +420,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 352);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,52,74,0,0,0,1,0,0,7,0,18,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,48,46,53,74,0,0,0,1,0,0,7,0,18,0,
 45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,162,0,180,0,200,
 0,212,0,228,0,251,0,7,1,38,1,45,1,50,1,55,1,60,1,65,1,
 70,1,79,1,84,1,88,1,94,1,101,1,107,1,115,1,124,1,145,1,166,

src/racket/src/eval.c

@@ -3049,7 +3049,9 @@ static int produces_unboxed(Scheme_Object *rator, int *non_fl_args, int argc, in
     if (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL) {
       if (((argc == 1)
            && (IS_NAMED_PRIM(rator, "unsafe-flabs")
-               || IS_NAMED_PRIM(rator, "unsafe-flsqrt")))
+               || IS_NAMED_PRIM(rator, "unsafe-flsqrt")
+               || IS_NAMED_PRIM(rator, "unsafe-flreal-part")
+               || IS_NAMED_PRIM(rator, "unsafe-flimag-part")))
           || ((argc == 2)
               && (IS_NAMED_PRIM(rator, "unsafe-fl+")
                   || IS_NAMED_PRIM(rator, "unsafe-fl-")
@@ -3083,7 +3085,9 @@ static int produces_unboxed(Scheme_Object *rator, int *non_fl_args, int argc, in
           || IS_NAMED_PRIM(rator, "flacos")
           || IS_NAMED_PRIM(rator, "flatan")
           || IS_NAMED_PRIM(rator, "fllog")
-          || IS_NAMED_PRIM(rator, "flexp"))
+          || IS_NAMED_PRIM(rator, "flexp")
+          || IS_NAMED_PRIM(rator, "flimag-part")
+          || IS_NAMED_PRIM(rator, "flreal-part"))
         return 1;
       if (IS_NAMED_PRIM(rator, "->fl")) {
         if (non_fl_args) *non_fl_args = 1;

src/racket/src/jit.c

@@ -148,6 +148,7 @@ SHARED_OK static void *bad_caar_code, *bad_cdar_code, *bad_cadr_code, *bad_cddr_
 SHARED_OK static void *bad_mcar_code, *bad_mcdr_code;
 SHARED_OK static void *bad_set_mcar_code, *bad_set_mcdr_code;
 SHARED_OK static void *imag_part_code, *real_part_code, *make_rectangular_code;
+SHARED_OK static void *bad_flimag_part_code, *bad_flreal_part_code, *bad_make_flrectangular_code;
 SHARED_OK static void *unbox_code, *set_box_code;
 SHARED_OK static void *bad_vector_length_code;
 SHARED_OK static void *bad_flvector_length_code;
@@ -4159,6 +4160,8 @@ static int is_inline_unboxable_op(Scheme_Object *obj, int flag, int unsafely, in
   if (IS_NAMED_PRIM(obj, "unsafe-fx->fl")) return 1;
   if (IS_NAMED_PRIM(obj, "unsafe-f64vector-ref")) return 1;
   if (IS_NAMED_PRIM(obj, "unsafe-flvector-ref")) return 1;
+  if (IS_NAMED_PRIM(obj, "unsafe-flimag-part")) return 1;
+  if (IS_NAMED_PRIM(obj, "unsafe-flreal-part")) return 1;
 
   if (unsafely) {
     /* These are inline-unboxable when their args are
@@ -4171,6 +4174,8 @@ static int is_inline_unboxable_op(Scheme_Object *obj, int flag, int unsafely, in
     if (IS_NAMED_PRIM(obj, "flsqrt")) return 1;
     if (IS_NAMED_PRIM(obj, "flmin")) return 1;
     if (IS_NAMED_PRIM(obj, "flmax")) return 1;
+    if (IS_NAMED_PRIM(obj, "flimag-part")) return 1;
+    if (IS_NAMED_PRIM(obj, "flreal-part")) return 1;
 
     if (just_checking_result) {
       if (IS_NAMED_PRIM(obj, "flfloor")) return 1;
@@ -6843,11 +6848,17 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
       
       return 1;
     } else if (IS_NAMED_PRIM(rator, "imag-part")
-               || IS_NAMED_PRIM(rator, "real-part")) {
+               || IS_NAMED_PRIM(rator, "real-part")
+               || IS_NAMED_PRIM(rator, "flimag-part")
+               || IS_NAMED_PRIM(rator, "flreal-part")) {
       GC_CAN_IGNORE jit_insn *reffail = NULL, *ref, *refdone;
       const char *name = ((Scheme_Primitive_Proc *)rator)->name;
+      int unbox;
 
-      LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)rator)->name));
+      LOG_IT(("inlined %s\n", name));
+
+      unbox = jitter->unbox;
+      jitter->unbox = 0;
 
       mz_runstack_skipped(jitter, 1);
 
@@ -6856,6 +6867,8 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
 
       mz_runstack_unskipped(jitter, 1);
 
+      jitter->unbox = unbox;
+
       mz_rs_sync();
 
       __START_TINY_JUMPS__(1);
@@ -6865,25 +6878,81 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
       __END_TINY_JUMPS__(1);
       if (name[0] == 'i') {
         (void)jit_calli(imag_part_code);
-      } else {
+      } else if (name[2] == 'i') {
+        (void)jit_calli(bad_flimag_part_code);
+      } else if (name[0] == 'r') {
         (void)jit_calli(real_part_code);
+      } else {
+        (void)jit_calli(bad_flreal_part_code);
+      }
+      if (name[0] != 'f') {
+        /* can return */
+        jit_retval(JIT_R0);
+        CHECK_LIMIT();
+        __START_TINY_JUMPS__(1);
+        refdone = jit_jmpi(jit_forward());
+        __END_TINY_JUMPS__(1);
+      } else {
+        refdone = NULL;
       }
-      jit_retval(JIT_R0);
-      CHECK_LIMIT();
       __START_TINY_JUMPS__(1);
-      refdone = jit_jmpi(jit_forward());
       mz_patch_branch(ref);
       jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
       (void)jit_bnei_i(reffail, JIT_R1, scheme_complex_type);
       if (name[0] == 'i') {
         (void)jit_ldxi_p(JIT_R0, JIT_R0, &((Scheme_Complex *)0x0)->i);
+      } else if (name[0] == 'r') {
+        (void)jit_ldxi_p(JIT_R0, JIT_R0, &((Scheme_Complex *)0x0)->r);
+      } else {
+        /* real part must always be inexact */
+        (void)jit_ldxi_p(JIT_R1, JIT_R0, &((Scheme_Complex *)0x0)->r);
+        CHECK_LIMIT();
+        jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type);
+        (void)jit_bnei_i(reffail, JIT_R2, scheme_double_type);
+        if (name[2] == 'i') {
+          (void)jit_ldxi_p(JIT_R0, JIT_R0, &((Scheme_Complex *)0x0)->i);
+        } else {
+          jit_movr_p(JIT_R0, JIT_R1);
+        }
+      }
+      VALIDATE_RESULT(JIT_R0);
+      if (refdone)
+        mz_patch_ucbranch(refdone);
+      CHECK_LIMIT();
+      __END_TINY_JUMPS__(1);
+
+      if (jitter->unbox) /* for fl....-part: */
+        generate_unboxing(jitter, JIT_R0);
+
+      return 1;
+    } else if (IS_NAMED_PRIM(rator, "unsafe-flimag-part")
+               || IS_NAMED_PRIM(rator, "unsafe-flreal-part")) {
+      const char *name = ((Scheme_Primitive_Proc *)rator)->name;
+      int unbox;
+
+      LOG_IT(("inlined %s\n", name));
+      
+      mz_runstack_skipped(jitter, 1);
+
+      unbox = jitter->unbox;
+      jitter->unbox = 0;
+
+      generate_non_tail(app->rand, jitter, 0, 1, 0);
+      CHECK_LIMIT();
+
+      jitter->unbox = unbox;
+
+      mz_runstack_unskipped(jitter, 1);
+
+      if (name[9] == 'i') {
+        (void)jit_ldxi_p(JIT_R0, JIT_R0, &((Scheme_Complex *)0x0)->i);
       } else {
         (void)jit_ldxi_p(JIT_R0, JIT_R0, &((Scheme_Complex *)0x0)->r);
       }
-      VALIDATE_RESULT(JIT_R0);
-      mz_patch_ucbranch(refdone);
       CHECK_LIMIT();
-      __END_TINY_JUMPS__(1);
+
+      if (jitter->unbox)
+        generate_unboxing(jitter, JIT_R0);
       
       return 1;
     } else if (IS_NAMED_PRIM(rator, "add1")) {
@@ -7318,6 +7387,29 @@ static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int
   return 1;
 }
 
+static int allocate_rectangular(mz_jit_state *jitter)
+{
+#ifdef CAN_INLINE_ALLOC
+  /* Inlined alloc */
+  inline_alloc(jitter, sizeof(Scheme_Complex), scheme_complex_type, 0, 1, 0, 0);
+  CHECK_LIMIT();
+  
+  jit_stxi_p((long)&(((Scheme_Complex *)0x0)->r) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
+  jit_stxi_p((long)&(((Scheme_Complex *)0x0)->i) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
+  jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
+#else
+  /* Non-inlined alloc */
+  JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
+  mz_prepare(2);
+  jit_pusharg_p(JIT_R1);
+  jit_pusharg_p(JIT_R0);
+  (void)mz_finish(ts_scheme_make_complex);
+  jit_retval(JIT_R0);
+#endif
+
+  return 1;
+}
+
 static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, int is_tail, int multi_ok, 
 				   Branch_Info *for_branch, int branch_short, int need_sync, int result_ignored)
 /* de-sync's; for branch, sync'd before  */
@@ -8031,7 +8123,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
                || IS_NAMED_PRIM(rator, "vector")) {
       return generate_vector_alloc(jitter, rator, NULL, NULL, app);
     } else if (IS_NAMED_PRIM(rator, "make-rectangular")) {
-      GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refslow, *refdone;
+      GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *ref4, *refslow, *refdone;
 
       LOG_IT(("inlined make-rectangular\n"));
 
@@ -8069,38 +8161,55 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
       (void)jit_bgei_i(refslow, JIT_R2, scheme_complex_type);
       ref3 = jit_blti_i(jit_forward(), JIT_R2, scheme_float_type);
       (void)jit_bnei_i(refslow, JIT_V1, 1); /* need to coerce other to inexact */
+      ref4 = jit_jmpi(jit_forward());
       mz_patch_branch(ref3);
-      ref3 = jit_jmpi(jit_forward());
       mz_patch_branch(ref);
       (void)jit_bnei_i(refslow, JIT_V1, 0); /* need to coerce to inexact */
       /* exact zero => result is real */
       (void)jit_beqi_p(refslow, JIT_R1, scheme_make_integer(0));
       CHECK_LIMIT();
-      mz_patch_ucbranch(ref3);
+      mz_patch_ucbranch(ref4);
 
       __END_SHORT_JUMPS__(1);
 
-#ifdef CAN_INLINE_ALLOC
+      allocate_rectangular(jitter);
-      /* Inlined alloc */
-      inline_alloc(jitter, sizeof(Scheme_Complex), scheme_complex_type, 0, 1, 0, 0);
-      CHECK_LIMIT();
-
-      jit_stxi_p((long)&(((Scheme_Complex *)0x0)->r) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
-      jit_stxi_p((long)&(((Scheme_Complex *)0x0)->i) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
-      jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
-#else
-      /* Non-inlined alloc */
-      JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
-      mz_prepare(2);
-      jit_pusharg_p(JIT_R1);
-      jit_pusharg_p(JIT_R0);
-      (void)mz_finish(ts_scheme_make_complex);
-      jit_retval(JIT_R0);
-#endif
-      CHECK_LIMIT();
 
       mz_patch_ucbranch(refdone);
 
+      return 1;
+    } else if (IS_NAMED_PRIM(rator, "make-flrectangular")) {
+      GC_CAN_IGNORE jit_insn *ref, *refslow;
+      
+      LOG_IT(("inlined make-rectangular\n"));
+
+      generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
+      CHECK_LIMIT();
+      mz_rs_sync();
+
+      __START_TINY_JUMPS__(1);
+      ref = jit_bmci_ul(jit_forward(), JIT_R0, 0x1);
+      refslow = _jit.x.pc;
+      (void)jit_calli(bad_make_flrectangular_code);
+      mz_patch_branch(ref);
+      jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
+      (void)jit_bnei_i(refslow, JIT_R2, scheme_double_type);
+      (void)jit_bmsi_ul(refslow, JIT_R1, 0x1);
+      jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type);
+      (void)jit_bnei_i(refslow, JIT_R2, scheme_double_type);
+      __END_TINY_JUMPS__(1);
+      CHECK_LIMIT();
+
+      allocate_rectangular(jitter);
+
+      return 1;
+    } else if (IS_NAMED_PRIM(rator, "unsafe-make-flrectangular")) {
+      LOG_IT(("inlined make-rectangular\n"));
+
+      generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
+      CHECK_LIMIT();
+      
+      allocate_rectangular(jitter);
+
       return 1;
     }
   }
@@ -10702,7 +10811,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
 
   /* *** [bad_][m]{car,cdr,...,{imag,real}_part}_code *** */
   /* Argument is in R0 for car/cdr, R2 otherwise */
-  for (i = 0; i < 10; i++) {
+  for (i = 0; i < 12; i++) {
     void *code;
     
     code = jit_get_ip().ptr;
@@ -10737,6 +10846,12 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
     case 9:
       imag_part_code = code;
       break;
+    case 10:
+      bad_flreal_part_code = code;
+      break;
+    case 11:
+      bad_flimag_part_code = code;
+      break;
     }
     mz_prolog(JIT_R1);
     jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
@@ -10783,6 +10898,12 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
     case 9:
       (void)mz_finish(ts_scheme_checked_imag_part);
       break;
+    case 10:
+      (void)mz_finish(ts_scheme_checked_flreal_part);
+      break;
+    case 11:
+      (void)mz_finish(ts_scheme_checked_flimag_part);
+      break;
     }
     CHECK_LIMIT();
 
@@ -10801,9 +10922,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
     register_sub_func(jitter, code, scheme_false);
   }
 
-  /* *** bad_set_{car,cdr}_code and make_rectangular_code *** */
+  /* *** bad_set_{car,cdr}_code and make_[fl]rectangular_code *** */
   /* Bad argument is in R0, other is in R1 */
-  for (i = 0; i < 3; i++) {
+  for (i = 0; i < 4; i++) {
     void *code;
     code = jit_get_ip().ptr;
     switch (i) {
@@ -10816,6 +10937,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
     case 2:
       make_rectangular_code = code;
       break;
+    case 3:
+      bad_make_flrectangular_code = code;
+      break;
     }
     mz_prolog(JIT_R2);
     jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
@@ -10841,6 +10965,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
       jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
       mz_epilog(JIT_R2);
       break;
+    case 3:
+      (void)mz_finish(ts_scheme_checked_make_flrectangular);
+      break;
     }
     CHECK_LIMIT();
     register_sub_func(jitter, code, scheme_false);

src/racket/src/jit_ts.c

@@ -62,6 +62,9 @@ define_ts_iS_s(scheme_checked_set_mcdr, FSRC_MARKS)
 define_ts_iS_s(scheme_checked_imag_part, FSRC_MARKS)
 define_ts_iS_s(scheme_checked_real_part, FSRC_MARKS)
 define_ts_iS_s(scheme_checked_make_rectangular, FSRC_MARKS)
+define_ts_iS_s(scheme_checked_flimag_part, FSRC_MARKS)
+define_ts_iS_s(scheme_checked_flreal_part, FSRC_MARKS)
+define_ts_iS_s(scheme_checked_make_flrectangular, FSRC_MARKS)
 #ifndef CAN_INLINE_ALLOC
 define_ts_tt_s(scheme_make_complex, FSRC_OTHER)
 #endif
@@ -132,6 +135,9 @@ define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
 # define ts_scheme_checked_imag_part scheme_checked_imag_part
 # define ts_scheme_checked_real_part scheme_checked_real_part
 # define ts_scheme_checked_make_rectangular scheme_checked_make_rectangular
+# define ts_scheme_checked_flimag_part scheme_checked_flimag_part
+# define ts_scheme_checked_flreal_part scheme_checked_flreal_part
+# define ts_scheme_checked_make_flrectangular scheme_checked_make_flrectangular
 # define ts_scheme_make_complex scheme_make_complex
 # define ts_scheme_unbox scheme_unbox
 # define ts_scheme_set_box scheme_set_box

src/racket/src/number.c

@@ -137,6 +137,10 @@ static Scheme_Object *unsafe_flvector_length (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_flvector_ref (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_flvector_set (int argc, Scheme_Object *argv[]);
 
+static Scheme_Object *unsafe_make_flrectangular (int argc, Scheme_Object *argv[]);
+static Scheme_Object *unsafe_flreal_part (int argc, Scheme_Object *argv[]);
+static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[]);
+
 /* globals */
 READ_ONLY double scheme_infinity_val;
 READ_ONLY double scheme_minus_infinity_val;
@@ -703,6 +707,18 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
   else
     SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
   scheme_add_global_constant("flexp", p, env);
+
+  p = scheme_make_folding_prim(scheme_checked_make_rectangular, "make-flrectangular", 2, 2, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  scheme_add_global_constant("make-flrectangular", p, env);
+
+  p = scheme_make_folding_prim(scheme_checked_real_part, "flreal-part", 1, 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
+  scheme_add_global_constant("flreal-part", p, env);
+
+  p = scheme_make_folding_prim(scheme_checked_imag_part, "flimag-part", 1, 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
+  scheme_add_global_constant("flimag-part", p, env);
 }
 
 void scheme_init_unsafe_number(Scheme_Env *env)
@@ -788,6 +804,21 @@ void scheme_init_unsafe_number(Scheme_Env *env)
                              3, 3);
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
   scheme_add_global_constant("unsafe-flvector-set!", p, env);
+
+  p = scheme_make_folding_prim(unsafe_make_flrectangular, "unsafe-make-flrectangular", 2, 2, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant("unsafe-make-flrectangular", p, env);
+
+  p = scheme_make_folding_prim(unsafe_flreal_part, "unsafe-flreal-part", 1, 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
+                                | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant("unsafe-flreal-part", p, env);
+
+  p = scheme_make_folding_prim(unsafe_flimag_part, "unsafe-flimag-part", 1, 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
+                                | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant("unsafe-flimag-part", p, env);
 }
 
 
@@ -2493,6 +2524,20 @@ Scheme_Object *scheme_checked_make_rectangular (int argc, Scheme_Object *argv[])
   return scheme_make_complex(a, b);
 }
 
+Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *a, *b;
+
+  a = argv[0];
+  b = argv[1];
+  if (!SCHEME_FLOATP(a))
+    scheme_wrong_type("make-rectangular", "inexact-real", 0, argc, argv);
+  if (!SCHEME_FLOATP(b))
+    scheme_wrong_type("make-rectangular", "inexact-real", 1, argc, argv);
+
+  return scheme_make_complex(a, b);
+}
+
 Scheme_Object *scheme_make_polar (int argc, Scheme_Object *argv[])
 {
   Scheme_Object *a, *b, *r, *i, *v;
@@ -2541,6 +2586,28 @@ Scheme_Object *scheme_checked_imag_part (int argc, Scheme_Object *argv[])
   return zeroi;
 }
 
+Scheme_Object *scheme_checked_flreal_part (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+
+  if (!SCHEME_COMPLEXP(o)
+      || !SCHEME_FLOATP(((Scheme_Complex *)o)->r))
+    scheme_wrong_type("flreal-part", "complex number with inexact parts", 0, argc, argv);
+
+  return _scheme_complex_real_part(o);
+}
+
+Scheme_Object *scheme_checked_flimag_part (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+
+  if (!SCHEME_COMPLEXP(o)
+      || !SCHEME_FLOATP(((Scheme_Complex *)o)->r))
+    scheme_wrong_type("flimag-part", "complex number with inexact parts", 0, argc, argv);
+
+  return scheme_complex_imaginary_part(o);
+}
+
 static Scheme_Object *magnitude(int argc, Scheme_Object *argv[])
 {
   Scheme_Object *o = argv[0];
@@ -3425,3 +3492,18 @@ static Scheme_Object *fl_to_integer (int argc, Scheme_Object *argv[])
   scheme_wrong_type("fl->exact-integer", "inexact-real integer", 0, argc, argv);
   return NULL;
 }
+
+static Scheme_Object *unsafe_make_flrectangular (int argc, Scheme_Object *argv[])
+{
+  return scheme_make_complex(argv[0], argv[1]);
+}
+
+static Scheme_Object *unsafe_flreal_part (int argc, Scheme_Object *argv[])
+{
+  return ((Scheme_Complex *)argv[0])->r;
+}
+
+static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[])
+{
+  return ((Scheme_Complex *)argv[0])->i;
+}

src/racket/src/schminc.h

@@ -14,8 +14,8 @@
 #define USE_COMPILED_STARTUP 1
 
 #define EXPECTED_PRIM_COUNT 998
-#define EXPECTED_UNSAFE_COUNT 66
+#define EXPECTED_UNSAFE_COUNT 69
-#define EXPECTED_FLFXNUM_COUNT 55
+#define EXPECTED_FLFXNUM_COUNT 58
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/racket/src/schpriv.h

@@ -3383,6 +3383,9 @@ Scheme_Object *scheme_flvector_length(Scheme_Object *v);
 Scheme_Object *scheme_checked_real_part (int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_checked_imag_part (int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_checked_make_rectangular (int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_checked_flreal_part (int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_checked_flimag_part (int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[]);
 
 Scheme_Object *scheme_chaperone_vector_copy(Scheme_Object *obj);
 Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj);

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.0.0.4"
+#define MZSCHEME_VERSION "5.0.0.5"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 4
+#define MZSCHEME_VERSION_W 5
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)