diff --git a/scheme/ikarus.compiler.altcogen.ss b/scheme/ikarus.compiler.altcogen.ss index 4a7afd5..ff17a3c 100644 --- a/scheme/ikarus.compiler.altcogen.ss +++ b/scheme/ikarus.compiler.altcogen.ss @@ -2348,13 +2348,11 @@ [else x]))])] [(fl:load fl:store fl:add! fl:sub! fl:mul! fl:div! fl:load-single fl:store-single) - (cond - [(mem? a) - (let ([u (mku)]) - (make-seq - (E (make-asm-instr 'move u a)) - (E (make-asm-instr op u b))))] - [else x])] + (check-disp-arg a + (lambda (a) + (check-disp-arg b + (lambda (b) + (make-asm-instr op a b)))))] [(fl:from-int fl:shuffle) x] [else (error who "invalid effect op" op)])] [(primcall op rands) diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss index 0c44f65..0b6b89e 100644 --- a/scheme/ikarus.main.ss +++ b/scheme/ikarus.main.ss @@ -27,11 +27,14 @@ (printf "Ikarus Scheme version ~a\n" (if (zero? (string-length ikarus-revision)) ikarus-version - (format "~a+ (revision ~a, build ~a)" + (format "~a+ (revision ~a, build ~a~a)" ikarus-version (+ 1 (string->number ikarus-revision)) (let-syntax ([ds (lambda (x) (date-string))]) - ds)))) + ds) + (if (= (fixnum-width) 30) + "" + ", 64-bit")))) (display "Copyright (c) 2006-2008 Abdulaziz Ghuloum\n\n")) (define (init-library-path) diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index 4f19481..9e4e354 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -3470,13 +3470,25 @@ (define (pos-fxbitcount n) ;;; nifty parrallel count from: ;;; http://infolab.stanford.edu/~manku/bitcount/bitcount.html - (let ([m0 #x15555555] - [m1 #x13333333] - [m2 #x0f0f0f0f]) - (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))] - [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))] - [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))]) - ($fxmodulo n 255)))) + (case (fixnum-width) + [(30) + (let ([m0 #x15555555] + [m1 #x13333333] + [m2 #x0f0f0f0f]) + (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))] + [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))] + [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))]) + ($fxmodulo n 255)))] + [else + (let ([m0 #x0555555555555555] + [m1 #x0333333333333333] + [m2 #x0f0f0f0f0f0f0f0f] + [m3 #x00ff00ff00ff00ff]) + (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))] + [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))] + [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))] + [n ($fx+ ($fxlogand n m3) ($fxlogand ($fxsra n 8) m3))]) + ($fxmodulo n 255)))])) (define ($fxbitcount n) (if ($fx< n 0) (fxlognot (pos-fxbitcount (fxlognot n))) @@ -3510,15 +3522,24 @@ [else (die 'bitwise-bit-count "not an exact integer" n)]))) (define (fxlength x) + (define (fxlength32 x) + (let ([fl ($fixnum->flonum x)]) + (let ([sbe ($fxlogor + ($fxsll ($flonum-u8-ref fl 0) 4) + ($fxsra ($flonum-u8-ref fl 1) 4))]) + (cond + [($fx= sbe 0) 0] + [else ($fx- sbe 1022)])))) + (define (fxlength64 x) + (if ($fx> x #x7FFFFFFF) + ($fx+ 31 (fxlength32 ($fxsra x 31))) + (fxlength32 x))) (if (fixnum? x) - (let ([fl ($fixnum->flonum - (if ($fx< x 0) ($fxlognot x) x))]) - (let ([sbe ($fxlogor - ($fxsll ($flonum-u8-ref fl 0) 4) - ($fxsra ($flonum-u8-ref fl 1) 4))]) - (cond - [($fx= sbe 0) 0] - [else ($fx- sbe 1022)]))) + (case (fixnum-width) + [(30) + (fxlength32 (if ($fx< x 0) ($fxlognot x) x))] + [else + (fxlength64 (if ($fx< x 0) ($fxlognot x) x))]) (die 'fxlength "not a fixnum" x))) (define (fxbit-set? x i) diff --git a/scheme/last-revision b/scheme/last-revision index 2760076..57c7c05 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1541 +1542 diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss index 504f191..0109d1d 100644 --- a/scheme/pass-specify-rep-primops.ss +++ b/scheme/pass-specify-rep-primops.ss @@ -1070,13 +1070,19 @@ (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 - (K 0) ; dummy - (prm 'sra (T fx) (K fx-shift))) - (prm 'fl:store x (K (- disp-flonum-data vector-tag))) - x)]) + (case wordsize + [(4) + (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 + (K 0) ; dummy + (prm 'sra (T fx) (K fx-shift))) + (prm 'fl:store x (K (- disp-flonum-data vector-tag))) + x)] + [else + (with-tmp ([f (cogen-value-$make-flonum)]) + (make-forcall "ikrt_fixnum_to_flonum" (list (T fx) f)))])]) + (define (check-flonums ls code) (cond diff --git a/scheme/run-tests.64.ss b/scheme/run-tests.64.ss index 3742fe0..3d88bf5 100755 --- a/scheme/run-tests.64.ss +++ b/scheme/run-tests.64.ss @@ -53,33 +53,34 @@ (f 0 536870911000 536870911) (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n")) -;(test-bitwise-op) - ;(test-parse-flonums) -;(test-case-folding) - ;(test-reader) -;(test-char-syntax) +(test-bitwise-op) +(test-parse-flonums) +(test-case-folding) +(test-reader) +(test-char-syntax) ;(test-bytevectors) -;(test-strings) +(test-strings) ;(test-exact-integer-sqrt) - ;(test-bignum-to-flonum) - ;(test-bignum->flonum) - ;(test-string-to-number) - ;(test-div-and-mod) - ;(test-bignums) - ;(test-bignum-length) - ;(test-fxcarry) - ;(test-lists) - ;(test-hashtables) - ;(test-input-ports) - ;(test-bignum-conversion) - ;(test-fldiv-and-mod) - ;(test-fldiv0-and-mod0) - ;(test-fxdiv-and-mod) - ;(test-fxdiv0-and-mod0) - ;(test-fxlength) - (test-bitwise-bit-count) +(test-bignum-to-flonum) +;(test-bignum->flonum) +(test-string-to-number) +(test-div-and-mod) +(test-bignums) +(test-bignum-length) +(test-fxcarry) +(test-lists) +(test-hashtables) +(test-input-ports) +(test-bignum-conversion) +(test-fldiv-and-mod) +(test-fldiv0-and-mod0) +(test-fxdiv-and-mod) +(test-fxdiv0-and-mod0) +(test-fxlength) +(test-bitwise-bit-count) ;(test-io) -;(test-sorting) +(test-sorting) ;(test-fasl) - ;(test-numerics) +(test-numerics) + (printf "Happy Happy Joy Joy\n") diff --git a/scheme/tests/bignum-to-flonum.ss b/scheme/tests/bignum-to-flonum.ss index ea90f6b..b3c7e2e 100644 --- a/scheme/tests/bignum-to-flonum.ss +++ b/scheme/tests/bignum-to-flonum.ss @@ -16,11 +16,11 @@ (define (testnum x) (define precision 53) - (assert (bignum? x)) + ;(assert (bignum? x)) (let ([fl (inexact x)]) (let ([n (if (> x 0) x (- x))]) (let ([bits (bitwise-length n)]) - (printf "bits = ~s\n" bits) + (printf "bits(~s) = ~s\n" n bits) (cond [(<= bits precision) (unless (= x (exact fl)) diff --git a/scheme/tests/bignums.ss b/scheme/tests/bignums.ss index 4cdde17..e53836a 100644 --- a/scheme/tests/bignums.ss +++ b/scheme/tests/bignums.ss @@ -200,10 +200,6 @@ (test #x-1000000000000001)) - - - - (define (test-bitwise-bit-count) (define (test n) (define (pos-count-bits n) @@ -219,13 +215,15 @@ [bc1 (count-bits n)]) (unless (= bc0 bc1) (error 'test-bitcount "failed/expected/got" n bc1 bc0)))) - (define (test-fx n) + (define (test-fx count n inc) (when (fixnum? n) - (when (zero? (fxlogand n #x7FFFFFF)) + (when (zero? (fxlogand count #xFFFF)) (printf "bitwise-bit-count ~s\n" n)) (test n) - (test-fx (+ n 512)))) - (test-fx (least-fixnum)) + (test-fx (+ count 1) (+ n inc) inc))) + (if (= (fixnum-width) 30) + (test-fx 0 (least-fixnum) #xFF) + (test-fx 0 (least-fixnum) #xFF00000000)) (test 28472347823493290482390849023840928390482309480923840923840983) (test -847234234903290482390849023840928390482309480923840923840983)) diff --git a/scheme/tests/fixnums.ss b/scheme/tests/fixnums.ss index e0db2da..d432f67 100644 --- a/scheme/tests/fixnums.ss +++ b/scheme/tests/fixnums.ss @@ -98,12 +98,12 @@ [c1 (fxlength x)]) (unless (= c0 c1) (error 'test-fxlength "failed/expected/got" x c0 c1)))) - (define (fxtest x) - (when (fixnum? x) - (when (zero? (bitwise-and x #xFFFFFFF)) - (printf "fxlength ~s\n" x)) - (test x) - (fxtest (+ x #x100)))) + (define (test-fx count n inc) + (when (fixnum? n) + (when (zero? (fxlogand count #xFFFF)) + (printf "bitwise-bit-count ~s\n" n)) + (test n) + (test-fx (+ count 1) (+ n inc) inc))) (test 0) (test 1) (test 2) @@ -111,6 +111,8 @@ (test -1) (test -2) (test -3) - (fxtest (least-fixnum))) + (if (= (fixnum-width) 30) + (test-fx 0 (least-fixnum) #xFF) + (test-fx 0 (least-fixnum) #xFF00000000)) ) ) diff --git a/src/ikarus-collect.c b/src/ikarus-collect.c index 6d345de..0e32fe0 100644 --- a/src/ikarus-collect.c +++ b/src/ikarus-collect.c @@ -374,6 +374,7 @@ extern void verify_integrity(ikpcb* pcb, char*); ikpcb* ik_collect(unsigned long int mem_req, ikpcb* pcb){ +// fprintf(stderr, "ik_collect ...\n"); #ifndef NDEBUG verify_integrity(pcb, "entry"); #endif @@ -562,7 +563,7 @@ ik_collect(unsigned long int mem_req, ikpcb* pcb){ } -// fprintf(stderr, "ik_collect\n"); + //fprintf(stderr, "ik_collect done\n"); return pcb; } diff --git a/src/ikarus-data.h b/src/ikarus-data.h index be72101..53e8a0f 100644 --- a/src/ikarus-data.h +++ b/src/ikarus-data.h @@ -206,7 +206,7 @@ ikptr ik_unsafe_alloc(ikpcb* pcb, int size); ikptr ik_safe_alloc(ikpcb* pcb, int size); #define IK_HEAP_EXT_SIZE (32 * 4096) -#define IK_HEAPSIZE (1024 * ((wordsize==4)?1:16) * 4096) /* 4/8 MB */ +#define IK_HEAPSIZE (1024 * ((wordsize==4)?1:32) * 4096) /* 4/8 MB */ #define wordsize ((int)(sizeof(ikptr))) #define wordshift ((wordsize == 4)?2:3) diff --git a/src/ikarus-flonums.c b/src/ikarus-flonums.c index d71e189..1f4ba48 100644 --- a/src/ikarus-flonums.c +++ b/src/ikarus-flonums.c @@ -238,9 +238,7 @@ ikrt_fx_log(ikptr x, ikpcb* pcb){ ikptr -ikrt_fixnum_to_flonum(ikptr x, ikpcb* pcb){ - ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; - ref(r, -vector_tag) = (ikptr)flonum_tag; +ikrt_fixnum_to_flonum(ikptr x, ikptr r, ikpcb* pcb){ flonum_data(r) = unfix(x); return r; } diff --git a/src/ikarus-numerics.c b/src/ikarus-numerics.c index ebc831e..623b04e 100644 --- a/src/ikarus-numerics.c +++ b/src/ikarus-numerics.c @@ -1825,7 +1825,7 @@ ikrt_bnfx_modulo(ikptr x, ikptr y /*, ikpcb* pcb */){ static int -limb_length(unsigned int n){ +limb_length(unsigned long int n){ int i=0; while(n != 0){ n = n >> 1; @@ -1844,7 +1844,7 @@ ikrt_bignum_length(ikptr x){ int n0 = limb_length(last); if(((unsigned long int) fst) & bignum_sign_mask){ /* negative */ - if (last == (mp_limb_t)(1<<(n0-1))){ + if (last == (mp_limb_t)(1L<<(n0-1))){ /* single bit set in last limb */ int i; for(i=0; i<(sn-1); i++){ @@ -1966,47 +1966,37 @@ ikrt_bignum_to_flonum64(ikptr bn, ikptr more_bits, ikptr fl){ double pos_result; if(limb_count == 1){ pos_result = sp[0]; - } else if (limb_count == 2){ - mp_limb_t lo = sp[0]; - mp_limb_t hi = sp[1]; - pos_result = hi; - pos_result = pos_result * 4294967296.0; - pos_result = pos_result + lo; } else { mp_limb_t hi = sp[limb_count-1]; - mp_limb_t mi = sp[limb_count-2]; int bc = limb_size(hi); - if(bc < 32){ - mp_limb_t lo = sp[limb_count-3]; - hi = (hi << (32-bc)) | (mi >> bc); - mi = (mi << (32-bc)) | (lo >> bc); + if(bc < 64){ + mp_limb_t mi = sp[limb_count-2]; + hi = (hi << (64-bc)) | (mi >> bc); } - /* now hi has 32 full bits, and mi has 32 full bits */ - mp_limb_t mask = ((1<<(64-PRECISION)) - 1); - if((mi & mask) == ((mask+1)>>1)){ + /* now hi has 64 full bits */ + mp_limb_t mask = ((1L<<(64-PRECISION)) - 1); + if((hi & mask) == ((mask+1)>>1)){ /* exactly at break point */ - if(((sp[limb_count-3] << (32-bc)) == 0) && - all_zeros(sp, sp+limb_count-4) && + if(((sp[limb_count-2] << (64-bc)) == 0) && + all_zeros(sp, sp+limb_count-3) && (more_bits == 0)){ - if(mi & (1<<(64-PRECISION))){ + if(hi & (1L<<(64-PRECISION))){ /* odd number, round to even */ - mi = mi | mask; + hi = hi | mask; } } else { /* round up */ - mi = mi | mask; + hi = hi | mask; } - } else if ((mi & mask) > ((mask+1)>>1)){ + } else if ((hi & mask) > ((mask+1)>>1)){ /* also round up */ - mi = mi | mask; + hi = hi | mask; } else { /* keep it to round down */ } pos_result = hi; - pos_result = pos_result * 4294967296.0; - pos_result = pos_result + mi; int bignum_bits = bc + (mp_bits_per_limb * (limb_count-1)); - int exponent = bignum_bits - (2 * mp_bits_per_limb); + int exponent = bignum_bits - mp_bits_per_limb; while(exponent){ pos_result *= 2.0; exponent -= 1;