diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt index d2800ca..6345995 100644 Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index 3df5830..214b725 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -590,20 +590,37 @@ (define binary-bitwise-xor (lambda (x y) + (define (fxbn x y) + (let ([y0 (bitwise-and y (greatest-fixnum))] + [y1 (bitwise-arithmetic-shift-right y (- (fixnum-width) 1))]) + (bitwise-ior + ($fxlogand ($fxlogxor x y0) (greatest-fixnum)) + (bitwise-arithmetic-shift-left + (bitwise-arithmetic-shift-right + (if ($fx>= x 0) y (bitwise-not y)) + (- (fixnum-width) 1)) + (- (fixnum-width) 1))))) + (define (bnbn x y) + (let ([x0 (bitwise-and x (greatest-fixnum))] + [x1 (bitwise-arithmetic-shift-right x (- (fixnum-width) 1))] + [y0 (bitwise-and y (greatest-fixnum))] + [y1 (bitwise-arithmetic-shift-right y (- (fixnum-width) 1))]) + (bitwise-ior + ($fxlogand ($fxlogxor x0 y0) (greatest-fixnum)) + (bitwise-arithmetic-shift-left + (binary-bitwise-xor x1 y1) + (- (fixnum-width) 1))))) (cond [(fixnum? x) (cond [(fixnum? y) ($fxlogxor x y)] - [(bignum? y) - (foreign-call "ikrt_fxbnlogxor" x y)] + [(bignum? y) (fxbn 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)] + [(fixnum? y) (fxbn y x)] + [(bignum? y) (bnbn x y)] [else (die 'bitwise-xor "not an exact integer" y)])] [else (die 'bitwise-xor "not an exact integer" x)]))) diff --git a/scheme/last-revision b/scheme/last-revision index 09d2f32..1c61ae4 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1479 +1480 diff --git a/scheme/tests/bitwise-op.ss b/scheme/tests/bitwise-op.ss index a47c777..7344164 100644 --- a/scheme/tests/bitwise-op.ss +++ b/scheme/tests/bitwise-op.ss @@ -74,7 +74,7 @@ (define (test-other-cases) (test-case bitwise-and) (test-case bitwise-ior) - ;(test-case bitwise-xor) + (test-case bitwise-xor) ) diff --git a/src/ikarus-numerics.c b/src/ikarus-numerics.c index 614cf0f..a0e95ed 100644 --- a/src/ikarus-numerics.c +++ b/src/ikarus-numerics.c @@ -1476,20 +1476,6 @@ ikrt_bnbnlogor(ikptr x, ikptr y, ikpcb* pcb){ } } - -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;