* Added $fixnum->flonum (not working yet)

benchmarks.larceny/results.Larceny-r6rs

@@ -7450,3 +7450,43 @@ Words allocated: 22544130
 Words reclaimed: 0
 Elapsed time...: 1428 ms (User: 1399 ms; System: 23 ms)
 Elapsed GC time: 74 ms (CPU: 69 in 86 collections.)
+
+****************************
+Benchmarking Larceny-r6rs on Mon Jun 18 13:07:01 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386
+
+Testing ray under Larceny-r6rs
+Compiling...
+Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
+
+
+> 
+> 
+Running...
+Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
+
+
+> 
+Words allocated: 218092882
+Words reclaimed: 0
+Elapsed time...: 22831 ms (User: 13047 ms; System: 9713 ms)
+Elapsed GC time: 307 ms (CPU: 312 in 832 collections.)
+
+****************************
+Benchmarking Larceny-r6rs on Mon Jun 18 13:40:43 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386
+
+Testing ray under Larceny-r6rs
+Compiling...
+Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
+
+
+> 
+> 
+Running...
+Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified)
+
+
+> 
+Words allocated: 218092882
+Words reclaimed: 0
+Elapsed time...: 22792 ms (User: 13047 ms; System: 9716 ms)
+Elapsed GC time: 279 ms (CPU: 308 in 832 collections.)

benchmarks/r6rs-benchmarks.ss

@@ -41,6 +41,7 @@
      primes-iters
      puzzle-iters
      quicksort-iters
+     ray-iters
      sboyer-iters
      simplex-iters
      sum-iters

benchmarks/r6rs-benchmarks/ray.ss

@@ -71,6 +71,8 @@
                             (fl- (point-z eye)))))
       (inexact->exact (flround (fl* (sendray eye ray) 255.0)))))
   
+
+
   (define (sendray pt ray)
     (let* ((x (first-hit pt ray))
            (s (vector-ref x 0))

bin/ikarus-flonums.c

@@ -5,6 +5,12 @@
 #include <errno.h>
 #include <math.h>
 
+ikp
+ikrt_fl_round(ikp x, ikp y){
+  flonum_data(y) = round(flonum_data(x));
+  return y;
+}
+
 ikp
 ikrt_bytevector_to_flonum(ikp x, ikpcb* pcb){
   double v = strtod((char*)x+off_bytevector_data, NULL);

src/ikarus.numerics.ss

@@ -154,6 +154,7 @@
 
   (define (fixnum->flonum x)
     (foreign-call "ikrt_fixnum_to_flonum" x))
+
   (module (bignum->flonum)
     ;  sbe         f6     f5       f4       f3       f2       f1       f0
     ;SEEEEEEE|EEEEmmmm|mmmmmmmm|mmmmmmmm|mmmmmmmm|mmmmmmmm|mmmmmmmm|mmmmmmmm 
@@ -1660,11 +1661,13 @@
                    (if (even? q) q (- q 1))])))))))
 
   (define ($flround x)
-    (let ([e ($flonum->exact x)])
+    (foreign-call "ikrt_fl_round" x ($make-flonum)))
-      (cond
+
-        [(not e) x] ;;; infs and nans round to themselves
+  ;  (let ([e ($flonum->exact x)])
-        [(ratnum? e) (exact->inexact ($ratnum-round e))]
+  ;    (cond
-        [else (exact->inexact e)])))
+  ;      [(not e) x] ;;; infs and nans round to themselves
+  ;      [(ratnum? e) (exact->inexact ($ratnum-round e))]
+  ;      [else (exact->inexact e)])))
 
   (define (flround x)
     (if (flonum? x)

src/makefile.ss

@@ -629,9 +629,10 @@
     [$fl/                           $flonums]
     [$fl=                           $flonums]
     [$fl<                           $flonums]
-    [$fl<=                           $flonums]
+    [$fl<=                          $flonums]
     [$fl>                           $flonums]
-    [$fl>=                           $flonums]
+    [$fl>=                          $flonums]
+    [$fixnum->flonum                $flonums]
 
     [$make-bignum       $bignums]
     [$bignum-positive?  $bignums]

src/pass-specify-rep-primops.ss

@@ -773,6 +773,14 @@
             (prm 'sll (T v) (K (- 8 fx-shift))))]
      [else (interrupt)])])
 
+(define-primop $fixnum->flonum unsafe
+  [(V fx) 
+   (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
+     (prm 'mset x (K (- vector-tag)) (K flonum-tag))
+     (prm 'fl:from-int (prm 'sll (T fx) (K fx-shift)))
+     (prm 'fl:store x (K (- disp-flonum-data vector-tag)))
+     x)])
+
 (define-primop $fl+ unsafe
   [(V x y) ($flop-aux 'fl:add! x y)])
 (define-primop $fl- unsafe