diff --git a/benchmarks.larceny/results.Larceny-r6rs b/benchmarks.larceny/results.Larceny-r6rs index 2741a95..61d2c93 100644 --- a/benchmarks.larceny/results.Larceny-r6rs +++ b/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.) diff --git a/benchmarks/r6rs-benchmarks.ss b/benchmarks/r6rs-benchmarks.ss index a3846ef..8120e80 100644 --- a/benchmarks/r6rs-benchmarks.ss +++ b/benchmarks/r6rs-benchmarks.ss @@ -41,6 +41,7 @@ primes-iters puzzle-iters quicksort-iters + ray-iters sboyer-iters simplex-iters sum-iters diff --git a/benchmarks/r6rs-benchmarks/ray.ss b/benchmarks/r6rs-benchmarks/ray.ss index 49b04b9..fa3c370 100644 --- a/benchmarks/r6rs-benchmarks/ray.ss +++ b/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)) diff --git a/bin/ikarus b/bin/ikarus index 12243f2..1678088 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-flonums.c b/bin/ikarus-flonums.c index 27c2337..646a958 100644 --- a/bin/ikarus-flonums.c +++ b/bin/ikarus-flonums.c @@ -5,6 +5,12 @@ #include #include +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); diff --git a/src/ikarus.boot b/src/ikarus.boot index d084351..8cba868 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index d2bd1a4..a2ef270 100644 --- a/src/ikarus.numerics.ss +++ b/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)]) - (cond - [(not e) x] ;;; infs and nans round to themselves - [(ratnum? e) (exact->inexact ($ratnum-round e))] - [else (exact->inexact e)]))) + (foreign-call "ikrt_fl_round" x ($make-flonum))) + + ; (let ([e ($flonum->exact x)]) + ; (cond + ; [(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) diff --git a/src/makefile.ss b/src/makefile.ss index 8d047d1..f87e56c 100755 --- a/src/makefile.ss +++ b/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] diff --git a/src/pass-specify-rep-primops.ss b/src/pass-specify-rep-primops.ss index f41426a..d836664 100644 --- a/src/pass-specify-rep-primops.ss +++ b/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