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

fixing bit-field-rotate/reverse

Browse source
This commit is contained in:
Alex Shinn 2017-05-27 22:49:14 +09:00
parent e0fe160f46
commit 9a21154041
2 changed files with 56 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
lib/srfi/142/bitwise.scm
View file

@ -76,30 +76,32 @@
(define (bit-field-replace-same dst src start end) (define (bit-field-replace-same dst src start end)
(bitwise-if (range start end) src dst)) (bitwise-if (range start end) src dst))
(define (bit-rotate i count) (define (bit-field-rotate n count start end)
(let ((len (integer-length i))) (let* ((width (- end start))
(bit-ior (bit-and (arithmetic-shift i count) (mask len)) (count (modulo count width))
(arithmetic-shift i (- count len))))) (mask (bitwise-not (arithmetic-shift -1 width)))
(n^ (bitwise-and mask (arithmetic-shift n (- start)))))
(bit-ior (arithmetic-shift
(bit-ior (bit-and mask (arithmetic-shift n^ count))
(arithmetic-shift n^ (- count width)))
start)
(bit-and (bitwise-not (arithmetic-shift mask start)) n))))
(define (bit-field-rotate i count start end) (define (bit-reverse n len)
(bitwise-if (range start end) (let lp ((n n) (i 1) (res 0))
i (if (> i len)
(arithmetic-shift (bit-rotate (bit-field i start end) count)
start)))
(define (bit-reverse i)
(let ((len (integer-length i)))
(let lp ((i i) (res 0))
(if (zero? i)
res res
(lp (arithmetic-shift i -1) (lp (arithmetic-shift n -1)
(+ i 1)
(bit-ior (arithmetic-shift res 1) (bit-ior (arithmetic-shift res 1)
(bit-and i 1))))))) (bit-and n 1))))))
(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)) start))) (- end start))
start)
i))
(define (vector->integer vec) (define (vector->integer vec)
(let ((len (vector-length vec))) (let ((len (vector-length vec)))

34
lib/srfi/142/test.sld
View file

@ -151,4 +151,38 @@
(test #b101010101 (test #b101010101
(bitwise-unfold (lambda (i) (= i 10)) even? (lambda (i) (+ i 1)) 0)) (bitwise-unfold (lambda (i) (= i 10)) even? (lambda (i) (+ i 1)) 0))
(test #b110 (bit-field-rotate #b110 1 1 2))
(test #b1010 (bit-field-rotate #b110 1 2 4))
(test #b1011 (bit-field-rotate #b0111 -1 1 4))
(test #b0 (bit-field-rotate #b0 128 0 256))
(test #b1 (bit-field-rotate #b1 128 1 256))
(test #x100000000000000000000000000000000
(bit-field-rotate #x100000000000000000000000000000000 128 0 64))
(test #x100000000000000000000000000000008
(bit-field-rotate #x100000000000000000000000000000001 3 0 64))
(test #x100000000000000002000000000000000
(bit-field-rotate #x100000000000000000000000000000001 -3 0 64))
(test #b110 (bit-field-rotate #b110 0 0 10))
(test #b110 (bit-field-rotate #b110 0 0 256))
(test 1 (bit-field-rotate #x100000000000000000000000000000000 1 0 129))
(test 6 (bit-field-reverse 6 1 3))
(test 12 (bit-field-reverse 6 1 4))
(test #x80000000 (bit-field-reverse 1 0 32))
(test #x40000000 (bit-field-reverse 1 0 31))
(test #x20000000 (bit-field-reverse 1 0 30))
(test (bitwise-ior (arithmetic-shift -1 32) #xFBFFFFFF)
(bit-field-reverse -2 0 27))
(test (bitwise-ior (arithmetic-shift -1 32) #xF7FFFFFF)
(bit-field-reverse -2 0 28))
(test (bitwise-ior (arithmetic-shift -1 32) #xEFFFFFFF)
(bit-field-reverse -2 0 29))
(test (bitwise-ior (arithmetic-shift -1 32) #xDFFFFFFF)
(bit-field-reverse -2 0 30))
(test (bitwise-ior (arithmetic-shift -1 32) #xBFFFFFFF)
(bit-field-reverse -2 0 31))
(test (bitwise-ior (arithmetic-shift -1 32) #x7FFFFFFF)
(bit-field-reverse -2 0 32))
(test 5 (bit-field-reverse #x140000000000000000000000000000000 0 129))
(test-end)))) (test-end))))