add unsafe-f64vector-{ref,set!} and improve JIT to inline arithmetic ops with more than 2 arguments

svn: r17068

collects/compiler/decompile.ss

@@ -321,13 +321,15 @@
                                       list list* vector vector-immutable box))]
              [(3) (memq (car a) '(eq? = <= < >= >
                                       bitwise-bit-set? char=?
-                                      + - * / quotient remainder min max bitwise-and bitwise-ior
+                                      + - * / quotient remainder min max bitwise-and bitwise-ior bitwise-xor
                                       arithmetic-shift vector-ref string-ref bytes-ref
                                       set-mcar! set-mcdr! cons mcons
                                       list list* vector vector-immutable))]
              [(4) (memq (car a) '(vector-set! string-set! bytes-set!
-                                              list list* vector vector-immutable))]
+                                              list list* vector vector-immutable
-             [else (memq (car a) '(list list* vector vector-immutable))]))
+                                              + - * / min max bitwise-and bitwise-ior bitwise-xor))]
+             [else (memq (car a) '(list list* vector vector-immutable
+                                        + - * / min max bitwise-and bitwise-ior bitwise-xor))]))
       (cons '#%in a)
       a))
 

collects/scribblings/guide/performance.scrbl

@@ -253,9 +253,9 @@ machine's instruction to add the numbers (and check for overflow). If
 the two numbers are not fixnums, then the next check whether whether
 both are flonums; in that case, the machine's floating-point
 operations are used directly. For functions that take any number of
-arguments, such as @scheme[+], inlining is applied only for the
+arguments, such as @scheme[+], inlining works for two or more
-two-argument case (except for @scheme[-], whose one-argument case is
+arguments (except for @scheme[-], whose one-argument case is also
-also inlined).
+inlined) when the arguments are either all fixnums or all flonums.
 
 Flonums are @defterm{boxed}, which means that memory is allocated to
 hold every result of a flonum computation. Fortunately, the

collects/scribblings/reference/unsafe.scrbl

@@ -1,6 +1,10 @@
 #lang scribble/doc
 @(require "mz.ss"
-          (for-label scheme/unsafe/ops))
+          (for-label scheme/unsafe/ops
+                     (only-in scheme/foreign
+                              f64vector?
+                              f64vector-ref
+                              f64vector-set!)))
 
 @title[#:tag "unsafe"]{Unsafe Operations}
 
@@ -165,6 +169,15 @@ Unsafe versions of @scheme[bytes-length], @scheme[bytes-ref], and
 fixnum).}
 
 
+@deftogether[(
+@defproc[(unsafe-f64vector-ref [vec f64vector?][k fixnum?]) inexact-real?]
+@defproc[(unsafe-f64vector-set! [vec f64vector?][k fixnum?][n inexact-real?]) void?]
+)]{
+
+Unsafe versions of @scheme[f64vector-ref] and
+@scheme[f64vector-set!].}
+
+
 @deftogether[(
 @defproc[(unsafe-struct-ref [v any/c][k fixnum?]) any/c]
 @defproc[(unsafe-struct-set! [v any/c][k fixnum?][val any/c]) void?]

collects/tests/mzscheme/benchmarks/shootout/mandelbrot.ss

@@ -36,7 +36,7 @@
              ((> (+ zrq ziq) +limit-sqr+) 0)
              (else (loop (add1 i) 
                          (+ (- zrq ziq) cr) 
-                         (+ (* 2.0 (* zr zi)) ci)))))))))
+                         (+ (* 2.0 zr zi) ci)))))))))
 
 ;; -------------------------------
 

collects/tests/mzscheme/benchmarks/shootout/nbody.ss

@@ -93,9 +93,10 @@ Correct output N = 1000 is
     (if (null? o)
       e
       (let* ([o1 (car o)]
-             [e (+ e (* (* 0.5 (body-mass o1))
+             [e (+ e (* 0.5 
-                        (+ (+ (* (body-vx o1) (body-vx o1))
+                        (body-mass o1)
-                              (* (body-vy o1) (body-vy o1)))
+                        (+ (* (body-vx o1) (body-vx o1))
+                           (* (body-vy o1) (body-vy o1))
                            (* (body-vz o1) (body-vz o1)))))])
         (let loop-i ([i (cdr o)] [e e])
           (if (null? i)
@@ -104,7 +105,7 @@ Correct output N = 1000 is
                    [dx   (- (body-x o1) (body-x i1))]
                    [dy   (- (body-y o1) (body-y i1))]
                    [dz   (- (body-z o1) (body-z i1))]
-                   [dist (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz)))]
+                   [dist (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))]
                    [e    (- e (/ (* (body-mass o1) (body-mass i1)) dist))])
               (loop-i (cdr i) e))))))))
 
@@ -126,7 +127,7 @@ Correct output N = 1000 is
                    [dx    (- o1x (body-x i1))]
                    [dy    (- o1y (body-y i1))]
                    [dz    (- o1z (body-z i1))]
-                   [dist2 (+ (+ (* dx dx) (* dy dy)) (* dz dz))]
+                   [dist2 (+ (* dx dx) (* dy dy) (* dz dz))]
                    [mag   (/ +dt+ (* dist2 (sqrt dist2)))]
                    [dxmag (* dx mag)]
                    [dymag (* dy mag)]

collects/tests/mzscheme/optimize.ss

@@ -89,17 +89,38 @@
                   (bin0 iv op +nan.0 (exact->inexact arg2))
                   (unless (eq? op 'eq?)
                     (bin0 iv op +nan.0 +nan.0))))]
-	 [tri0 (lambda (v op get-arg1 arg2 arg3 check-effect)
+	 [tri0 (lambda (v op get-arg1 arg2 arg3 check-effect #:wrap [wrap values])
 		 ;; (printf "Trying ~a ~a ~a\n" op (get-arg1) arg2 arg3);
-		 (let ([name `(,op ,get-arg1 ,arg2, arg3)])
+		 (let ([name `(,op ,get-arg1 ,arg2, arg3)]
-		   (test v name ((eval `(lambda (x) (,op x ,arg2 ,arg3))) (get-arg1)))
+                       [get-arg2 (lambda () arg2)]
+                       [get-arg3 (lambda () arg3)])
+		   (test v name ((eval `(lambda (x) ,(wrap `(,op x ,arg2 ,arg3)))) (get-arg1)))
 		   (check-effect)
-		   (test v name ((eval `(lambda (x) (,op (,get-arg1) x ,arg3))) arg2))
+		   (test v name ((eval `(lambda (x) ,(wrap `(,op (,get-arg1) x ,arg3)))) arg2))
 		   (check-effect)
-		   (test v name ((eval `(lambda (x) (,op (,get-arg1) ,arg2 x))) arg3))
+		   (test v name ((eval `(lambda (x) ,(wrap `(,op x (,get-arg2) ,arg3)))) (get-arg1)))
 		   (check-effect)
-		   (test v name ((eval `(lambda (x y z) (,op x y z))) (get-arg1) arg2 arg3))
+		   (test v name ((eval `(lambda (x) ,(wrap `(,op (,get-arg1) (,get-arg2) x)))) arg3))
+		   (check-effect)
+		   (test v name ((eval `(lambda () ,(wrap `(,op (,get-arg1) (,get-arg2) (,get-arg3)))))))
+		   (check-effect)
+		   (test v name ((eval `(lambda (x) ,(wrap `(,op (,get-arg1) ,arg2 x)))) arg3))
+		   (check-effect)
+		   (test v name ((eval `(lambda (x y) ,(wrap `(,op (,get-arg1) x y)))) arg2 arg3))
+		   (check-effect)
+		   (test v name ((eval `(lambda (x y z) ,(wrap `(,op x y z)))) (get-arg1) arg2 arg3))
 		   (check-effect)))]
+         [tri (lambda (v op get-arg1 arg2 arg3 check-effect #:wrap [wrap values])
+                (define (e->i n) (if (number? n) (exact->inexact n) n))
+                (tri0 v op get-arg1 arg2 arg3 check-effect #:wrap wrap)
+                (tri0 (e->i v) op (lambda () (exact->inexact (get-arg1))) (exact->inexact arg2) (exact->inexact arg3) check-effect
+                       #:wrap wrap)
+                (tri0 (e->i v) op get-arg1 (exact->inexact arg2) arg3 check-effect
+                       #:wrap wrap))]
+         [tri-if (lambda (v op get-arg1 arg2 arg3 check-effect)
+                   (tri v op get-arg1 arg2 arg3 check-effect)
+                   (tri (if v 'true 'false) op get-arg1 arg2 arg3 check-effect
+                        #:wrap (lambda (e) `(if ,e 'true 'false))))]
 	 [tri-exact (lambda (v op get-arg1 arg2 arg3 check-effect 3rd-all-ok?)
                       (check-error-message op (eval `(lambda (x) (,op x ,arg2 ,arg3))))
                       (check-error-message op (eval `(lambda (x) (,op (,get-arg1) x ,arg3))))
@@ -188,12 +209,18 @@
     (bin #t '< -200 100)
     (bin #f '< 100 -200)
     (bin #t '< 1 (expt 2 30))
+    (tri-if #t '< (lambda () 1) 2 3 void)
+    (tri-if #f '< (lambda () 1) 3 3 void)
+    (tri-if #f '< (lambda () 1) -1 3 void)
 
     (bin #t '<= 100 200)
     (bin #f '<= 200 100)
     (bin #t '<= 100 100)
     (bin #t '<= -200 100)
     (bin #f '<= 100 -200)
+    (tri-if #t '<= (lambda () 1) 2 3 void)
+    (tri-if #t '<= (lambda () 1) 3 3 void)
+    (tri-if #f '<= (lambda () 1) -1 3 void)
 
     (bin #f '> 100 200)
     (bin #t '> 200 100)
@@ -201,18 +228,28 @@
     (bin #f '> -200 100)
     (bin #t '> 100 -200)
     (bin #f '> 1 (expt 2 30))
+    (tri-if #t '> (lambda () 3) 2 1 void)
+    (tri-if #f '> (lambda () 3) 3 1 void)
+    (tri-if #f '> (lambda () 3) -1 1 void)
 
     (bin #f '>= 100 200)
     (bin #t '>= 200 100)
     (bin #t '>= 100 100)
     (bin #f '>= -200 100)
     (bin #t '>= 100 -200)
+    (tri-if #t '>= (lambda () 3) 2 1 void)
+    (tri-if #t '>= (lambda () 3) 3 1 void)
+    (tri-if #f '>= (lambda () 3) -1 1 void)
 
     (bin #f '= 100 200)
     (bin #f '= 200 100)
     (bin #t '= 100 100)
     (bin #f '= -200 100)
     (bin #f '= +nan.0 +nan.0)
+    (tri-if #t '= (lambda () 3) 3 3 void)
+    (tri-if #f '= (lambda () 3) 3 1 void)
+    (tri-if #f '= (lambda () 3) 1 3 void)
+    (tri-if #f '= (lambda () 1) 3 3 void)
 
     (un 3 'add1 2)
     (un -3 'add1 -4)
@@ -247,6 +284,7 @@
     (bin -3 '+ 4 -7)
     (bin (expt 2 30) '+ (expt 2 29) (expt 2 29))
     (bin (- (expt 2 31) 2) '+ (sub1 (expt 2 30)) (sub1 (expt 2 30)))
+    (tri 6 '+ (lambda () 1) 2 3 void)
 
     (bin 3 '- 7 4)
     (bin 11 '- 7 -4)
@@ -254,6 +292,7 @@
     (bin (expt 2 30) '- (expt 2 29) (- (expt 2 29)))
     (bin (- (expt 2 30)) '- (- (expt 2 29)) (expt 2 29))
     (bin (- 2 (expt 2 31)) '- (- 1 (expt 2 30)) (sub1 (expt 2 30)))
+    (tri 6 '- (lambda () 10) 3 1 void)
 
     (bin 4 '* 1 4)
     (bin 0 '* 0 4)
@@ -265,6 +304,7 @@
     (bin (expt 2 30) '* 2 (expt 2 29))
     (bin (expt 2 31) '* 2 (expt 2 30))
     (bin (- (expt 2 30)) '* 2 (- (expt 2 29)))
+    (tri 30 '* (lambda () 2) 3 5 void)
 
     (bin 0 '/ 0 4)
     (bin 1/4 '/ 1 4)
@@ -273,6 +313,7 @@
     (bin -4 '/ -16 4)
     (bin -4 '/ 16 -4)
     (bin 4 '/ -16 -4)
+    (tri 3 '/ (lambda () 30) 5 2 void)
 
     (bin-int 3 'quotient 10 3)
     (bin-int -3 'quotient 10 -3)
@@ -289,10 +330,16 @@
     (bin 3 'min 3 300)
     (bin -300 'min 3 -300)
     (bin -400 'min -400 -300)
+    (tri 5 'min (lambda () 10) 5 20 void)
+    (tri 5 'min (lambda () 5) 10 20 void)
+    (tri 5 'min (lambda () 20) 10 5 void)
 
     (bin 300 'max 3 300)
     (bin 3 'max 3 -300)
     (bin -3 'max -3 -300)
+    (tri 50 'max (lambda () 10) 50 20 void)
+    (tri 50 'max (lambda () 50) 10 20 void)
+    (tri 50 'max (lambda () 20) 10 50 void)
 
     (bin-exact 11 'bitwise-and 11 43)
     (bin-exact 0 'bitwise-and 11 32)
@@ -301,18 +348,21 @@
     (bin-exact 11 'bitwise-and 11 -1)
     (bin-exact -11 'bitwise-and -11 -1)
     (bin-exact (expt 2 50) 'bitwise-and (expt 2 50) (expt 2 50))
+    (tri-exact #x10101 'bitwise-and (lambda () #x11111) #x10111 #x110101 void #f)
 
     (bin-exact 11 'bitwise-ior 8 3)
     (bin-exact 11 'bitwise-ior 11 3)
     (bin-exact -1 'bitwise-ior 11 -1)
     (bin-exact (sub1 (expt 2 51)) 'bitwise-ior (sub1 (expt 2 50)) (expt 2 50))
     (bin-exact (add1 (expt 2 50)) 'bitwise-ior 1 (expt 2 50))
+    (tri-exact #x10101 'bitwise-ior (lambda () #x1) #x100 #x10000 void #f)
 
     (bin-exact 11 'bitwise-xor 8 3)
     (bin-exact 8 'bitwise-xor 11 3)
     (bin-exact -2 'bitwise-xor 1 -1)
     (bin-exact (sub1 (expt 2 51)) 'bitwise-xor (sub1 (expt 2 50)) (expt 2 50))
     (bin-exact (add1 (expt 2 50)) 'bitwise-xor 1 (expt 2 50))
+    (tri-exact #x10101 'bitwise-xor (lambda () #x1) #x110 #x10010 void #f)
 
     (bin-exact 4 'arithmetic-shift 2 1)
     (bin-exact 1 'arithmetic-shift 2 -1)

collects/tests/mzscheme/unsafe.ss

@@ -3,7 +3,8 @@
 
 (Section 'unsafe)
 
-(require '#%unsafe)
+(require scheme/unsafe/ops
+         scheme/foreign)
 
 (let ()
   (define (test-tri result proc x y z 
@@ -186,6 +187,13 @@
               #:post (lambda (x) (list x (string-ref v 2)))
               #:literal-ok? #f))
 
+  (test-bin 9.5 'unsafe-f64vector-ref (f64vector 1.0 9.5 18.7) 1)
+  (let ([v (f64vector 1.0 9.5 18.7)])
+    (test-tri (list (void) 27.4) 'unsafe-f64vector-set! v 2 27.4
+              #:pre (lambda () (f64vector-set! v 2 0.0)) 
+              #:post (lambda (x) (list x (f64vector-ref v 2)))
+              #:literal-ok? #f))
+
   (let ()
     (define-struct posn (x [y #:mutable] z))
     (test-bin 'a unsafe-struct-ref (make-posn 'a 'b 'c) 0 #:literal-ok? #f)
@@ -195,6 +203,12 @@
                 #:pre (lambda () (set-posn-y! p 0)) 
                 #:post (lambda (x) (posn-y p))
                 #:literal-ok? #f)))
+  ;; test unboxing:
+  (test-tri 5.4 '(lambda (x y z) (unsafe-fl+ x (unsafe-f64vector-ref y z))) 1.2 (f64vector 1.0 4.2 6.7) 1)
+  (test-tri 3.2 '(lambda (x y z) 
+                   (unsafe-f64vector-set! y 1 (unsafe-fl+ x z))
+                   (unsafe-f64vector-ref y 1))
+            1.2 (f64vector 1.0 4.2 6.7) 2.0)
 
   (void))
 

doc/release-notes/mzscheme/HISTORY.txt

@@ -1,3 +1,7 @@
+Version 4.2.3.3
+Added unsafe-f64vector-ref and unsafe-f64vector-set!
+Changed JIT to inline numeric ops with more than 2 arguments
+
 Version 4.2.3, November 2009
 Changed _pointer (in scheme/foreign) to mean a pointer that does not
  refer to GCable memory; added _gcpointer

src/mzscheme/src/cstartup.inc

@@ -1,43 +1,43 @@
   {
-    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,50,0,0,0,1,0,0,3,0,12,0,
+    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,51,50,0,0,0,1,0,0,3,0,12,0,
-17,0,20,0,27,0,40,0,47,0,51,0,58,0,63,0,68,0,72,0,78,
+25,0,29,0,34,0,41,0,44,0,49,0,56,0,63,0,67,0,72,0,78,
 0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
 177,0,179,0,193,0,4,1,33,1,44,1,55,1,65,1,101,1,134,1,167,
 1,226,1,36,2,114,2,180,2,185,2,205,2,96,3,116,3,167,3,233,3,
 118,4,4,5,56,5,79,5,158,5,0,0,105,7,0,0,29,11,11,68,104,
-101,114,101,45,115,116,120,64,99,111,110,100,62,111,114,66,108,101,116,114,101,
+101,114,101,45,115,116,120,72,112,97,114,97,109,101,116,101,114,105,122,101,63,
-99,72,112,97,114,97,109,101,116,101,114,105,122,101,66,117,110,108,101,115,115,
+97,110,100,64,108,101,116,42,66,100,101,102,105,110,101,62,111,114,64,99,111,
-63,108,101,116,66,100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42,
+110,100,66,108,101,116,114,101,99,66,117,110,108,101,115,115,63,108,101,116,64,
-63,97,110,100,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110,
+119,104,101,110,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110,
 101,108,11,29,94,2,13,68,35,37,112,97,114,97,109,122,11,62,105,102,65,
 98,101,103,105,110,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
 115,61,120,73,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,
-35,11,8,240,168,70,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2,
+35,11,8,240,35,79,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2,
-14,35,35,16,20,2,3,2,1,2,5,2,1,2,6,2,1,2,7,2,1,
+14,35,35,16,20,2,3,2,1,2,7,2,1,2,4,2,1,2,5,2,1,
-2,8,2,1,2,9,2,1,2,10,2,1,2,4,2,1,2,11,2,1,2,
+2,6,2,1,2,9,2,1,2,8,2,1,2,10,2,1,2,11,2,1,2,
-12,2,1,97,36,11,8,240,168,70,0,0,93,159,2,14,35,36,16,2,2,
+12,2,1,97,36,11,8,240,35,79,0,0,93,159,2,14,35,36,16,2,2,
-2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,168,70,0,0,16,
+2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,35,79,0,0,16,
-0,96,37,11,8,240,168,70,0,0,16,0,13,16,4,35,29,11,11,2,1,
+0,96,37,11,8,240,35,79,0,0,16,0,13,16,4,35,29,11,11,2,1,
 11,18,16,2,99,64,104,101,114,101,8,31,8,30,8,29,8,28,8,27,93,
-8,224,175,70,0,0,95,9,8,224,175,70,0,0,2,1,27,248,22,137,4,
+8,224,42,79,0,0,95,9,8,224,42,79,0,0,2,1,27,248,22,137,4,
 195,249,22,130,4,80,158,38,35,251,22,77,2,16,248,22,92,199,12,249,22,
 67,2,17,248,22,94,201,27,248,22,137,4,195,249,22,130,4,80,158,38,35,
 251,22,77,2,16,248,22,92,199,249,22,67,2,17,248,22,94,201,12,27,248,
 22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,
 75,248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,251,22,77,2,
-16,248,22,68,199,249,22,67,2,12,248,22,69,201,11,18,16,2,101,10,8,
+16,248,22,68,199,249,22,67,2,4,248,22,69,201,11,18,16,2,101,10,8,
 31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
-49,49,51,56,56,16,4,11,11,2,19,3,1,8,101,110,118,49,49,51,56,
+49,50,57,54,48,16,4,11,11,2,19,3,1,8,101,110,118,49,50,57,54,
-57,93,8,224,176,70,0,0,95,9,8,224,176,70,0,0,2,1,27,248,22,
+49,93,8,224,43,79,0,0,95,9,8,224,43,79,0,0,2,1,27,248,22,
 69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,75,
 248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,250,22,77,2,20,
 248,22,77,249,22,77,248,22,77,2,21,248,22,68,201,251,22,77,2,16,2,
-21,2,21,249,22,67,2,4,248,22,69,204,18,16,2,101,11,8,31,8,30,
+21,2,21,249,22,67,2,7,248,22,69,204,18,16,2,101,11,8,31,8,30,
-8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,49,51,
+8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,50,57,
-57,49,16,4,11,11,2,19,3,1,8,101,110,118,49,49,51,57,50,93,8,
+54,51,16,4,11,11,2,19,3,1,8,101,110,118,49,50,57,54,52,93,8,
-224,177,70,0,0,95,9,8,224,177,70,0,0,2,1,248,22,137,4,193,27,
+224,44,79,0,0,95,9,8,224,44,79,0,0,2,1,248,22,137,4,193,27,
 248,22,137,4,194,249,22,67,248,22,77,248,22,68,196,248,22,69,195,27,248,
 22,69,248,22,137,4,23,197,1,249,22,130,4,80,158,38,35,28,248,22,53,
 248,22,131,4,248,22,68,23,198,2,27,249,22,2,32,0,89,162,8,44,36,
@@ -51,8 +51,8 @@
 249,22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,137,4,248,22,
 68,201,248,22,69,198,27,248,22,69,248,22,137,4,196,27,248,22,137,4,248,
 22,68,195,249,22,130,4,80,158,39,35,28,248,22,75,195,250,22,78,2,20,
-9,248,22,69,199,250,22,77,2,8,248,22,77,248,22,68,199,250,22,78,2,
+9,248,22,69,199,250,22,77,2,11,248,22,77,248,22,68,199,250,22,78,2,
-11,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27,
+5,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27,
 249,22,1,22,81,249,22,2,22,137,4,248,22,137,4,248,22,68,199,249,22,
 130,4,80,158,39,35,251,22,77,1,22,119,105,116,104,45,99,111,110,116,105,
 110,117,97,116,105,111,110,45,109,97,114,107,2,24,250,22,78,1,23,101,120,
@@ -62,14 +62,14 @@
 22,69,203,27,248,22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,
 35,36,249,22,130,4,80,158,38,35,27,248,22,137,4,248,22,68,197,28,249,
 22,167,8,62,61,62,248,22,131,4,248,22,92,196,250,22,77,2,20,248,22,
-77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,3,249,22,77,2,
+77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,8,249,22,77,2,
 25,249,22,77,248,22,101,203,2,25,248,22,69,202,251,22,77,2,16,28,249,
 22,167,8,248,22,131,4,248,22,68,200,64,101,108,115,101,10,248,22,68,197,
-250,22,78,2,20,9,248,22,69,200,249,22,67,2,3,248,22,69,202,100,8,
+250,22,78,2,20,9,248,22,69,200,249,22,67,2,8,248,22,69,202,100,8,
 31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
-49,49,52,49,52,16,4,11,11,2,19,3,1,8,101,110,118,49,49,52,49,
+49,50,57,56,54,16,4,11,11,2,19,3,1,8,101,110,118,49,50,57,56,
-53,93,8,224,178,70,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47,
+55,93,8,224,45,79,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47,
-95,9,8,224,178,70,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22,
+95,9,8,224,45,79,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22,
 130,4,80,158,38,35,28,248,22,53,248,22,131,4,248,22,68,197,250,22,77,
 2,26,248,22,77,248,22,68,199,248,22,92,198,27,248,22,131,4,248,22,68,
 197,250,22,77,2,26,248,22,77,248,22,68,197,250,22,78,2,23,248,22,69,
@@ -81,25 +81,25 @@
 2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,35,
 45,36,11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,
 16,0,35,35,16,11,16,5,2,2,20,15,159,35,35,35,35,20,102,159,35,
-16,0,16,1,33,32,10,16,5,2,7,89,162,8,44,36,52,9,223,0,33,
+16,0,16,1,33,32,10,16,5,2,10,89,162,8,44,36,52,9,223,0,33,
-33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,10,89,162,8,44,
+33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,12,89,162,8,44,
 36,52,9,223,0,33,34,35,20,102,159,35,16,1,2,2,16,0,11,16,5,
-2,12,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2,
+2,4,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2,
-2,16,1,33,36,11,16,5,2,4,89,162,8,44,36,55,9,223,0,33,37,
+2,16,1,33,36,11,16,5,2,7,89,162,8,44,36,55,9,223,0,33,37,
-35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,8,89,162,8,
+35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,11,89,162,8,
 44,36,57,9,223,0,33,41,35,20,102,159,35,16,1,2,2,16,0,11,16,
-5,2,5,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1,
+5,2,9,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1,
-2,2,16,0,11,16,5,2,11,89,162,8,44,36,53,9,223,0,33,44,35,
+2,2,16,0,11,16,5,2,5,89,162,8,44,36,53,9,223,0,33,44,35,
-20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,89,162,8,44,36,54,
+20,102,159,35,16,1,2,2,16,0,11,16,5,2,3,89,162,8,44,36,54,
-9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,3,
+9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,8,
 89,162,8,44,36,57,9,223,0,33,46,35,20,102,159,35,16,1,2,2,16,
-1,33,48,11,16,5,2,9,89,162,8,44,36,53,9,223,0,33,49,35,20,
+1,33,48,11,16,5,2,6,89,162,8,44,36,53,9,223,0,33,49,35,20,
 102,159,35,16,1,2,2,16,0,11,16,0,94,2,14,2,15,93,2,14,9,
 9,35,0};
     EVAL_ONE_SIZED_STR((char *)expr, 2018);
   }
   {
-    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,59,0,0,0,1,0,0,13,0,18,0,
+    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,51,59,0,0,0,1,0,0,13,0,18,0,
 35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226,
 0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1,
 199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100,
@@ -341,12 +341,12 @@
     EVAL_ONE_SIZED_STR((char *)expr, 5006);
   }
   {
-    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,8,0,0,0,1,0,0,6,0,19,0,
+    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,51,8,0,0,0,1,0,0,6,0,19,0,
 34,0,48,0,62,0,76,0,118,0,0,0,38,1,0,0,65,113,117,111,116,
 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,
 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,
 11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35,
-37,107,101,114,110,101,108,11,97,35,11,8,240,46,71,0,0,98,159,2,2,
+37,107,101,114,110,101,108,11,97,35,11,8,240,169,79,0,0,98,159,2,2,
 35,35,159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,
 35,159,2,6,35,35,16,0,159,35,20,102,159,35,16,1,11,16,0,83,158,
 41,20,100,144,69,35,37,98,117,105,108,116,105,110,29,11,11,11,11,11,18,
@@ -360,7 +360,7 @@
     EVAL_ONE_SIZED_STR((char *)expr, 331);
   }
   {
-    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,56,0,0,0,1,0,0,11,0,38,0,
+    static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,51,56,0,0,0,1,0,0,11,0,38,0,
 44,0,57,0,66,0,73,0,95,0,117,0,143,0,155,0,173,0,193,0,205,
 0,221,0,244,0,0,1,31,1,38,1,43,1,48,1,53,1,58,1,67,1,
 72,1,76,1,84,1,93,1,101,1,204,1,249,1,13,2,42,2,73,2,129,

src/mzscheme/src/lightning/i386/fp.h

@@ -201,6 +201,8 @@ union jit_double_imm {
   ((rd) == 0 ? (FSTPr (0), FPX(), FLDLm(0, (s1), (s2), 1))	\
    : (FPX(), FLDLm(0, (s1), (s2), 1), FSTPr ((rd) + 1)))
 
+#define jit_ldxr_d_fppush(rd, s1, s2) (FPX(), FLDLm(0, (s1), (s2), 1))
+
 #define jit_extr_i_d(rd, rs)   (PUSHLr((rs)),          \
   ((rd) == 0 ? (FSTPr (0), FILDLm(0, _ESP, 0, 0))      \
    : (FILDLm(0, _ESP, 0, 0), FSTPr ((rd) + 1))),       \
@@ -235,9 +237,10 @@ union jit_double_imm {
 
 #define jit_sti_d_fppop(id, rs)      (FPX(), FSTPLm((id), 0,    0, 0))
 #endif
-#define jit_stxi_d_fppop(id, rd, rs) (FPX(), FSTPLm((id), (rd), 0, 0))
 
+#define jit_stxi_d_fppop(id, rd, rs) (FPX(), FSTPLm((id), (rd), 0, 0))
 #define jit_str_d_fppop(rd, rs)      (FPX(), FSTPLm(0,    (rd), 0, 0))
+#define jit_stxr_d_fppop(d1, d2, rs) (FPX(), FSTPLm(0,    (d1), (d2), 1))
 
 /* Assume round to near mode */
 #define jit_floorr_d_i(rd, rs) \

src/mzscheme/src/numarith.c

@@ -63,20 +63,24 @@ void scheme_init_numarith(Scheme_Env *env)
   scheme_add_global_constant("sub1", p, env);
 
   p = scheme_make_folding_prim(plus, "+", 0, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("+", p, env);
 
   p = scheme_make_folding_prim(minus, "-", 1, -1, 1);
   SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
-                                | SCHEME_PRIM_IS_UNARY_INLINED);
+                                | SCHEME_PRIM_IS_UNARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("-", p, env);
 
   p = scheme_make_folding_prim(mult, "*", 0, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("*", p, env);
 
   p = scheme_make_folding_prim(div_prim, "/", 1, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("/", p, env);
 
   p = scheme_make_folding_prim(scheme_abs, "abs", 1, 1, 1);

src/mzscheme/src/number.c

@@ -105,6 +105,8 @@ static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fx_lshift (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fx_rshift (int argc, Scheme_Object *argv[]);
 static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[]);
+static Scheme_Object *fl_ref (int argc, Scheme_Object *argv[]);
+static Scheme_Object *fl_set (int argc, Scheme_Object *argv[]);
 
 static double not_a_number_val;
 
@@ -312,15 +314,18 @@ scheme_init_number (Scheme_Env *env)
 			     env);
 
   p = scheme_make_folding_prim(scheme_bitwise_and, "bitwise-and", 0, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("bitwise-and", p, env);
 
   p = scheme_make_folding_prim(bitwise_or, "bitwise-ior", 0, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("bitwise-ior", p, env);
 
   p = scheme_make_folding_prim(bitwise_xor, "bitwise-xor", 0, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("bitwise-xor", p, env);
 
   p = scheme_make_folding_prim(bitwise_not, "bitwise-not", 1, 1, 1);
@@ -525,6 +530,18 @@ void scheme_init_unsafe_number(Scheme_Env *env)
   if (scheme_can_inline_fp_op())
     SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
   scheme_add_global_constant("unsafe-fx->fl", p, env);
+
+  p = scheme_make_noncm_prim(fl_ref, "unsafe-f64vector-ref",
+                             2, 2);
+  if (scheme_can_inline_fp_op())
+    SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  scheme_add_global_constant("unsafe-f64vector-ref", p, env);
+  
+  p = scheme_make_noncm_prim(fl_set, "unsafe-f64vector-set!",
+                             3, 3);
+  if (scheme_can_inline_fp_op())
+    SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
+  scheme_add_global_constant("unsafe-f64vector-set!", p, env);  
 }
 
 
@@ -2814,3 +2831,20 @@ static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[])
   v = SCHEME_INT_VAL(argv[0]);
   return scheme_make_double(v);
 }
+
+static Scheme_Object *fl_ref (int argc, Scheme_Object *argv[])
+{
+  double v;
+  Scheme_Object *p;
+  p = ((Scheme_Structure *)argv[0])->slots[0];
+  v = ((double *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])];
+  return scheme_make_double(v);
+}
+
+static Scheme_Object *fl_set (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *p;
+  p = ((Scheme_Structure *)argv[0])->slots[0];
+  ((double *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])] = SCHEME_DBL_VAL(argv[2]);
+  return scheme_void;
+}

src/mzscheme/src/numcomp.c

@@ -57,23 +57,28 @@ void scheme_init_numcomp(Scheme_Env *env)
   Scheme_Object *p;
 
   p = scheme_make_folding_prim(eq, "=", 2, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("=", p, env);
 
   p = scheme_make_folding_prim(lt, "<", 2, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_BINARY_INLINED);
   scheme_add_global_constant("<", p, env);
 
   p = scheme_make_folding_prim(gt, ">", 2, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant(">", p, env);
 
   p = scheme_make_folding_prim(lt_eq, "<=", 2, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("<=", p, env);
 
   p = scheme_make_folding_prim(gt_eq, ">=", 2, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant(">=", p, env);
 
   p = scheme_make_folding_prim(zero_p, "zero?", 1, 1, 1);
@@ -89,11 +94,13 @@ void scheme_init_numcomp(Scheme_Env *env)
   scheme_add_global_constant("negative?", p, env);
 
   p = scheme_make_folding_prim(sch_max, "max", 1, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("max", p, env);
 
   p = scheme_make_folding_prim(sch_min, "min", 1, -1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("min", p, env);
 }
 

src/mzscheme/src/schminc.h

@@ -14,7 +14,7 @@
 #define USE_COMPILED_STARTUP 1
 
 #define EXPECTED_PRIM_COUNT 959
-#define EXPECTED_UNSAFE_COUNT 47
+#define EXPECTED_UNSAFE_COUNT 49
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/mzscheme/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "4.2.3.2"
+#define MZSCHEME_VERSION "4.2.3.3"
 
 #define MZSCHEME_VERSION_X 4
 #define MZSCHEME_VERSION_Y 2
 #define MZSCHEME_VERSION_Z 3
-#define MZSCHEME_VERSION_W 2
+#define MZSCHEME_VERSION_W 3
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)