more progress on the AMD64 front, fixing more numeric and more cogen

64-bit bugs.
This commit is contained in:
Abdulaziz Ghuloum 2008-07-18 22:21:57 -07:00
parent 01c4afa320
commit 81a1a640df
13 changed files with 123 additions and 105 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -1 +1 @@
1541
1542

View File

@ -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

View File

@ -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")

View File

@ -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))

View File

@ -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))

View File

@ -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)) )
)

View File

@ -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;
}

View File

@ -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)

View File

@ -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;
}

View File

@ -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;