From 439bc0a293e2591a98c35e555ece2c95009fb32e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 2 Jul 2010 15:25:02 -0600 Subject: [PATCH] add `flreal-part', `flimag-part', `make-flrectangular', and unsafe variants --- collects/racket/flonum.rkt | 3 +- collects/scribblings/reference/numbers.scrbl | 12 ++ collects/scribblings/reference/unsafe.scrbl | 12 ++ collects/tests/racket/optimize.rktl | 24 ++- collects/tests/racket/unsafe.rktl | 4 + doc/release-notes/racket/HISTORY.txt | 13 ++ src/racket/src/cstartup.inc | 24 +-- src/racket/src/eval.c | 8 +- src/racket/src/jit.c | 191 +++++++++++++++---- src/racket/src/jit_ts.c | 6 + src/racket/src/number.c | 82 ++++++++ src/racket/src/schminc.h | 4 +- src/racket/src/schpriv.h | 3 + src/racket/src/schvers.h | 4 +- 14 files changed, 329 insertions(+), 61 deletions(-) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index 834465a2b7..c2c0667902 100644 --- a/collects/racket/flonum.rkt +++ b/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) diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index 7e91c14010..6ea439b46a 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/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 diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index ccb9ac587a..3125d4c37b 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/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?] diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index e0f4dbba48..331077c376 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -3,8 +3,8 @@ (Section 'optimization) -(require scheme/flonum - scheme/fixnum +(require racket/flonum + 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 'scheme/fixnum) + (namespace-require 'racket/flonum) + (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))]) diff --git a/collects/tests/racket/unsafe.rktl b/collects/tests/racket/unsafe.rktl index d34116177a..1c7f5ac219 100644 --- a/collects/tests/racket/unsafe.rktl +++ b/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) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index e80f0dd837..65dcbe64c2 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/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 diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index bff6a61e35..4e58326d44 100644 --- a/src/racket/src/cstartup.inc +++ b/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, -22,0,27,0,34,0,38,0,51,0,55,0,58,0,65,0,72,0,77,0,82, + 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,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, -116,101,114,105,122,101,63,108,101,116,62,111,114,66,100,101,102,105,110,101,66, +111,110,100,72,112,97,114,97,109,101,116,101,114,105,122,101,66,108,101,116,114, +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, diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index ea397c2c12..394c1d86d5 100644 --- a/src/racket/src/eval.c +++ b/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; diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 95f06164f1..467efb1683 100644 --- a/src/racket/src/jit.c +++ b/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,26 +6878,82 @@ 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 { + } 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); - mz_patch_ucbranch(refdone); + 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); + } + CHECK_LIMIT(); + + if (jitter->unbox) + generate_unboxing(jitter, JIT_R0); + return 1; } else if (IS_NAMED_PRIM(rator, "add1")) { generate_arith(jitter, rator, app->rand, NULL, 1, 1, 0, 1, NULL, 1, 0, 0, NULL); @@ -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 - /* 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(); + allocate_rectangular(jitter); 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); diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index 171f9f78e5..6b89bb0741 100644 --- a/src/racket/src/jit_ts.c +++ b/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 diff --git a/src/racket/src/number.c b/src/racket/src/number.c index 91f6b92b71..1227b205a7 100644 --- a/src/racket/src/number.c +++ b/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; +} diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h index 513bf3acac..97d5846c86 100644 --- a/src/racket/src/schminc.h +++ b/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_FLFXNUM_COUNT 55 +#define EXPECTED_UNSAFE_COUNT 69 +#define EXPECTED_FLFXNUM_COUNT 58 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 3ebc511fcf..2124903b15 100644 --- a/src/racket/src/schpriv.h +++ b/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); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index 235884397e..6040867585 100644 --- a/src/racket/src/schvers.h +++ b/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)