From 1c4ba2692344832d4fc54eebe43e2f24ecd92537 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Sun, 23 Dec 2007 17:33:13 -0500 Subject: [PATCH] Added bitwise-length (fixing bug 178345: Missing bitwise-length) --- scheme/ikarus.numerics.ss | 10 +- scheme/last-revision | 2 +- scheme/makefile.ss | 2 +- scheme/run-tests.ss | 1 + scheme/tests/bignums.ss | 187 +++++++++++++++++++++++++++++++++++++- src/ikarus-numerics.c | 40 ++++++++ 6 files changed, 238 insertions(+), 4 deletions(-) diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index c9422f0..5e73ba6 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -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? @@ -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)])) ) diff --git a/scheme/last-revision b/scheme/last-revision index a848267..c652336 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1281 +1282 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index efcb73d..2bc0d0c 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -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] diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index eeb35cc..25be2a6 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -61,6 +61,7 @@ (test-string-to-number) (test-div-and-mod) (test-bignums) +(test-bignum-length) (test-fxcarry) (test-lists) (test-hashtables) diff --git a/scheme/tests/bignums.ss b/scheme/tests/bignums.ss index 167b532..4cdde17 100644 --- a/scheme/tests/bignums.ss +++ b/scheme/tests/bignums.ss @@ -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) diff --git a/src/ikarus-numerics.c b/src/ikarus-numerics.c index a384c37..10bdcb9 100644 --- a/src/ikarus-numerics.c +++ b/src/ikarus-numerics.c @@ -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); + } +}