conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added bitwise-length (fixing bug 178345: Missing bitwise-length)

This commit is contained in:
Abdulaziz Ghuloum 2007-12-23 17:33:13 -05:00
parent 2e7faf85c7
commit 1c4ba26923
6 changed files with 238 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
scheme/ikarus.numerics.ss
View File

@ -397,7 +397,9 @@
modulo even? odd? bitwise-and bitwise-not
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift
positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt
bitwise-length
positive? negative? expt gcd lcm numerator denominator
exact-integer-sqrt
quotient+remainder number->string string->number min max
abs truncate fltruncate sra sll real->flonum
exact->inexact inexact floor ceiling round log fl=? fl<? fl<=? fl>?
@ -417,6 +419,7 @@
remainder modulo even? odd? quotient+remainder number->string
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift
bitwise-length
positive? negative? bitwise-and bitwise-not
string->number expt gcd lcm numerator denominator
exact->inexact inexact floor ceiling round log
@ -2553,6 +2556,11 @@
[(ratnum? x) (flexp (ratnum->flonum x))]
[else (die 'exp "not a number" x)]))
(define (bitwise-length n)
(cond
[(fixnum? n) (fxlength n)]
[(bignum? n) (foreign-call "ikrt_bignum_length" n)]
[else (error 'bitwise-length "not an exact integer" n)]))
)

2
scheme/last-revision
View File

@ -1 +1 @@
1281
1282

2
scheme/makefile.ss
View File

@ -767,7 +767,7 @@
[bitwise-copy-bit-field r bw]
[bitwise-first-bit-set i r bw]
[bitwise-if r bw]
[bitwise-length r bw]
[bitwise-length i r bw]
[bitwise-reverse-bit-field r bw]
[bitwise-rotate-bit-field r bw]
[fixnum? i r fx]

1
scheme/run-tests.ss
View File

@ -61,6 +61,7 @@
(test-string-to-number)
(test-div-and-mod)
(test-bignums)
(test-bignum-length)
(test-fxcarry)
(test-lists)
(test-hashtables)

187
scheme/tests/bignums.ss
View File

@ -1,5 +1,6 @@
(library (tests bignums)
(export test-bignums test-bignum-conversion test-bitwise-bit-count)
(export test-bignums test-bignum-conversion test-bitwise-bit-count
test-bignum-length)
(import (ikarus) (tests framework))
(define (test-bignum-conversion)
@ -18,6 +19,190 @@
(test #b-1111111111111111111111111111111111111111)
(test -39487932748923498234))
(define (test-bignum-length)
(define (ref ei)
(do ((result 0 (+ result 1))
(bits (if (negative? ei)
(bitwise-not ei)
ei)
(bitwise-arithmetic-shift bits -1)))
((zero? bits)
result)))
(define (test n)
(let ([n0 (bitwise-length n)]
[n1 (ref n)])
(unless (= n0 n1)
(error 'test-bignum-length "mismatch"
(format "#x~x" n) n0 n1))))
(test #xF)
(test #xFF)
(test #xFFF)
(test #xFFFF)
(test #xFFFFF)
(test #xFFFFFF)
(test #xFFFFFFF)
(test #xFFFFFFFF)
(test #xFFFFFFFFF)
(test #xFFFFFFFFFF)
(test #xFFFFFFFFFFF)
(test #xFFFFFFFFFFFF)
(test #xFFFFFFFFFFFFF)
(test #xFFFFFFFFFFFFFF)
(test #xFFFFFFFFFFFFFFF)
(test #xFFFFFFFFFFFFFFFF)
(test #x-F)
(test #x-FF)
(test #x-FFF)
(test #x-FFFF)
(test #x-FFFFF)
(test #x-FFFFFF)
(test #x-FFFFFFF)
(test #x-FFFFFFFF)
(test #x-FFFFFFFFF)
(test #x-FFFFFFFFFF)
(test #x-FFFFFFFFFFF)
(test #x-FFFFFFFFFFFF)
(test #x-FFFFFFFFFFFFF)
(test #x-FFFFFFFFFFFFFF)
(test #x-FFFFFFFFFFFFFFF)
(test #x-FFFFFFFFFFFFFFFF)
(test #xE)
(test #xFE)
(test #xFFE)
(test #xFFFE)
(test #xFFFFE)
(test #xFFFFFE)
(test #xFFFFFFE)
(test #xFFFFFFFE)
(test #xFFFFFFFFE)
(test #xFFFFFFFFFE)
(test #xFFFFFFFFFFE)
(test #xFFFFFFFFFFFE)
(test #xFFFFFFFFFFFFE)
(test #xFFFFFFFFFFFFFE)
(test #xFFFFFFFFFFFFFFE)
(test #xFFFFFFFFFFFFFFFE)
(test #x-E)
(test #x-FE)
(test #x-FFE)
(test #x-FFFE)
(test #x-FFFFE)
(test #x-FFFFFE)
(test #x-FFFFFFE)
(test #x-FFFFFFFE)
(test #x-FFFFFFFFE)
(test #x-FFFFFFFFFE)
(test #x-FFFFFFFFFFE)
(test #x-FFFFFFFFFFFE)
(test #x-FFFFFFFFFFFFE)
(test #x-FFFFFFFFFFFFFE)
(test #x-FFFFFFFFFFFFFFE)
(test #x-FFFFFFFFFFFFFFFE)
(test #x1)
(test #x1F)
(test #x1FF)
(test #x1FFF)
(test #x1FFFF)
(test #x1FFFFF)
(test #x1FFFFFF)
(test #x1FFFFFFF)
(test #x1FFFFFFFF)
(test #x1FFFFFFFFF)
(test #x1FFFFFFFFFF)
(test #x1FFFFFFFFFFF)
(test #x1FFFFFFFFFFFF)
(test #x1FFFFFFFFFFFFF)
(test #x1FFFFFFFFFFFFFF)
(test #x1FFFFFFFFFFFFFFF)
(test #x-1)
(test #x-1F)
(test #x-1FF)
(test #x-1FFF)
(test #x-1FFFF)
(test #x-1FFFFF)
(test #x-1FFFFFF)
(test #x-1FFFFFFF)
(test #x-1FFFFFFFF)
(test #x-1FFFFFFFFF)
(test #x-1FFFFFFFFFF)
(test #x-1FFFFFFFFFFF)
(test #x-1FFFFFFFFFFFF)
(test #x-1FFFFFFFFFFFFF)
(test #x-1FFFFFFFFFFFFFF)
(test #x-1FFFFFFFFFFFFFFF)
(test #x1)
(test #x10)
(test #x100)
(test #x1000)
(test #x10000)
(test #x100000)
(test #x1000000)
(test #x10000000)
(test #x100000000)
(test #x1000000000)
(test #x10000000000)
(test #x100000000000)
(test #x1000000000000)
(test #x10000000000000)
(test #x100000000000000)
(test #x1000000000000000)
(test #x-1)
(test #x-10)
(test #x-100)
(test #x-1000)
(test #x-10000)
(test #x-100000)
(test #x-1000000)
(test #x-10000000)
(test #x-100000000)
(test #x-1000000000)
(test #x-10000000000)
(test #x-100000000000)
(test #x-1000000000000)
(test #x-10000000000000)
(test #x-100000000000000)
(test #x-1000000000000000)
(test #x1)
(test #x11)
(test #x101)
(test #x1001)
(test #x10001)
(test #x100001)
(test #x1000001)
(test #x10000001)
(test #x100000001)
(test #x1000000001)
(test #x10000000001)
(test #x100000000001)
(test #x1000000000001)
(test #x10000000000001)
(test #x100000000000001)
(test #x1000000000000001)
(test #x-1)
(test #x-11)
(test #x-101)
(test #x-1001)
(test #x-10001)
(test #x-100001)
(test #x-1000001)
(test #x-10000001)
(test #x-100000001)
(test #x-1000000001)
(test #x-10000000001)
(test #x-100000000001)
(test #x-1000000000001)
(test #x-10000000000001)
(test #x-100000000000001)
(test #x-1000000000000001))
(define (test-bitwise-bit-count)
(define (test n)

40
src/ikarus-numerics.c
View File

@ -1611,6 +1611,46 @@ ikrt_bnfx_modulo(ikptr x, ikptr y, ikpcb* pcb){
}
static int
limb_length(unsigned int n){
int i=0;
while(n != 0){
n = n >> 1;
i++;
}
return i;
}
ikptr
ikrt_bignum_length(ikptr x){
ikptr fst = ref(x, -vector_tag);
mp_limb_t* sp = (mp_limb_t*)(x+off_bignum_data);
mp_size_t sn = ((unsigned int) fst) >> bignum_length_shift;
mp_limb_t last = sp[sn-1];
int n0 = limb_length(last);
if(((unsigned int) fst) & bignum_sign_mask){
/* negative */
if (last == (1<<(n0-1))){
/* single bit set in last limb */
int i;
for(i=0; i<(sn-1); i++){
if(sp[i] != 0){
/* another bit set */
return fix((sn-1)*mp_bits_per_limb + n0);
}
}
/* number is - #b100000000000000000000000000 */
/* fxnot(n) = #b011111111111111111111111111 */
/* so, subtract 1. */
return fix((sn-1)*mp_bits_per_limb + n0 - 1);
} else {
return fix((sn-1)*mp_bits_per_limb + n0);
}
} else {
return fix((sn-1)*mp_bits_per_limb + n0);
}
}