added bitwise-ior.

This commit is contained in:
Abdulaziz Ghuloum 2008-05-18 02:27:55 -07:00
parent 0cd61369b2
commit de4276124b
6 changed files with 438 additions and 69 deletions

View File

@ -1,7 +1,7 @@
(library (ikarus not-yet-implemented)
(export
make-rectangular angle make-polar bitwise-ior bitwise-xor
make-rectangular angle make-polar
bitwise-copy-bit-field bitwise-reverse-bit-field
bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
fxrotate-bit-field bytevector->string string->bytevector
@ -17,7 +17,7 @@
string-upcase)
(import (except (ikarus)
make-rectangular angle make-polar bitwise-ior bitwise-xor
make-rectangular angle make-polar
bitwise-copy-bit-field bitwise-reverse-bit-field
bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
fxrotate-bit-field bytevector->string string->bytevector
@ -57,10 +57,11 @@
...)]))
(not-yet
make-rectangular angle make-polar bitwise-ior bitwise-xor
bitwise-copy-bit-field bitwise-reverse-bit-field
bitwise-rotate-bit-field bitwise-if fxreverse-bit-field
fxrotate-bit-field bytevector->string string->bytevector
make-rectangular angle make-polar
bitwise-if
bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field
fxreverse-bit-field fxrotate-bit-field
bytevector->string string->bytevector
make-custom-binary-input/output-port
make-custom-textual-input/output-port
open-file-input/output-port output-port-buffer-mode

View File

@ -394,7 +394,8 @@
(library (ikarus generic-arithmetic)
(export + - * / zero? = < <= > >= add1 sub1 quotient remainder
modulo even? odd? bitwise-and bitwise-not
modulo even? odd? bitwise-and bitwise-not bitwise-ior
bitwise-xor
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift
bitwise-length
@ -423,7 +424,8 @@
bitwise-arithmetic-shift
bitwise-length
bitwise-copy-bit bitwise-bit-field
positive? negative? bitwise-and bitwise-not
positive? negative? bitwise-and bitwise-not bitwise-ior
bitwise-xor
string->number expt gcd lcm numerator denominator
exact->inexact inexact floor ceiling round log
exact-integer-sqrt min max abs real->flonum
@ -565,6 +567,47 @@
(die 'bitwise-and "not an exact integer" y)])]
[else (die 'bitwise-and "not an exact integer" x)])))
(define binary-bitwise-ior
(lambda (x y)
(cond
[(fixnum? x)
(cond
[(fixnum? y) ($fxlogor x y)]
[(bignum? y)
(foreign-call "ikrt_fxbnlogor" x y)]
[else
(die 'bitwise-ior "not an exact integer" y)])]
[(bignum? x)
(cond
[(fixnum? y)
(foreign-call "ikrt_fxbnlogor" y x)]
[(bignum? y)
(foreign-call "ikrt_bnbnlogor" x y)]
[else
(die 'bitwise-ior "not an exact integer" y)])]
[else (die 'bitwise-ior "not an exact integer" x)])))
(define binary-bitwise-xor
(lambda (x y)
(cond
[(fixnum? x)
(cond
[(fixnum? y) ($fxlogxor x y)]
[(bignum? y)
(foreign-call "ikrt_fxbnlogxor" x y)]
[else
(die 'bitwise-xor "not an exact integer" y)])]
[(bignum? x)
(cond
[(fixnum? y)
(foreign-call "ikrt_fxbnlogxor" y x)]
[(bignum? y)
(foreign-call "ikrt_bnbnlogxor" x y)]
[else
(die 'bitwise-xor "not an exact integer" y)])]
[else (die 'bitwise-xor "not an exact integer" x)])))
(define binary-
(lambda (x y)
@ -705,6 +748,44 @@
[(null? e*) ac]
[else (f (binary-bitwise-and ac (car e*)) (cdr e*))]))]))
(define bitwise-ior
(case-lambda
[(x y) (binary-bitwise-ior x y)]
[(x y z) (binary-bitwise-ior (binary-bitwise-ior x y) z)]
[(a)
(cond
[(fixnum? a) a]
[(bignum? a) a]
[else (die 'bitwise-ior "not a number" a)])]
[() 0]
[(a b c d . e*)
(let f ([ac (binary-bitwise-ior a
(binary-bitwise-ior b
(binary-bitwise-ior c d)))]
[e* e*])
(cond
[(null? e*) ac]
[else (f (binary-bitwise-ior ac (car e*)) (cdr e*))]))]))
(define bitwise-xor
(case-lambda
[(x y) (binary-bitwise-xor x y)]
[(x y z) (binary-bitwise-xor (binary-bitwise-xor x y) z)]
[(a)
(cond
[(fixnum? a) a]
[(bignum? a) a]
[else (die 'bitwise-xor "not a number" a)])]
[() 0]
[(a b c d . e*)
(let f ([ac (binary-bitwise-xor a
(binary-bitwise-xor b
(binary-bitwise-xor c d)))]
[e* e*])
(cond
[(null? e*) ac]
[else (f (binary-bitwise-xor ac (car e*)) (cdr e*))]))]))
(define (bitwise-not x)
(cond
[(fixnum? x) ($fxlognot x)]

View File

@ -1 +1 @@
1478
1479

View File

@ -17,6 +17,7 @@
(import (ikarus)
(tests bitwise-op)
(tests reader)
(tests lists)
(tests bytevectors)
@ -51,6 +52,8 @@
(f 0 536870911000 536870911)
(printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
(test-bitwise-op)
(test-parse-flonums)
(test-case-folding)
(test-reader)

View File

@ -0,0 +1,85 @@
(library (tests bitwise-op)
(export test-bitwise-op)
(import (ikarus) (tests framework))
(define (test-base-case op i0 i1 r)
(assert (= (op i0 i1) r)))
(define (test-base-cases)
(test-base-case bitwise-and 0 0 0)
(test-base-case bitwise-and 0 1 0)
(test-base-case bitwise-and 1 0 0)
(test-base-case bitwise-and 1 1 1)
(test-base-case bitwise-ior 0 0 0)
(test-base-case bitwise-ior 0 1 1)
(test-base-case bitwise-ior 1 0 1)
(test-base-case bitwise-ior 1 1 1)
(test-base-case bitwise-xor 0 0 0)
(test-base-case bitwise-xor 0 1 1)
(test-base-case bitwise-xor 1 0 1)
(test-base-case bitwise-xor 1 1 0))
(define (generate-numbers)
(define N 68)
(define (n* n i)
(if (zero? i)
'()
(cons n (n* (bitwise-arithmetic-shift-left n 1) (- i 1)))))
(append
(n* 1 N)
(n* -1 N)
(map sub1 (n* 1 N))
(map sub1 (n* -1 N))
(map add1 (n* 1 N))
(map add1 (n* -1 N))))
(define (one-bit n)
(if (even? n) 0 1))
(define (unit? n)
(or (= n 0) (= n -1)))
(define (trusted op n1 n2)
(if (and (unit? n1) (unit? n2))
(op n1 n2)
(+ (one-bit (op (one-bit n1) (one-bit n2)))
(bitwise-arithmetic-shift-left
(trusted op
(bitwise-arithmetic-shift-right n1 1)
(bitwise-arithmetic-shift-right n2 1))
1))))
(define (test-case op)
(define ls (generate-numbers))
(define id 0)
(for-each
(lambda (n1)
(for-each
(lambda (n2)
(let ([r0 (op n1 n2)]
[r1 (trusted op n1 n2)])
(unless (= r0 r1)
(printf "id=~s ~x ~x ~x ~x\n" id n1 n2 r0 r1)
(error 'test-bitwise-op
"mismatch/op/a0/a1/got/expected" op n1 n2 r0 r1))
(set! id (+ id 1))))
ls))
ls))
(define (test-other-cases)
(test-case bitwise-and)
(test-case bitwise-ior)
;(test-case bitwise-xor)
)
(define (test-bitwise-op)
(test-base-cases)
(test-other-cases)))

View File

@ -182,7 +182,6 @@ ikrt_fxbnplus(ikptr x, ikptr y, ikpcb* pcb){
}
}
else {
//fprintf(stderr, "this case 0x%08x\n", intx);
/* positive fx + negative bn = smaller negative bn */
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
@ -1041,59 +1040,6 @@ ikrt_bnbncomp(ikptr bn1, ikptr bn2){
}
}
/* FIXME: Too complicated! */
ikptr
ikrt_fxbnlogand(ikptr x, ikptr y, ikpcb* pcb){
long int n1 = unfix(x);
ikptr fst = ref(y, -vector_tag);
if(n1 >= 0){
if(bnfst_negative(fst)){
/* y is negative */
return fix(n1 & (1+~(long int)ref(y, disp_vector_data-vector_tag)));
} else {
/* y is positive */
return fix(n1 & (long int)ref(y, disp_vector_data-vector_tag));
}
} else {
if(n1 == -1){ return y; }
if(bnfst_negative(fst)){
/* y is negative */
long int len = bnfst_limb_count(fst);
unsigned long int nn =
(1+~((1+~(long int)ref(y, disp_bignum_data - vector_tag)) & n1));
if((len == 1) && (nn <= most_negative_fixnum)){
return fix(-nn);
}
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikptr) nn;
int i;
for(i=1; i<len; i++){
ref(r, disp_bignum_data+i*wordsize) =
ref(y, disp_bignum_data-vector_tag+i*wordsize);
}
return BN(r+vector_tag);
} else {
/* y is positive */
long int len = bnfst_limb_count(fst);
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikptr)
(((long int)ref(y, disp_bignum_data - vector_tag)) & n1);
int i;
for(i=1; i<len; i++){
ref(r, disp_bignum_data+i*wordsize) =
ref(y, disp_bignum_data-vector_tag+i*wordsize);
}
return BN(r+vector_tag);
}
}
}
static inline int
count_leading_ffs(int n, mp_limb_t* x){
@ -1106,6 +1052,15 @@ count_leading_ffs(int n, mp_limb_t* x){
return n;
}
static void
copy_limbs(mp_limb_t* src, mp_limb_t* dst, int n1, int n2){
while(n1 < n2){
dst[n1] = src[n1];
n1++;
}
}
static void
bits_compliment(mp_limb_t* src, mp_limb_t* dst, int n){
mp_limb_t carry = 1;
@ -1118,6 +1073,39 @@ bits_compliment(mp_limb_t* src, mp_limb_t* dst, int n){
}
}
static void
bits_compliment2(mp_limb_t* src, mp_limb_t* dst, int n1, int n2){
mp_limb_t carry = 1;
int i;
for(i=0; i<n1; i++){
mp_limb_t d = src[i];
mp_limb_t c = carry + ~ d;
dst[i] = c;
carry = (carry && ! d);
}
for(i=n1; i<n2; i++){
mp_limb_t d = 0;
mp_limb_t c = carry + ~ d;
dst[i] = c;
carry = (carry && ! d);
}
}
static int
bits_compliment_carry(mp_limb_t* src, mp_limb_t* dst, int n1, int n2, mp_limb_t carry){
int i;
for(i=n1; i<n2; i++){
mp_limb_t d = src[i];
mp_limb_t c = carry + ~ d;
dst[i] = c;
carry = (carry && ! d);
}
return carry;
}
static void
bits_compliment_with_carry(mp_limb_t* src, mp_limb_t* dst, int n, int carry){
int i;
@ -1141,6 +1129,22 @@ bits_compliment_logand(mp_limb_t* s1, mp_limb_t* s2, mp_limb_t* dst, int n){
}
}
static int
bits_compliment_logor(mp_limb_t* s1, mp_limb_t* s2, mp_limb_t* dst, int n){
int carry = 1;
int i;
for(i=0; i<n; i++){
mp_limb_t d = s1[i];
mp_limb_t c = carry + ~ d;
dst[i] = c | s2[i];
carry = (carry && ! d);
}
return carry;
}
static int
bits_carry(mp_limb_t* s, int n){
/*
@ -1213,6 +1217,53 @@ ikrt_bnlognot(ikptr x, ikpcb* pcb){
}
ikptr
ikrt_fxbnlogand(ikptr x, ikptr y, ikpcb* pcb){
long int n1 = unfix(x);
ikptr fst = ref(y, -vector_tag);
if(n1 >= 0){
/* x is positive */
if(bnfst_negative(fst)){
/* y is negative */
return fix(n1 & (1+~(long int)ref(y, disp_vector_data-vector_tag)));
} else {
/* y is positive */
return fix(n1 & (long int)ref(y, disp_vector_data-vector_tag));
}
} else {
/* x is negative */
if(n1 == -1){ return y; }
if(bnfst_negative(fst)){
/* y is negative */
long int len = bnfst_limb_count(fst);
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + (len+1)*wordsize));
pcb->root0 = 0;
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
bits_compliment2(s2, s, len, len+1);
s[0] = s[0] & n1;
bits_compliment2(s, s, len+1, len+1);
return normalize_bignum(len+1, 1<<bignum_sign_shift, r);
} else {
/* y is positive */
long int len = bnfst_limb_count(fst);
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikptr)
(((long int)ref(y, disp_bignum_data - vector_tag)) & n1);
int i;
for(i=1; i<len; i++){
ref(r, disp_bignum_data+i*wordsize) =
ref(y, disp_bignum_data-vector_tag+i*wordsize);
}
return BN(r+vector_tag);
}
}
}
ikptr
ikrt_bnbnlogand(ikptr x, ikptr y, ikpcb* pcb){
ikptr xfst = ref(x, -vector_tag);
@ -1224,16 +1275,16 @@ ikrt_bnbnlogand(ikptr x, ikptr y, ikpcb* pcb){
if(n1 >= n2){
pcb->root0 = &x;
pcb->root1 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + n1*wordsize));
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + (n1+1)*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
mp_limb_t* s1 = (mp_limb_t*)(long)(x+disp_bignum_data-vector_tag);
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
bits_compliment(s1, s, n1);
bits_compliment2(s1, s, n1, n1+1);
bits_compliment_logand(s2, s, s, n2);
bits_compliment(s, s, n1);
return normalize_bignum(n1, 1<<bignum_sign_shift, r);
bits_compliment2(s, s, n1+1, n1+1);
return normalize_bignum(n1+1, 1<<bignum_sign_shift, r);
} else {
return ikrt_bnbnlogand(y,x,pcb);
}
@ -1252,7 +1303,12 @@ ikrt_bnbnlogand(ikptr x, ikptr y, ikpcb* pcb){
mp_limb_t* s1 = (mp_limb_t*)(long)(x+disp_bignum_data-vector_tag);
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
bits_compliment_logand(s2, s1, s, n1);
if(n1 <= n2){
bits_compliment_logand(s2, s1, s, n1);
} else {
bits_compliment_logand(s2, s1, s, n2);
copy_limbs(s1, s, n2, n1);
}
return normalize_bignum(n1, 0, r);
} else {
/* both positive */
@ -1263,7 +1319,7 @@ ikrt_bnbnlogand(ikptr x, ikptr y, ikpcb* pcb){
(long int) ref(x, disp_bignum_data-vector_tag+i*wordsize);
long int l2 =
(long int) ref(y, disp_bignum_data-vector_tag+i*wordsize);
long int last = l1 & l2;
unsigned long int last = l1 & l2;
if(last){
if((i == 0) && (last < most_positive_fixnum)){
return fix(last);
@ -1291,6 +1347,149 @@ ikrt_bnbnlogand(ikptr x, ikptr y, ikpcb* pcb){
}
ikptr
ikrt_fxbnlogor(ikptr x, ikptr y, ikpcb* pcb){
long int n1 = unfix(x);
ikptr fst = ref(y, -vector_tag);
if(n1 < 0){
/* x is negative */
if(bnfst_negative(fst)){
/* y is negative */
return fix(n1 | (1+~(long int)ref(y, disp_vector_data-vector_tag)));
} else {
/* y is positive */
return fix(n1 | (long int)ref(y, disp_vector_data-vector_tag));
}
} else {
/* x is non negative */
if(n1 == 0){ return y; }
/* x is positive */
if(bnfst_negative(fst)){
/* y is negative */
long int len = bnfst_limb_count(fst);
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + (len+1)*wordsize));
pcb->root0 = 0;
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
bits_compliment2(s2, s, len, len+1);
s[0] = s[0] | n1;
bits_compliment2(s, s, len+1, len+1);
return normalize_bignum(len+1, 1<<bignum_sign_shift, r);
} else {
/* y is positive */
long int len = bnfst_limb_count(fst);
pcb->root0 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikptr)
(((long int)ref(y, disp_bignum_data - vector_tag)) | n1);
int i;
for(i=1; i<len; i++){
ref(r, disp_bignum_data+i*wordsize) =
ref(y, disp_bignum_data-vector_tag+i*wordsize);
}
return BN(r+vector_tag);
}
}
}
ikptr
ikrt_bnbnlogor(ikptr x, ikptr y, ikpcb* pcb){
ikptr xfst = ref(x, -vector_tag);
ikptr yfst = ref(y, -vector_tag);
long int n1 = bnfst_limb_count(xfst);
long int n2 = bnfst_limb_count(yfst);
if(bnfst_negative(xfst)){
if(bnfst_negative(yfst)){
if(n1 >= n2){
pcb->root0 = &x;
pcb->root1 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + n1*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
mp_limb_t* s1 = (mp_limb_t*)(long)(x+disp_bignum_data-vector_tag);
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
bits_compliment2(s2, s, n2, n1);
int carry = bits_compliment_logor(s1, s, s, n1);
bits_compliment_carry(s,s,n1,n1,carry);
bits_compliment2(s, s, n1, n1);
return normalize_bignum(n1, 1<<bignum_sign_shift, r);
} else {
return ikrt_bnbnlogor(y,x,pcb);
}
} else {
return ikrt_bnbnlogor(y,x,pcb);
}
} else {
if(bnfst_negative(yfst)){
/* x positive, y negative */
/* the result is at most n2 words long */
pcb->root0 = &x;
pcb->root1 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + n2*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
mp_limb_t* s1 = (mp_limb_t*)(long)(x+disp_bignum_data-vector_tag);
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
if(n2 <= n1){
bits_compliment_logor(s2, s1, s, n2);
bits_compliment2(s, s, n2, n2);
} else {
int carry = bits_compliment_logor(s2, s1, s, n1);
bits_compliment_carry(s2, s, n1, n2, carry);
bits_compliment_carry(s, s, 0, n2, 1);
}
return normalize_bignum(n2, 1<<bignum_sign_shift, r);
} else {
/* both positive */
int n = (n1>n2)?n1:n2;
pcb->root0 = &x;
pcb->root1 = &y;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data+n*wordsize));
mp_limb_t* s = (mp_limb_t*)(long)(r+disp_bignum_data);
mp_limb_t* s1 = (mp_limb_t*)(long)(x+disp_bignum_data-vector_tag);
mp_limb_t* s2 = (mp_limb_t*)(long)(y+disp_bignum_data-vector_tag);
pcb->root0 = 0;
pcb->root1 = 0;
long int i;
if(n == n1){
for(i=0; i<n2; i++){
s[i] = s1[i] | s2[i];
}
for(i=n2; i<n1; i++){
s[i] = s1[i];
}
} else {
for(i=0; i<n1; i++){
s[i] = s1[i] | s2[i];
}
for(i=n1; i<n2; i++){
s[i] = s2[i];
}
}
return normalize_bignum(n, 0, r);
}
}
}
ikptr
ikrt_fxbnlogxor(ikptr x, ikptr y, ikpcb* pcb){
fprintf(stderr, "ikrt_fxbnlogxor\n");
exit(-1);
}
ikptr
ikrt_bnbnlogxor(ikptr x, ikptr y, ikpcb* pcb){
fprintf(stderr, "ikrt_bnbnlogxor\n");
exit(-1);
}
static void
copy_bits_shifting_right(mp_limb_t* src, mp_limb_t* dst, int n, int m){
mp_limb_t carry = src[0] >> m;