Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +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

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

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

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

@ -151,4 +151,38 @@
(test #b101010101
(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))))