suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix JIT-generated code for `vector-length' on a fixnum

Browse Source 
and also code for operations like `fl<' on fixnums in
 certain build modes (CGC, PPC)
This commit is contained in:
Matthew Flatt 2010-09-23 06:39:17 -06:00
parent feddcdaef9
commit 3d16dd698a
2 changed files with 48 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/tests/racket/optimize.rktl
View File

@ -14,7 +14,7 @@
[eval-jit-enabled #t]) [eval-jit-enabled #t])
(namespace-require 'racket/flonum) (namespace-require 'racket/flonum)
(namespace-require 'racket/fixnum) (namespace-require 'racket/fixnum)
(let* ([check-error-message (lambda (name proc) (let* ([check-error-message (lambda (name proc [fixnum? #f])
(unless (memq name '(eq? not null? pair? (unless (memq name '(eq? not null? pair?
real? number? boolean? real? number? boolean?
procedure? symbol? procedure? symbol?
@ -25,7 +25,7 @@
exact-nonnegative-integer? exact-nonnegative-integer?
exact-positive-integer?)) exact-positive-integer?))
(let ([s (with-handlers ([exn? exn-message]) (let ([s (with-handlers ([exn? exn-message])
(proc 'bad))] (proc (if fixnum? 10 'bad)))]
[name (symbol->string name)]) [name (symbol->string name)])
(test name (test name
(lambda (v) (lambda (v)
@ -44,12 +44,14 @@
(test (if v 'yes 'no) (test (if v 'yes 'no)
name name
((eval `(lambda (x) (if (,op x) 'yes 'no))) arg)))))] ((eval `(lambda (x) (if (,op x) 'yes 'no))) arg)))))]
[un-exact (lambda (v op arg) [un-exact (lambda (v op arg [check-fixnum-as-bad? #f])
(check-error-message op (eval `(lambda (x) (,op x)))) (check-error-message op (eval `(lambda (x) (,op x))))
(when check-fixnum-as-bad?
(check-error-message op (eval `(lambda (x) (,op x))) #t))
(un0 v op arg))] (un0 v op arg))]
[un (lambda (v op arg) [un (lambda (v op arg [check-fixnum-as-bad? #f])
(un-exact v op arg) (un-exact v op arg check-fixnum-as-bad?)
(when (number? arg) (when (number? arg)
(let ([iv (if (number? v) (let ([iv (if (number? v)
(exact->inexact v) (exact->inexact v)
@ -65,12 +67,17 @@
;; (printf " for branch...\n") ;; (printf " for branch...\n")
(test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ,arg2) 'yes 'no))) arg1)) (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ,arg2) 'yes 'no))) arg1))
(test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))] (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))]
[bin-exact (lambda (v op arg1 arg2) [bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f])
(check-error-message op (eval `(lambda (x) (,op x ,arg2)))) (check-error-message op (eval `(lambda (x) (,op x ,arg2))))
(check-error-message op (eval `(lambda (x) (,op ,arg1 x)))) (check-error-message op (eval `(lambda (x) (,op ,arg1 x))))
(when check-fixnum-as-bad?
(check-error-message op (eval `(lambda (x) (,op x ,arg2))) #t)
(check-error-message op (eval `(lambda (x) (,op x 10))) #t)
(unless (fixnum? arg2)
(check-error-message op (eval `(lambda (x) (,op ,arg1 x))) #t)))
(bin0 v op arg1 arg2))] (bin0 v op arg1 arg2))]
[bin-int (lambda (v op arg1 arg2) [bin-int (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f])
(bin-exact v op arg1 arg2) (bin-exact v op arg1 arg2 check-fixnum-as-bad?)
(let* ([iv (if (number? v) (let* ([iv (if (number? v)
(exact->inexact v) (exact->inexact v)
v)] v)]
@ -80,8 +87,8 @@
(bin0 iv op (exact->inexact arg1) arg2) (bin0 iv op (exact->inexact arg1) arg2)
(bin0 iv0 op arg1 (exact->inexact arg2)) (bin0 iv0 op arg1 (exact->inexact arg2))
(bin0 iv op (exact->inexact arg1) (exact->inexact arg2))))] (bin0 iv op (exact->inexact arg1) (exact->inexact arg2))))]
[bin (lambda (v op arg1 arg2) [bin (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f])
(bin-int v op arg1 arg2) (bin-int v op arg1 arg2 check-fixnum-as-bad?)
(let ([iv (if (number? v) (let ([iv (if (number? v)
(if (eq? op '*) (if (eq? op '*)
(/ v (* 33333 33333)) (/ v (* 33333 33333))
@ -233,7 +240,7 @@
(bin-exact #t 'fx< 100 200) (bin-exact #t 'fx< 100 200)
(bin-exact #f 'fx< 200 100) (bin-exact #f 'fx< 200 100)
(bin-exact #f 'fx< 200 200) (bin-exact #f 'fx< 200 200)
(bin-exact #t 'fl< 100.0 200.0) (bin-exact #t 'fl< 100.0 200.0 #t)
(bin-exact #f 'fl< 200.0 100.0) (bin-exact #f 'fl< 200.0 100.0)
(bin-exact #f 'fl< 200.0 200.0) (bin-exact #f 'fl< 200.0 200.0)
@ -248,7 +255,7 @@
(bin-exact #t 'fx<= 100 200) (bin-exact #t 'fx<= 100 200)
(bin-exact #f 'fx<= 200 100) (bin-exact #f 'fx<= 200 100)
(bin-exact #t 'fx<= 200 200) (bin-exact #t 'fx<= 200 200)
(bin-exact #t 'fl<= 100.0 200.0) (bin-exact #t 'fl<= 100.0 200.0 #t)
(bin-exact #f 'fl<= 200.0 100.0) (bin-exact #f 'fl<= 200.0 100.0)
(bin-exact #t 'fl<= 200.0 200.0) (bin-exact #t 'fl<= 200.0 200.0)
@ -264,7 +271,7 @@
(bin-exact #f 'fx> 100 200) (bin-exact #f 'fx> 100 200)
(bin-exact #t 'fx> 200 100) (bin-exact #t 'fx> 200 100)
(bin-exact #f 'fx> 200 200) (bin-exact #f 'fx> 200 200)
(bin-exact #f 'fl> 100.0 200.0) (bin-exact #f 'fl> 100.0 200.0 #t)
(bin-exact #t 'fl> 200.0 100.0) (bin-exact #t 'fl> 200.0 100.0)
(bin-exact #f 'fl> 200.0 200.0) (bin-exact #f 'fl> 200.0 200.0)
@ -279,7 +286,7 @@
(bin-exact #f 'fx>= 100 200) (bin-exact #f 'fx>= 100 200)
(bin-exact #t 'fx>= 200 100) (bin-exact #t 'fx>= 200 100)
(bin-exact #t 'fx>= 200 200) (bin-exact #t 'fx>= 200 200)
(bin-exact #f 'fl>= 100.0 200.0) (bin-exact #f 'fl>= 100.0 200.0 #t)
(bin-exact #t 'fl>= 200.0 100.0) (bin-exact #t 'fl>= 200.0 100.0)
(bin-exact #t 'fl>= 200.0 200.0) (bin-exact #t 'fl>= 200.0 200.0)
@ -294,7 +301,7 @@
(tri-if #f '= (lambda () 1) 3 3 void) (tri-if #f '= (lambda () 1) 3 3 void)
(bin-exact #f 'fx= 100 200) (bin-exact #f 'fx= 100 200)
(bin-exact #t 'fx= 200 200) (bin-exact #t 'fx= 200 200)
(bin-exact #f 'fl= 100.0 200.0) (bin-exact #f 'fl= 100.0 200.0 #t)
(bin-exact #t 'fl= 200.0 200.0) (bin-exact #t 'fl= 200.0 200.0)
(un 3 'add1 2) (un 3 'add1 2)
@ -319,14 +326,14 @@
(un (expt 2 30) 'abs (- (expt 2 30))) (un (expt 2 30) 'abs (- (expt 2 30)))
(un (sub1 (expt 2 62)) 'abs (sub1 (expt 2 62))) (un (sub1 (expt 2 62)) 'abs (sub1 (expt 2 62)))
(un (expt 2 62) 'abs (- (expt 2 62))) (un (expt 2 62) 'abs (- (expt 2 62)))
(un-exact 3.0 'flabs -3.0) (un-exact 3.0 'flabs -3.0 #t)
(un-exact 3.0 'flsqrt 9.0) (un-exact 3.0 'flsqrt 9.0 #t)
(un-exact +nan.0 'flsqrt -9.0) (un-exact +nan.0 'flsqrt -9.0)
(let ([test-trig (let ([test-trig
(lambda (trig fltrig) (lambda (trig fltrig)
(un (trig 1.0) fltrig 1.0) (un (trig 1.0) fltrig 1.0 #t)
(un +nan.0 fltrig +nan.0))]) (un +nan.0 fltrig +nan.0))])
(test-trig sin 'flsin) (test-trig sin 'flsin)
(test-trig cos 'flcos) (test-trig cos 'flcos)
@ -346,10 +353,10 @@
(un-exact 10.0 '->fl 10) (un-exact 10.0 '->fl 10)
(un-exact 10.0 'fx->fl 10) (un-exact 10.0 'fx->fl 10)
(un-exact 11 'fl->exact-integer 11.0) (un-exact 11 'fl->exact-integer 11.0 #t)
(un-exact -1 'fl->exact-integer -1.0) (un-exact -1 'fl->exact-integer -1.0)
(un-exact (inexact->exact 5e200) 'fl->exact-integer 5e200) (un-exact (inexact->exact 5e200) 'fl->exact-integer 5e200)
(un-exact 11 'fl->fx 11.0) (un-exact 11 'fl->fx 11.0 #t)
(un-exact -11 'fl->fx -11.0) (un-exact -11 'fl->fx -11.0)
(bin 11 '+ 4 7) (bin 11 '+ 4 7)
@ -359,7 +366,7 @@
(tri 6 '+ (lambda () 1) 2 3 void) (tri 6 '+ (lambda () 1) 2 3 void)
(tri 13/2 '+ (lambda () 1) 5/2 3 void) (tri 13/2 '+ (lambda () 1) 5/2 3 void)
(bin-exact 25 'fx+ 10 15) (bin-exact 25 'fx+ 10 15)
(bin-exact 3.4 'fl+ 1.1 2.3) (bin-exact 3.4 'fl+ 1.1 2.3 #t)
(bin 3 '- 7 4) (bin 3 '- 7 4)
(bin 11 '- 7 -4) (bin 11 '- 7 -4)
@ -370,7 +377,7 @@
(tri 6 '- (lambda () 10) 3 1 void) (tri 6 '- (lambda () 10) 3 1 void)
(tri 13/2 '- (lambda () 10) 3 1/2 void) (tri 13/2 '- (lambda () 10) 3 1/2 void)
(bin-exact 13 'fx- 5 -8) (bin-exact 13 'fx- 5 -8)
(bin-exact -0.75 'fl- 1.5 2.25) (bin-exact -0.75 'fl- 1.5 2.25 #t)
(bin 4 '* 1 4) (bin 4 '* 1 4)
(bin 0 '* 0 4) (bin 0 '* 0 4)
@ -385,7 +392,7 @@
(tri 30 '* (lambda () 2) 3 5 void) (tri 30 '* (lambda () 2) 3 5 void)
(tri 5 '* (lambda () 2) 3 5/6 void) (tri 5 '* (lambda () 2) 3 5/6 void)
(bin-exact 253 'fx* 11 23) (bin-exact 253 'fx* 11 23)
(bin-exact 2.53 'fl* 1.1 2.3) (bin-exact 2.53 'fl* 1.1 2.3 #t)
(bin 0 '/ 0 4) (bin 0 '/ 0 4)
(bin 1/4 '/ 1 4) (bin 1/4 '/ 1 4)
@ -396,7 +403,7 @@
(bin 4 '/ -16 -4) (bin 4 '/ -16 -4)
(tri 3 '/ (lambda () 30) 5 2 void) (tri 3 '/ (lambda () 30) 5 2 void)
(tri 12 '/ (lambda () 30) 5 1/2 void) (tri 12 '/ (lambda () 30) 5 1/2 void)
(bin-exact (/ 1.1 2.3) 'fl/ 1.1 2.3) (bin-exact (/ 1.1 2.3) 'fl/ 1.1 2.3 #t)
(bin-int 3 'quotient 10 3) (bin-int 3 'quotient 10 3)
(bin-int -3 'quotient 10 -3) (bin-int -3 'quotient 10 -3)
@ -433,7 +440,7 @@
(tri 5 'min (lambda () 10) 5 20 void) (tri 5 'min (lambda () 10) 5 20 void)
(tri 5 'min (lambda () 5) 10 20 void) (tri 5 'min (lambda () 5) 10 20 void)
(tri 5 'min (lambda () 20) 10 5 void) (tri 5 'min (lambda () 20) 10 5 void)
(bin-exact 3.0 'flmin 3.0 4.5) (bin-exact 3.0 'flmin 3.0 4.5 #t)
(bin-exact 2.5 'flmin 3.0 2.5) (bin-exact 2.5 'flmin 3.0 2.5)
(bin0 3.5 '(lambda (x y) (fl+ 1.0 (flmin x y))) 3.0 2.5) (bin0 3.5 '(lambda (x y) (fl+ 1.0 (flmin x y))) 3.0 2.5)
(bin0 4.0 '(lambda (x y) (fl+ 1.0 (flmin x y))) 3.0 4.5) (bin0 4.0 '(lambda (x y) (fl+ 1.0 (flmin x y))) 3.0 4.5)
@ -446,7 +453,7 @@
(tri 50 'max (lambda () 10) 50 20 void) (tri 50 'max (lambda () 10) 50 20 void)
(tri 50 'max (lambda () 50) 10 20 void) (tri 50 'max (lambda () 50) 10 20 void)
(tri 50 'max (lambda () 20) 10 50 void) (tri 50 'max (lambda () 20) 10 50 void)
(bin-exact 4.5 'flmax 3.0 4.5) (bin-exact 4.5 'flmax 3.0 4.5 #t)
(bin-exact 3.0 'flmax 3.0 2.5) (bin-exact 3.0 'flmax 3.0 2.5)
(bin0 5.5 '(lambda (x y) (fl+ 1.0 (flmax x y))) 3.0 4.5) (bin0 5.5 '(lambda (x y) (fl+ 1.0 (flmax x y))) 3.0 4.5)
(bin0 4.0 '(lambda (x y) (fl+ 1.0 (flmax x y))) 3.0 2.5) (bin0 4.0 '(lambda (x y) (fl+ 1.0 (flmax x y))) 3.0 2.5)
@ -515,11 +522,11 @@
(un 1 'real-part 1+2i) (un 1 'real-part 1+2i)
(un 105 'real-part 105) (un 105 'real-part 105)
(un-exact 10.0 'flreal-part 10.0+7.0i) (un-exact 10.0 'flreal-part 10.0+7.0i #t)
(un 2 'imag-part 1+2i) (un 2 'imag-part 1+2i)
(un-exact 0 'imag-part 106) (un-exact 0 'imag-part 106)
(un-exact 0 'imag-part 106.0) (un-exact 0 'imag-part 106.0)
(un-exact 7.0 'flimag-part 10.0+7.0i) (un-exact 7.0 'flimag-part 10.0+7.0i #t)
(bin 1+2i 'make-rectangular 1 2) (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 2.0)
@ -534,23 +541,23 @@
(bin-exact #f 'char=? #\a #\b) (bin-exact #f 'char=? #\a #\b)
(bin-exact #f 'char=? #\u1034 #\a) (bin-exact #f 'char=? #\u1034 #\a)
(bin-exact 'a 'vector-ref #(a b c) 0) (bin-exact 'a 'vector-ref #(a b c) 0 #t)
(bin-exact 'b 'vector-ref #(a b c) 1) (bin-exact 'b 'vector-ref #(a b c) 1)
(bin-exact 'c 'vector-ref #(a b c) 2) (bin-exact 'c 'vector-ref #(a b c) 2)
(un-exact 'a 'unbox (box 'a)) (un-exact 'a 'unbox (box 'a) #t)
(un-exact 3 'vector-length (vector 'a 'b 'c)) (un-exact 3 'vector-length (vector 'a 'b 'c) #t)
(bin-exact 1.1 'flvector-ref (flvector 1.1 2.2 3.3) 0) (bin-exact 1.1 'flvector-ref (flvector 1.1 2.2 3.3) 0 #t)
(bin-exact 3.3 'flvector-ref (flvector 1.1 2.2 3.3) 2) (bin-exact 3.3 'flvector-ref (flvector 1.1 2.2 3.3) 2)
(un-exact 3 'flvector-length (flvector 1.1 2.2 3.3)) (un-exact 3 'flvector-length (flvector 1.1 2.2 3.3) #t)
(bin-exact #\a 'string-ref "abc\u2001" 0) (bin-exact #\a 'string-ref "abc\u2001" 0 #t)
(bin-exact #\b 'string-ref "abc\u2001" 1) (bin-exact #\b 'string-ref "abc\u2001" 1)
(bin-exact #\c 'string-ref "abc\u2001" 2) (bin-exact #\c 'string-ref "abc\u2001" 2)
(bin-exact #\u2001 'string-ref "abc\u2001" 3) (bin-exact #\u2001 'string-ref "abc\u2001" 3)
(bin-exact 65 'bytes-ref #"Abc\xF7" 0) (bin-exact 65 'bytes-ref #"Abc\xF7" 0 #t)
(bin-exact 99 'bytes-ref #"Abc\xF7" 2) (bin-exact 99 'bytes-ref #"Abc\xF7" 2)
(bin-exact #xF7 'bytes-ref #"Abc\xF7" 3) (bin-exact #xF7 'bytes-ref #"Abc\xF7" 3)

7
src/racket/src/jit.c
View File

@ -5110,7 +5110,10 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
} else { } else {
int unbox = jitter->unbox; int unbox = jitter->unbox;
if (unsafe_fl < 0) unsafe_fl = 0; if (unsafe_fl < 0) {
has_fixnum_fast = 0;
unsafe_fl = 0;
}
/* While generating a fixnum op, don't unbox! */ /* While generating a fixnum op, don't unbox! */
jitter->unbox = 0; jitter->unbox = 0;
@ -11068,6 +11071,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
mz_prolog(JIT_R1); mz_prolog(JIT_R1);
/* Check for chaperone: */ /* Check for chaperone: */
ref2 = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type); jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
ref = jit_bnei_i(jit_forward(), JIT_R1, scheme_chaperone_type); ref = jit_bnei_i(jit_forward(), JIT_R1, scheme_chaperone_type);
jit_ldxi_p(JIT_R0, JIT_R0, (long)&((Scheme_Chaperone *)0x0)->val); jit_ldxi_p(JIT_R0, JIT_R0, (long)&((Scheme_Chaperone *)0x0)->val);
@ -11075,6 +11079,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
CHECK_LIMIT(); CHECK_LIMIT();
mz_patch_branch(ref); mz_patch_branch(ref);
mz_patch_branch(ref2);
jit_prepare(1); jit_prepare(1);
jit_pusharg_i(JIT_R0); jit_pusharg_i(JIT_R0);
(void)mz_finish(ts_scheme_vector_length); (void)mz_finish(ts_scheme_vector_length);