racket/flonum: add `flexpt'

collects/images/private/flomap-transform.rkt

@@ -123,10 +123,6 @@
          (values (+ x-mid (+ (* x cos-θ) (* y sin-θ)))
                  (+ y-mid (- (* y cos-θ) (* x sin-θ)))))))))
 
-(: flexpt (Flonum Flonum -> Flonum))
-(define (flexpt b x)
-  (exp (* x (fllog b))))
-
 (: whirl-and-pinch-function (Real Real Real Integer Integer
                                   -> (Flonum Flonum -> (values Flonum Flonum))))
 (define (whirl-and-pinch-function θ pinch radius w h)

collects/racket/flonum.rkt

@@ -8,7 +8,7 @@
 (provide fl+ fl- fl* fl/
          flabs flsqrt flexp fllog
          flsin flcos fltan flasin flacos flatan
-         flfloor flceiling flround fltruncate
+         flfloor flceiling flround fltruncate flexpt
          fl= fl< fl<= fl> fl>= flmin flmax
          ->fl fl->exact-integer
          flvector? flvector make-flvector 

collects/racket/unsafe/ops.rkt

@@ -7,4 +7,4 @@
                      (combine-out flsin flcos fltan
                                   flasin flacos flatan
                                   fltruncate flround flfloor flceiling
-                                  flexp fllog)))
+                                  flexp fllog flexpt)))

collects/scribblings/reference/flonums.scrbl

@@ -76,6 +76,14 @@ the range @racket[-1.0] to @racket[1.0] is given to @racket[flasin] or
 @racket[flacos], or when a negative number is given to @racket[fllog]
 or @racket[flsqrt].}
 
+@defproc[(flexpt  [a flonum?] [b flonum?])
+         flonum?]{
+
+Like @racket[expt], but constrained to consume and produce
+@tech{flonums}. The result is @racket[+nan.0] when @racket[a] is
+negative and @racket[b] is not an integer or when @racket[a] is zero
+and @racket[b] is not positive.}
+
 
 @defproc[(->fl [a exact-integer?]) flonum?]{
 

collects/scribblings/reference/unsafe.scrbl

@@ -97,11 +97,11 @@ constrained to consume @tech{fixnums}.}
 
 
 @deftogether[(
-@defproc[(unsafe-fl+   [a inexact-real?] [b inexact-real?]) inexact-real?]
+@defproc[(unsafe-fl+   [a flonum?] [b flonum?]) flonum?]
-@defproc[(unsafe-fl-   [a inexact-real?] [b inexact-real?]) inexact-real?]
+@defproc[(unsafe-fl-   [a flonum?] [b flonum?]) flonum?]
-@defproc[(unsafe-fl*   [a inexact-real?] [b inexact-real?]) inexact-real?]
+@defproc[(unsafe-fl*   [a flonum?] [b flonum?]) flonum?]
-@defproc[(unsafe-fl/   [a inexact-real?] [b inexact-real?]) inexact-real?]
+@defproc[(unsafe-fl/   [a flonum?] [b flonum?]) flonum?]
-@defproc[(unsafe-flabs [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flabs [a flonum?]) flonum?]
 )]{
 
 For @tech{flonums}: Unchecked versions of @racket[fl+], @racket[fl-],
@@ -109,13 +109,13 @@ For @tech{flonums}: Unchecked versions of @racket[fl+], @racket[fl-],
 
 
 @deftogether[(
-@defproc[(unsafe-fl=   [a inexact-real?] [b inexact-real?]) boolean?]
+@defproc[(unsafe-fl=   [a flonum?] [b flonum?]) boolean?]
-@defproc[(unsafe-fl<   [a inexact-real?] [b inexact-real?]) boolean?]
+@defproc[(unsafe-fl<   [a flonum?] [b flonum?]) boolean?]
-@defproc[(unsafe-fl>   [a inexact-real?] [b inexact-real?]) boolean?]
+@defproc[(unsafe-fl>   [a flonum?] [b flonum?]) boolean?]
-@defproc[(unsafe-fl<=  [a inexact-real?] [b inexact-real?]) boolean?]
+@defproc[(unsafe-fl<=  [a flonum?] [b flonum?]) boolean?]
-@defproc[(unsafe-fl>=  [a inexact-real?] [b inexact-real?]) boolean?]
+@defproc[(unsafe-fl>=  [a flonum?] [b flonum?]) boolean?]
-@defproc[(unsafe-flmin [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flmin [a flonum?]) flonum?]
-@defproc[(unsafe-flmax [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flmax [a flonum?]) flonum?]
 )]{
 
 For @tech{flonums}: Unchecked versions of @racket[fl=], @racket[fl<],
@@ -124,10 +124,10 @@ For @tech{flonums}: Unchecked versions of @racket[fl=], @racket[fl<],
 
 
 @deftogether[(
-@defproc[(unsafe-flround [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flround [a flonum?]) flonum?]
-@defproc[(unsafe-flfloor [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flfloor [a flonum?]) flonum?]
-@defproc[(unsafe-flceiling [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flceiling [a flonum?]) flonum?]
-@defproc[(unsafe-fltruncate [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-fltruncate [a flonum?]) flonum?]
 )]{
 
 For @tech{flonums}: Unchecked (potentially) versions of
@@ -137,29 +137,30 @@ the corresponding safe bindings.}
 
 
 @deftogether[(
-@defproc[(unsafe-flsin [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flsin [a flonum?]) flonum?]
-@defproc[(unsafe-flcos [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flcos [a flonum?]) flonum?]
-@defproc[(unsafe-fltan [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-fltan [a flonum?]) flonum?]
-@defproc[(unsafe-flasin [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flasin [a flonum?]) flonum?]
-@defproc[(unsafe-flacos [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flacos [a flonum?]) flonum?]
-@defproc[(unsafe-flatan [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flatan [a flonum?]) flonum?]
-@defproc[(unsafe-fllog [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-fllog [a flonum?]) flonum?]
-@defproc[(unsafe-flexp [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flexp [a flonum?]) flonum?]
-@defproc[(unsafe-flsqrt [a inexact-real?]) inexact-real?]
+@defproc[(unsafe-flsqrt [a flonum?]) flonum?]
+@defproc[(unsafe-flexpt [a flonum?] [b flonum?]) flonum?]
 )]{
 
 For @tech{flonums}: Unchecked (potentially) versions of
 @racket[flsin], @racket[flcos], @racket[fltan], @racket[flasin],
-@racket[flacos], @racket[flatan], @racket[fllog], @racket[flexp], and
+@racket[flacos], @racket[flatan], @racket[fllog], @racket[flexp],
-@racket[flsqrt]. Currently, some of these bindings are simply aliases
+@racket[flsqrt], and @racket[flexpt]. Currently, some of these
-for the corresponding safe bindings.}
+bindings are simply aliases for the corresponding safe bindings.}
 
 
 @deftogether[(
-@defproc[(unsafe-make-flrectangular [a inexact-real?] [b inexact-real?]) 
+@defproc[(unsafe-make-flrectangular [a flonum?] [b flonum?]) 
          (and/c complex? inexact? (not/c real?))]
-@defproc[(unsafe-flreal-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+@defproc[(unsafe-flreal-part [a (and/c complex? inexact? (not/c real?))]) flonum?]
-@defproc[(unsafe-flimag-part [a (and/c complex? inexact? (not/c real?))]) inexact-real?]
+@defproc[(unsafe-flimag-part [a (and/c complex? inexact? (not/c real?))]) flonum?]
 )]{
 
 For @tech{flonums}: Unchecked versions of @racket[make-flrectangular],
@@ -167,8 +168,8 @@ For @tech{flonums}: Unchecked versions of @racket[make-flrectangular],
 
 
 @deftogether[(
-@defproc[(unsafe-fx->fl [a fixnum?]) inexact-real?]
+@defproc[(unsafe-fx->fl [a fixnum?]) flonum?]
-@defproc[(unsafe-fl->fx [a inexact-real?]) fixnum?]
+@defproc[(unsafe-fl->fx [a flonum?]) fixnum?]
 )]{
 Unchecked conversion of a fixnum to an integer flonum and vice versa.
 These are similar to the safe bindings @racket[->fl] and @racket[fl->exact-integer],
@@ -264,7 +265,7 @@ fixnum).}
 @deftogether[(
 @defproc[(unsafe-flvector-length [v flvector?]) fixnum?]
 @defproc[(unsafe-flvector-ref [v flvector?] [k fixnum?]) any/c]
-@defproc[(unsafe-flvector-set! [v flvector?] [k fixnum?] [x inexact-real?]) void?]
+@defproc[(unsafe-flvector-set! [v flvector?] [k fixnum?] [x flonum?]) void?]
 )]{
 
 Unsafe versions of @racket[flvector-length], @racket[flvector-ref], and
@@ -274,8 +275,8 @@ fixnum).}
 
 
 @deftogether[(
-@defproc[(unsafe-f64vector-ref [vec f64vector?] [k fixnum?]) inexact-real?]
+@defproc[(unsafe-f64vector-ref [vec f64vector?] [k fixnum?]) flonum?]
-@defproc[(unsafe-f64vector-set! [vec f64vector?] [k fixnum?] [n inexact-real?]) void?]
+@defproc[(unsafe-f64vector-set! [vec f64vector?] [k fixnum?] [n flonum?]) void?]
 )]{
 
 Unsafe versions of @racket[f64vector-ref] and

collects/tests/racket/optimize.rktl

@@ -391,6 +391,26 @@
       (test-trig log 'fllog)
       (test-trig exp 'flexp))
 
+    (for-each
+     (lambda (v)
+       (define (once v)
+         (un-exact (round v) 'flround v #t)
+         (un-exact (ceiling v) 'flceiling v #t)
+         (un-exact (floor v) 'flfloor v #t)
+         (un-exact (truncate v) 'fltruncate v #t))
+       (once v)
+       (once (- v)))
+     '(3.0 3.1 3.5 3.8 4.0 4.1 4.5 4.8 0.0))
+
+    (bin-exact 9.0 'flexpt 3.0 2.0 #t)
+    (bin-exact (expt 3.1 2.5) 'flexpt 3.1 2.5 #t)
+    (bin-exact -1.0 'flexpt -1.0 3.0 #t)
+    (bin-exact -0.125 'flexpt -2.0 -3.0 #t)
+    (bin-exact +nan.0 'flexpt -1.0 3.1 #t)
+    (bin-exact 0.0 'flexpt 0.0 10.0 #t)
+    (bin-exact +nan.0 'flexpt 0.0 -1.0 #t)
+    (bin-exact +nan.0 'flexpt 0.0 0.0 #t)
+    
     (un 1.0 'exact->inexact 1)
     (un 1073741823.0 'exact->inexact (sub1 (expt 2 30)))
     (un -1073741824.0 'exact->inexact (- (expt 2 30)))

collects/typed-racket/base-env/base-env-numeric.rkt

@@ -564,6 +564,11 @@
       (from-cases (map unop (list -FlonumPosZero -FlonumNegZero -FlonumZero
                                   -NonNegFlonum ; we don't have positive case, possible underflow
                                   -Flonum))))) ; anything negative returns nan
+  (define flexpt-type
+    (lambda ()
+      ;; could be more precise...
+      (from-cases (-Flonum -Flonum . -> . -Flonum))))
+
   (define fx->fl-type
     (lambda ()
       (fx-from-cases
@@ -645,7 +650,8 @@
                        [unsafe-flasin     flasin ]
                        [unsafe-flacos     flacos]
                        [unsafe-fllog      fllog]
-                       [unsafe-flexp      flexp])))
+                       [unsafe-flexp      flexp]
+                       [unsafe-flexpt     flexpt])))
    (define phase (namespace-base-phase (namespace-anchor->namespace anchor)))
 
    (for-each
@@ -1881,6 +1887,7 @@
 [fllog (fllog-type)]
 [flexp (flexp-type)]
 [flsqrt (flsqrt-type)]
+[flexpt (flexpt-type)]
 [->fl (fx->fl-type)]
 [fx->fl (fx->fl-type)]
 [fl->fx (fl->fx-type)]

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,7 @@
+Version 5.3.0.6
+racket/flonum: added flexpt
+racket/unsafe/ops: added unsafe-flexpt
+
 Version 5.3.0.5
 Added box-cas!
 racket/gui: changed open-output-text-editor to by default deliver 

src/racket/include/schthread.h

@@ -162,6 +162,7 @@ typedef struct Thread_Local_Variables {
   int fixup_already_in_place_;
   void *retry_alloc_r1_;
   double scheme_jit_save_fp_;
+  double scheme_jit_save_fp2_;
   struct Scheme_Bucket_Table *starts_table_;
   struct Scheme_Bucket_Table *submodule_empty_modidx_table_;
   struct Scheme_Modidx *modidx_caching_chain_;
@@ -510,6 +511,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define fixup_already_in_place XOA (scheme_get_thread_local_variables()->fixup_already_in_place_)
 #define retry_alloc_r1 XOA (scheme_get_thread_local_variables()->retry_alloc_r1_)
 #define scheme_jit_save_fp XOA (scheme_get_thread_local_variables()->scheme_jit_save_fp_)
+#define scheme_jit_save_fp2 XOA (scheme_get_thread_local_variables()->scheme_jit_save_fp2_)
 #define starts_table XOA (scheme_get_thread_local_variables()->starts_table_)
 #define submodule_empty_modidx_table XOA (scheme_get_thread_local_variables()->submodule_empty_modidx_table_)
 #define modidx_caching_chain XOA (scheme_get_thread_local_variables()->modidx_caching_chain_)

src/racket/src/cstartup.inc

@@ -1,5 +1,5 @@
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,53,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0,
 19,0,32,0,39,0,42,0,49,0,56,0,60,0,65,0,69,0,74,0,83,
 0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0,
@@ -16,12 +16,12 @@
 108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,
 20,112,97,114,97,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,
-249,81,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,
+248,81,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,
 20,2,10,2,2,2,3,2,2,2,4,2,2,2,6,2,2,2,7,2,2,
 2,8,2,2,2,9,2,2,2,5,2,2,2,11,2,2,2,12,2,2,97,
-37,11,8,240,249,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
+37,11,8,240,248,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
-37,2,13,2,2,2,13,96,11,11,8,240,249,81,0,0,16,0,96,38,11,
+37,2,13,2,2,2,13,96,38,11,8,240,248,81,0,0,16,0,96,11,11,
-8,240,249,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,
+8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,
 2,2,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,150,
 4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248,
 22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,2,
@@ -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,51,46,48,46,53,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,
 26,0,43,0,65,0,94,0,109,0,127,0,139,0,155,0,169,0,191,0,207,
 0,224,0,246,0,1,1,7,1,16,1,23,1,30,1,42,1,58,1,82,1,
@@ -600,7 +600,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 10438);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,53,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,
 57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,179,
 1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,
@@ -627,7 +627,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 501);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,53,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,81,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,158,0,170,0,185,
 0,201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,
@@ -984,7 +984,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 7421);
   }
   {
-    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,53,84,0,0,0,0,0,0,0,0,0,0,
+    SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,
 29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0,
 0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,
@@ -992,7 +992,7 @@
 114,107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,
 74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66,
 35,37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11,
-29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,246,83,
+29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,245,83,
 0,0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,
 36,36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,
 36,16,0,159,36,20,113,159,36,16,1,11,16,0,20,26,144,9,2,1,2,

src/racket/src/jit.h

@@ -173,6 +173,7 @@ extern int scheme_direct_call_count, scheme_indirect_call_count;
 extern int scheme_jit_malloced;
 #ifdef JIT_USE_FP_OPS
 THREAD_LOCAL_DECL(extern double scheme_jit_save_fp);
+THREAD_LOCAL_DECL(extern double scheme_jit_save_fp2);
 #endif
 
 typedef int (*Native_Check_Arity_Proc)(Scheme_Object *o, int argc, int dummy EXTRA_NATIVE_ARGUMENT_TYPE);
@@ -396,6 +397,7 @@ typedef struct {
 # define tl_fixup_runstack_base            tl_delta(fixup_runstack_base)
 # define tl_fixup_already_in_place         tl_delta(fixup_already_in_place)
 # define tl_scheme_jit_save_fp             tl_delta(scheme_jit_save_fp)
+# define tl_scheme_jit_save_fp2            tl_delta(scheme_jit_save_fp2)
 # define tl_scheme_fuel_counter            tl_delta(scheme_fuel_counter)
 # define tl_scheme_jit_stack_boundary      tl_delta(scheme_jit_stack_boundary)
 # define tl_jit_future_storage             tl_delta(jit_future_storage)
@@ -1331,7 +1333,8 @@ Scheme_Object *scheme_jit_continuation_apply_install(Apply_LWC_Args *args);
 #define ARITH_FLUNOP   14
 /*  inexact->exact, unsafe-fl->fx, fl->exact-integer, fl->fx */
 #define ARITH_INEX_EX  15
-
+/*  flexpt */
+#define ARITH_EXPT     16
 
 /* Comparison codes. Used in jitarith.c and jitinline.c. */
 

src/racket/src/jitarith.c

@@ -361,6 +361,11 @@ DECL_FP_GLUE(ceiling)
 DECL_FP_GLUE(truncate)
 DECL_FP_GLUE(round)
 typedef void (*call_fp_proc)(void);
+
+#define DECL_BIN_FP_GLUE(op) static void call_ ## op(void) XFORM_SKIP_PROC {  \
+    scheme_jit_save_fp = scheme_double_ ## op(scheme_jit_save_fp, scheme_jit_save_fp2); }
+DECL_BIN_FP_GLUE(expt)
+typedef void (*call_fp_bin_proc)(void);
 # endif
 #endif
 
@@ -626,6 +631,20 @@ static int generate_double_arith(mz_jit_state *jitter, Scheme_Object *rator,
           (void)mz_tl_ldi_d_fppush(JIT_FPR0, tl_scheme_jit_save_fp, JIT_R2);
         }
         break;
+      case ARITH_EXPT: /* flexpt */
+        {
+          if (!reversed) {
+            (void)mz_tl_sti_d_fppop(tl_scheme_jit_save_fp2, JIT_FPR0, JIT_R2);
+            (void)mz_tl_sti_d_fppop(tl_scheme_jit_save_fp, JIT_FPR1, JIT_R2);
+          } else {
+            (void)mz_tl_sti_d_fppop(tl_scheme_jit_save_fp, JIT_FPR0, JIT_R2);
+            (void)mz_tl_sti_d_fppop(tl_scheme_jit_save_fp2, JIT_FPR1, JIT_R2);
+          }
+          mz_prepare(0);
+          (void)mz_finish(call_expt);
+          (void)mz_tl_ldi_d_fppush(JIT_FPR0, tl_scheme_jit_save_fp, JIT_R2);          
+        }
+        break;
 # endif
 #endif
       default:

src/racket/src/jitinline.c

@@ -2185,6 +2185,9 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
     } else if (IS_NAMED_PRIM(rator, "fxrshift")) {
       scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_RSH, 0, 0, NULL, 1, -1, 0, NULL);
       return 1;
+    } else if (IS_NAMED_PRIM(rator, "flexpt")) {
+      scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_EXPT, 0, 0, NULL, 1, 0, -1, NULL);
+      return 1;
     } else if (IS_NAMED_PRIM(rator, "vector-ref")
                || IS_NAMED_PRIM(rator, "unsafe-vector-ref")
                || IS_NAMED_PRIM(rator, "unsafe-vector*-ref")

src/racket/src/number.c

@@ -133,6 +133,7 @@ static Scheme_Object *fl_acos (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fl_atan (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fl_exp (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fl_log (int argc, Scheme_Object *argv[]);
+static Scheme_Object *fl_expt (int argc, Scheme_Object *argv[]);
 
 static Scheme_Object *unsafe_fx_and (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_fx_or (int argc, Scheme_Object *argv[]);
@@ -803,6 +804,13 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
     SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
   scheme_add_global_constant("flexp", p, env);
 
+  p = scheme_make_folding_prim(fl_expt, "flexpt", 2, 2, 1);
+  if (scheme_can_inline_fp_op())
+    SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  else
+    SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
+  scheme_add_global_constant("flexpt", 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);
@@ -2715,6 +2723,14 @@ scheme_expt(int argc, Scheme_Object *argv[])
   return r;
 }
 
+double scheme_double_expt(double x, double y) {
+  if ((x < 0) && (floor(y) != y))
+    return not_a_number_val;
+  else if ((x == 0.0) && (y <= 0))
+    return not_a_number_val;
+  else
+    return sch_pow(x, y);
+}
 
 Scheme_Object *scheme_checked_make_rectangular (int argc, Scheme_Object *argv[])
 {
@@ -3818,6 +3834,19 @@ SAFE_FL(atan)
 SAFE_FL(exp)
 SAFE_FL(log)
 
+#define SAFE_BIN_FL(op) \
+  static Scheme_Object * fl_ ## op (int argc, Scheme_Object *argv[])    \
+  {                                                                     \
+    double v;                                                           \
+    if (!SCHEME_DBLP(argv[0])) scheme_wrong_type("fl" #op, "flonum", 0, argc, argv); \
+    if (!SCHEME_DBLP(argv[1])) scheme_wrong_type("fl" #op, "flonum", 1, argc, argv); \
+    v = scheme_double_ ## op (SCHEME_DBL_VAL(argv[0]), SCHEME_DBL_VAL(argv[1]));     \
+    return scheme_make_double(v);                                        \
+  }
+
+SAFE_BIN_FL(expt)
+
+
 #define UNSAFE_FX(name, op, fold)                            \
  static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
  {                                                           \

src/racket/src/schminc.h

@@ -16,7 +16,7 @@
 
 #define EXPECTED_PRIM_COUNT 1047
 #define EXPECTED_UNSAFE_COUNT 79
-#define EXPECTED_FLFXNUM_COUNT 68
+#define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_FUTURES_COUNT 13
 
 #ifdef MZSCHEME_SOMETHING_OMITTED

src/racket/src/schpriv.h

@@ -2097,6 +2097,7 @@ double scheme_double_acos(double x);
 double scheme_double_atan(double x);
 double scheme_double_log(double x);
 double scheme_double_exp(double x);
+double scheme_double_expt(double x, double y);
 
 /*========================================================================*/
 /*                     read, eval, print                                  */

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.0.5"
+#define MZSCHEME_VERSION "5.3.0.6"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)