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

* Added bitwise-not.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-08 20:57:11 -05:00
parent 6e6c9c9c1b
commit 62c0643c19
4 changed files with 87 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
scheme/ikarus.numerics.ss
View File

@ -325,8 +325,9 @@
(library (ikarus generic-arithmetic)
(export + - * / zero? = < <= > >= add1 sub1 quotient remainder
modulo even? odd? logand bitwise-and
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift
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
quotient+remainder number->string string->number min max
abs truncate fltruncate sra sll
@ -344,8 +345,9 @@
(only (ikarus flonums) $flonum->exact $flzero? $flnegative?)
(except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
remainder modulo even? odd? quotient+remainder number->string
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift
positive? negative? bitwise-and logand
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift
positive? negative? bitwise-and bitwise-not
string->number expt gcd lcm numerator denominator
exact->inexact inexact floor ceiling round log
exact-integer-sqrt min max abs
@ -770,14 +772,19 @@
[else (error 'bitwise-and "not a number" a)])]
[() -1]
[(a b c d . e*)
(let f ([ac (binary-bitwise-and
(binary-bitwise-and
(binary-bitwise-and a b) c) d)]
(let f ([ac (binary-bitwise-and a
(binary-bitwise-and b
(binary-bitwise-and c d)))]
[e* e*])
(cond
[(null? e*) ac]
[else (f (binary-bitwise-and ac (car e*)) (cdr e*))]))]))
(define logand bitwise-and)
(define (bitwise-not x)
(cond
[(fixnum? x) ($fxlognot x)]
[(bignum? x) (foreign-call "ikrt_bnlognot" x)]
[else (error 'bitwise-not "invalid argument" x)]))
(define -
(case-lambda

2
scheme/makefile.ss
View File

@ -746,7 +746,7 @@
[bitwise-arithmetic-shift i r bw]
[bitwise-arithmetic-shift-left i r bw]
[bitwise-arithmetic-shift-right i r bw]
[bitwise-not r bw]
[bitwise-not i r bw]
[bitwise-and i r bw]
[bitwise-ior r bw]
[bitwise-xor r bw]

29
scheme/tests/bignums.ss
View File

@ -108,6 +108,35 @@
(modulo -536870912238479837489374 3248732398479823749283)]
[(lambda (x) (= x -830066489308918857679))
(modulo -536870912238479837489374 -3248732398479823749283)]
[(lambda (x) (= x -13)) (bitwise-not 12)]
[(lambda (x) (= x 11)) (bitwise-not -12)]
[(lambda (x) (= x 0)) (bitwise-not -1)]
[(lambda (x) (= x -1)) (bitwise-not 0)]
[(lambda (x) (= x (least-fixnum))) (bitwise-not (greatest-fixnum))]
[(lambda (x) (= x (greatest-fixnum))) (bitwise-not (least-fixnum))]
[(lambda (x) (= x -38947389478348937489375))
(bitwise-not 38947389478348937489374)]
[(lambda (x) (= x -22300745198530623141535718272648361505980416))
(bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)]
[(lambda (x) (= x 38947389478348937489374))
(bitwise-not -38947389478348937489375)]
[(lambda (x) (= x 22300745198530623141535718272648361505980414))
(bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)]
[(lambda (x) (= x -340282366920938463463374607431768211456))
(bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)]
[(lambda (x) (= x 340282366920938463463374607431768211454))
(bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)]
[(lambda (x) (= x -79228162514264337593543950337))
(bitwise-not #x1000000000000000000000000)]
[(lambda (x) (= x 79228162514264337593543950335))
(bitwise-not #x-1000000000000000000000000)]
))

42
src/ikarus-numerics.c
View File

@ -1086,6 +1086,48 @@ bits_carry(unsigned int* s, int n){
return 1;
}
ikp
ikrt_bnlognot(ikp x, ikpcb* pcb){
ikp fst = ref(x, -vector_tag);
int n = ((unsigned int)fst) >> bignum_length_shift;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
if(bignum_sign_mask & (unsigned int) fst){
/* negative */
ikp r = ik_alloc(pcb, align(disp_bignum_data + n*wordsize));
unsigned int* rd = (unsigned int*)(r+disp_bignum_data);
int i;
for(i=0; (i<n) && (s1[i] == 0); i++) {
rd[i] = -1;
}
rd[i] = s1[i] - 1;
for(i++; i<n; i++){
rd[i] = s1[i];
}
return normalize_bignum(n, 0, r);
} else {
/* positive */
int i;
for(i=0; (i<n) && (s1[i] == -1); i++) {/*nothing*/}
if(i==n){
ikp r = ik_alloc(pcb, align(disp_bignum_data + (n+1)*wordsize));
bzero(r+disp_bignum_data, n*wordsize);
((unsigned int*)(r+disp_bignum_data))[n] = 1;
ref(r, 0) = (ikp)
(bignum_tag | (1<<bignum_sign_shift) | ((n+1) << bignum_length_shift));
return r+vector_tag;
} else {
ikp r = ik_alloc(pcb, align(disp_bignum_data + n*wordsize));
unsigned int* rd = (unsigned int*)(r+disp_bignum_data);
int j;
for(j=0; j<i; j++){ rd[j] = 0; }
rd[i] = s1[i] + 1;
for(j=i+1; j<n; j++){ rd[j] = s1[j]; }
ref(r, 0) = (ikp)
(bignum_tag | (1<<bignum_sign_shift) | (n << bignum_length_shift));
return r+vector_tag;
}
}
}
ikp