* improved performance for fl+, fl-, fl*, fl/, fl=?, fl<?, fl<=?, fl>? and fl>=?

- results in 
    45% reduction in runtime for fpsum
    43% reduction in runtime for fibfp
    29% reduction in runtime for pnpoly
    28% reduction in runtime for mbrot
  - and
    23% increase in compile time for nucleic
    11% increase in compile time for ray
    10% increase in compile time for fft

BUGS

@@ -1,11 +1,31 @@
-BUG:
+Performance Bugs:
-* (exact->inexact (/ (expt 2 3000) (- (expt 2 3000) 1)))
+
-  should return 1.0, not +nan.0.
+Tail call optimization does not seem to always kick.  In this
+example, x which comes in (disp -4 %esp) is copied into 
+(disp -4 %esp) even though it was there to begin with.
+
+> (lambda (x) (quotient x x))
+   
+    ---
+    (cmpl -4 %eax)
+    (jne (label L16))
+    (label L17)
+    (movl (disp -4 %esp) %edi)
+    (movl (disp -4 %esp) %eax)
+    (movl %edi %ebx)
+    (movl (disp (obj quotient) 7) %edi)
+    (movl %ebx (disp -4 %esp))
+    (movl %eax (disp -8 %esp))
+    (movl -8 %eax)
+    (jmp (disp -3 %edi))
+    (label L16)
+    (jmp (label SL_invalid_args))
+    (nop)
+
+Other Bugs:
 
 * fxsra does not work for large numbers
 
-* pretty-print goes into infinite loop on cyclic data
-* set! on global names is not working.
 * Ensure immutable exports
 
 
@@ -22,6 +42,14 @@ Unix:unified)
 18446744073709551615
 
 ======================================================================
+FIXED: 
+
+* pretty-print goes into infinite loop on cyclic data
+
+* set! on global names is not working.
+
+* (exact->inexact (/ (expt 2 3000) (- (expt 2 3000) 1)))
+  should return 1.0, not +nan.0.
 
 * FIXED symbol calls are not checking for non-procedure.
 
@@ -58,4 +86,3 @@ Fixed:
   Two displays occurred at the end.
 
 
-

scheme/pass-specify-rep-primops.ss

@@ -694,14 +694,14 @@
 
 (define-primop $fxquotient unsafe
   [(V a b) 
-   (with-tmp ([b (T b)])
+   (with-tmp ([b (T b)]) ;;; FIXME: why is quotient called remainder?
     (prm 'sll (prm 'remainder (T a) b) (K fixnum-shift)))]
   [(P a b) (K #t)]
   [(E a b) (nop)])
 
 (define-primop $fxmodulo unsafe
   [(V a b)
-   (with-tmp ([b (T b)])
+   (with-tmp ([b (T b)]) ;;; FIXME: why is modulo called quotient?
      (with-tmp ([c (prm 'logand b 
                       (prm 'sra (prm 'logxor b (T a))
                          (K (sub1 (* 8 wordsize)))))])
@@ -857,6 +857,36 @@
      (prm 'fl:store x (K (- disp-flonum-data vector-tag)))
      x)])
 
+(define (check-flonums ls code)
+  (define (or* a*)
+    (cond
+      [(null? (cdr a*)) (car a*)]
+      [else (prm 'logor (car a*) (or* (cdr a*)))]))
+  (let ([check
+         (let f ([ls ls] [ac '()])
+           (cond
+             [(null? ls) ac]
+             [else
+              (struct-case (car ls)
+                [(constant v) 
+                 (if (flonum? v) 
+                     (f (cdr ls) ac)
+                     #f)]
+                [else (f (cdr ls) (cons (T (car ls)) ac))])]))])
+    (cond
+      [(not check) (interrupt)]
+      [(null? check) code]
+      [else
+       (seq* 
+         (interrupt-unless 
+           (tag-test (or* check) vector-mask vector-tag))
+         (interrupt-unless
+           (prm '= (or* (map (lambda (x) 
+                               (prm 'mref x (K (- vector-tag))))
+                             check))
+                (K flonum-tag)))
+         code)])))
+
 (define-primop $fl+ unsafe
   [(V x y) ($flop-aux 'fl:add! x y)])
 (define-primop $fl- unsafe
@@ -866,6 +896,23 @@
 (define-primop $fl/ unsafe
   [(V x y) ($flop-aux 'fl:div! x y)])
 
+(define-primop fl+ safe
+  [(V x y) (check-flonums (list x y) ($flop-aux 'fl:add! x y))]
+  [(P x y) (check-flonums (list x y) (K #t))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl- safe
+  [(V x y) (check-flonums (list x y) ($flop-aux 'fl:sub! x y))]
+  [(P x y) (check-flonums (list x y) (K #t))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl* safe
+  [(V x y) (check-flonums (list x y) ($flop-aux 'fl:mul! x y))]
+  [(P x y) (check-flonums (list x y) (K #t))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl/ safe
+  [(V x y) (check-flonums (list x y) ($flop-aux 'fl:div! x y))]
+  [(P x y) (check-flonums (list x y) (K #t))]
+  [(E x y) (check-flonums (list x y) (nop))])
+
 (define-primop $fl= unsafe
   [(P x y) ($flcmp-aux 'fl:= x y)])
 (define-primop $fl< unsafe
@@ -877,6 +924,23 @@
 (define-primop $fl>= unsafe
   [(P x y) ($flcmp-aux 'fl:>= x y)])
 
+(define-primop fl=? safe
+  [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:= x y))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl<? safe
+  [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:< x y))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl<=? safe
+  [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:<= x y))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl>? safe
+  [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:> x y))]
+  [(E x y) (check-flonums (list x y) (nop))])
+(define-primop fl>=? safe
+  [(P x y) (check-flonums (list x y) ($flcmp-aux 'fl:>= x y))]
+  [(E x y) (check-flonums (list x y) (nop))])
+
+
 /section)
 
 (section ;;; ratnums