Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

SRFI 151 fixes: bitwise-if arg order swapped from SRFI 33; bit-set? on negative integers should extend infinite 1s; bit-field-every? should compare only bits within mask

Browse source
This commit is contained in:
Alex Shinn 2020-01-31 23:12:20 +08:00
parent a88a1ad244
commit 708f57ffed
3 changed files with 28 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lib/srfi/151/bit.c
View file

@ -398,13 +398,15 @@ sexp sexp_bit_set_p (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp x) {
return sexp_xtype_exception(ctx, self, "index must be non-negative", i); return sexp_xtype_exception(ctx, self, "index must be non-negative", i);
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
return sexp_make_boolean((pos < sizeof(sexp_uint_t)*CHAR_BIT) return sexp_make_boolean((pos < sizeof(sexp_uint_t)*CHAR_BIT)
&& (sexp_unbox_fixnum(x) & ((sexp_uint_t)1<<pos))); ? (sexp_unbox_fixnum(x) & ((sexp_uint_t)1<<pos))
: sexp_unbox_fixnum(x) < 0);
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
pos /= (sizeof(sexp_uint_t)*CHAR_BIT); pos /= (sizeof(sexp_uint_t)*CHAR_BIT);
rem = (sexp_unbox_fixnum(i) - pos*sizeof(sexp_uint_t)*CHAR_BIT); rem = (sexp_unbox_fixnum(i) - pos*sizeof(sexp_uint_t)*CHAR_BIT);
return sexp_make_boolean((pos < (sexp_sint_t)sexp_bignum_length(x)) return sexp_make_boolean((pos < (sexp_sint_t)sexp_bignum_length(x))
&& (sexp_bignum_data(x)[pos] & ((sexp_uint_t)1<<rem))); ? (sexp_bignum_data(x)[pos] & ((sexp_uint_t)1<<rem))
: sexp_bignum_sign(x) < 0);
#endif #endif
} else { } else {
return sexp_type_exception(ctx, self, SEXP_FIXNUM, x); return sexp_type_exception(ctx, self, SEXP_FIXNUM, x);

16
lib/srfi/151/bitwise.scm
View file

@ -45,16 +45,20 @@
(arithmetic-shift (mask (- end start)) start)) (arithmetic-shift (mask (- end start)) start))
(define (bitwise-if mask m n) (define (bitwise-if mask m n)
(bit-ior (bit-and mask n) (bit-and (bitwise-not mask) m))) (bit-ior (bit-and mask m)
(bit-and (bitwise-not mask) n)))
(define (bit-field n start end) (define (bit-field n start end)
(bit-and (arithmetic-shift n (- start)) (mask (- end start)))) (bit-and (arithmetic-shift n (- start)) (mask (- end start))))
(define (bit-field-any? n start end) (define (bit-field-any? n start end)
(not (zero? (bit-and (arithmetic-shift n (- start)) (mask (- end start)))))) (not (zero? (bit-and (arithmetic-shift n (- start))
(mask (- end start))))))
(define (bit-field-every? n start end) (define (bit-field-every? n start end)
(= (arithmetic-shift n (- start)) (mask (- end start)))) (let ((lo (mask (- end start))))
(= (bit-and lo (arithmetic-shift n (- start)))
lo)))
(define (copy-bit index i boolean) (define (copy-bit index i boolean)
(bit-field-replace i (if boolean 1 0) index (+ index 1))) (bit-field-replace i (if boolean 1 0) index (+ index 1)))
@ -74,7 +78,7 @@
(bit-field-replace-same dst (arithmetic-shift src start) start end)) (bit-field-replace-same dst (arithmetic-shift src start) start end))
(define (bit-field-replace-same dst src start end) (define (bit-field-replace-same dst src start end)
(bitwise-if (range start end) dst src)) (bitwise-if (range start end) src dst))
(define (bit-field-rotate n count start end) (define (bit-field-rotate n count start end)
(let* ((width (- end start)) (let* ((width (- end start))
@ -98,10 +102,10 @@
(define (bit-field-reverse i start end) (define (bit-field-reverse i start end)
(bitwise-if (range start end) (bitwise-if (range start end)
i
(arithmetic-shift (bit-reverse (bit-field i start end) (arithmetic-shift (bit-reverse (bit-field i start end)
(- end start)) (- end start))
start))) start)
i))
(define (vector->bits vec) (define (vector->bits vec)
(let ((len (vector-length vec))) (let ((len (vector-length vec)))

16
lib/srfi/151/test.sld
View file

@ -101,14 +101,19 @@
(test-not (bit-set? 64 1)) (test-not (bit-set? 64 1))
(test-assert (bit-set? 64 #x10000000000000000)) (test-assert (bit-set? 64 #x10000000000000000))
(test-assert (bit-set? 1000000 -1))
(test-assert (bit-set? 1000 -1))
(test #b1010 (bit-field #b1101101010 0 4)) (test #b1010 (bit-field #b1101101010 0 4))
(test #b101101 (bit-field #b1101101010 3 9)) (test #b101101 (bit-field #b1101101010 3 9))
(test #b10110 (bit-field #b1101101010 4 9)) (test #b10110 (bit-field #b1101101010 4 9))
(test #b110110 (bit-field #b1101101010 4 10)) (test #b110110 (bit-field #b1101101010 4 10))
(test 3 (bitwise-if 1 2 1)) (test 0 (bitwise-if 1 2 1))
(test #b00110011 (bitwise-if #b00111100 #b00001111 #b11110000)) (test 3 (bitwise-if 1 1 2))
(test 9 (bitwise-if 3 1 8))
(test 0 (bitwise-if 3 8 1))
(test #b00110011 (bitwise-if #b00111100 #b11110000 #b00001111))
(test #b1 (copy-bit 0 0 #t)) (test #b1 (copy-bit 0 0 #t))
(test #b100 (copy-bit 2 0 #t)) (test #b100 (copy-bit 2 0 #t))
@ -185,4 +190,11 @@
(bit-field-reverse -2 0 32)) (bit-field-reverse -2 0 32))
(test 5 (bit-field-reverse #x140000000000000000000000000000000 0 129)) (test 5 (bit-field-reverse #x140000000000000000000000000000000 0 129))
(test-assert (bit-field-any? #b1001001 1 6))
(test-not (bit-field-any? #b1000001 1 6))
(test-assert (bit-field-every? 45 2 4))
(test-assert (bit-field-every? 45 0 1))
(test-assert (bit-field-every? #b1011110 1 5))
(test-not (bit-field-every? #b1011010 1 5))
(test-end)))) (test-end))))