From 9a41129c69cd18cfe901a26d1bee0ebe45cde1a9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 7 May 2012 20:39:38 -0600 Subject: [PATCH] racket/flonum: add `flexpt' --- collects/images/private/flomap-transform.rkt | 4 - collects/racket/flonum.rkt | 2 +- collects/racket/unsafe/ops.rkt | 2 +- collects/scribblings/reference/flonums.scrbl | 8 ++ collects/scribblings/reference/unsafe.scrbl | 73 ++++++++++--------- collects/tests/racket/optimize.rktl | 20 +++++ .../base-env/base-env-numeric.rkt | 9 ++- doc/release-notes/racket/HISTORY.txt | 4 + src/racket/include/schthread.h | 2 + src/racket/src/cstartup.inc | 20 ++--- src/racket/src/jit.h | 5 +- src/racket/src/jitarith.c | 19 +++++ src/racket/src/jitinline.c | 3 + src/racket/src/number.c | 29 ++++++++ src/racket/src/schminc.h | 2 +- src/racket/src/schpriv.h | 1 + src/racket/src/schvers.h | 4 +- 17 files changed, 150 insertions(+), 57 deletions(-) diff --git a/collects/images/private/flomap-transform.rkt b/collects/images/private/flomap-transform.rkt index b33ef6cb07..a3635bb392 100644 --- a/collects/images/private/flomap-transform.rkt +++ b/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) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index a2386c828e..7fce7b9b04 100644 --- a/collects/racket/flonum.rkt +++ b/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 diff --git a/collects/racket/unsafe/ops.rkt b/collects/racket/unsafe/ops.rkt index a084ccf8a6..faf5e62380 100644 --- a/collects/racket/unsafe/ops.rkt +++ b/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))) diff --git a/collects/scribblings/reference/flonums.scrbl b/collects/scribblings/reference/flonums.scrbl index 20a25a280f..e62f82ee2d 100644 --- a/collects/scribblings/reference/flonums.scrbl +++ b/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?]{ diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index f93857d919..12de2af180 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/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 inexact-real?] [b inexact-real?]) inexact-real?] -@defproc[(unsafe-fl* [a inexact-real?] [b inexact-real?]) inexact-real?] -@defproc[(unsafe-fl/ [a inexact-real?] [b inexact-real?]) inexact-real?] -@defproc[(unsafe-flabs [a inexact-real?]) inexact-real?] +@defproc[(unsafe-fl+ [a flonum?] [b flonum?]) flonum?] +@defproc[(unsafe-fl- [a flonum?] [b flonum?]) flonum?] +@defproc[(unsafe-fl* [a flonum?] [b flonum?]) flonum?] +@defproc[(unsafe-fl/ [a flonum?] [b flonum?]) flonum?] +@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 inexact-real?] [b inexact-real?]) boolean?] -@defproc[(unsafe-fl> [a inexact-real?] [b inexact-real?]) boolean?] -@defproc[(unsafe-fl<= [a inexact-real?] [b inexact-real?]) boolean?] -@defproc[(unsafe-fl>= [a inexact-real?] [b inexact-real?]) boolean?] -@defproc[(unsafe-flmin [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flmax [a inexact-real?]) inexact-real?] +@defproc[(unsafe-fl= [a flonum?] [b flonum?]) boolean?] +@defproc[(unsafe-fl< [a flonum?] [b flonum?]) boolean?] +@defproc[(unsafe-fl> [a flonum?] [b flonum?]) boolean?] +@defproc[(unsafe-fl<= [a flonum?] [b flonum?]) boolean?] +@defproc[(unsafe-fl>= [a flonum?] [b flonum?]) boolean?] +@defproc[(unsafe-flmin [a flonum?]) flonum?] +@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-flfloor [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flceiling [a inexact-real?]) inexact-real?] -@defproc[(unsafe-fltruncate [a inexact-real?]) inexact-real?] +@defproc[(unsafe-flround [a flonum?]) flonum?] +@defproc[(unsafe-flfloor [a flonum?]) flonum?] +@defproc[(unsafe-flceiling [a flonum?]) flonum?] +@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-flcos [a inexact-real?]) inexact-real?] -@defproc[(unsafe-fltan [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flasin [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flacos [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flatan [a inexact-real?]) inexact-real?] -@defproc[(unsafe-fllog [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flexp [a inexact-real?]) inexact-real?] -@defproc[(unsafe-flsqrt [a inexact-real?]) inexact-real?] +@defproc[(unsafe-flsin [a flonum?]) flonum?] +@defproc[(unsafe-flcos [a flonum?]) flonum?] +@defproc[(unsafe-fltan [a flonum?]) flonum?] +@defproc[(unsafe-flasin [a flonum?]) flonum?] +@defproc[(unsafe-flacos [a flonum?]) flonum?] +@defproc[(unsafe-flatan [a flonum?]) flonum?] +@defproc[(unsafe-fllog [a flonum?]) flonum?] +@defproc[(unsafe-flexp [a flonum?]) flonum?] +@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[flsqrt]. Currently, some of these bindings are simply aliases -for the corresponding safe bindings.} +@racket[flacos], @racket[flatan], @racket[fllog], @racket[flexp], +@racket[flsqrt], and @racket[flexpt]. Currently, some of these +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-flimag-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?))]) 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-fl->fx [a inexact-real?]) fixnum?] +@defproc[(unsafe-fx->fl [a fixnum?]) flonum?] +@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-set! [vec f64vector?] [k fixnum?] [n inexact-real?]) void?] +@defproc[(unsafe-f64vector-ref [vec f64vector?] [k fixnum?]) flonum?] +@defproc[(unsafe-f64vector-set! [vec f64vector?] [k fixnum?] [n flonum?]) void?] )]{ Unsafe versions of @racket[f64vector-ref] and diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index 702be44924..a8841f73ac 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -390,6 +390,26 @@ (test-trig atan 'flatan) (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))) diff --git a/collects/typed-racket/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt index aa03ea9f90..bdf646b236 100644 --- a/collects/typed-racket/base-env/base-env-numeric.rkt +++ b/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)] diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index af9a377cc6..2ed82ff36d 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/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 diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index 1a71ea70fd..1af50e0a50 100644 --- a/src/racket/include/schthread.h +++ b/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_) diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index 53e3d0150f..e78af204ea 100644 --- a/src/racket/src/cstartup.inc +++ b/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,2,13,2,2,2,13,96,11,11,8,240,249,81,0,0,16,0,96,38,11, -8,240,249,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14, +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,38,11,8,240,248,81,0,0,16,0,96,11,11, +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, diff --git a/src/racket/src/jit.h b/src/racket/src/jit.h index 4216fb581f..b5d6aa0e0b 100644 --- a/src/racket/src/jit.h +++ b/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. */ diff --git a/src/racket/src/jitarith.c b/src/racket/src/jitarith.c index e99b7f4121..43a94ba32a 100644 --- a/src/racket/src/jitarith.c +++ b/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: diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index 8b509e9124..a334ebc377 100644 --- a/src/racket/src/jitinline.c +++ b/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") diff --git a/src/racket/src/number.c b/src/racket/src/number.c index 76314ff00c..5dcf7c4e9f 100644 --- a/src/racket/src/number.c +++ b/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[]) \ { \ diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h index a1a7896b3c..dfb711a4ae 100644 --- a/src/racket/src/schminc.h +++ b/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 diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 797b9c6a33..0d75d16c55 100644 --- a/src/racket/src/schpriv.h +++ b/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 */ diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index a5e95e7256..b2d7c5c64d 100644 --- a/src/racket/src/schvers.h +++ b/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)