add flreal-part', flimag-part', `make-flrectangular', and unsafe variants
This commit is contained in:
Matthew Flatt
parent
eef7a8ba9d
commit
439bc0a293
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?]
|
||||
|
|
|
|||
|
|
@ -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))])
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
__START_TINY_JUMPS__(1);
|
||||
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);
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user