* Added $fixnum->flonum (not working yet)
This commit is contained in:
parent
cb4752df99
commit
d3b2ee35f3
|
@ -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.)
|
||||
|
|
|
@ -41,6 +41,7 @@
|
|||
primes-iters
|
||||
puzzle-iters
|
||||
quicksort-iters
|
||||
ray-iters
|
||||
sboyer-iters
|
||||
simplex-iters
|
||||
sum-iters
|
||||
|
|
|
@ -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
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -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);
|
||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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)
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue