(library (rnrs arithmetic bitwise (6)) (export bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-if bitwise-bit-count bitwise-length bitwise-first-bit-set bitwise-bit-set? bitwise-copy-bit bitwise-bit-field bitwise-copy-bit-field bitwise-rotate-bit-field bitwise-reverse-bit-field bitwise-arithmetic-shift-left bitwise-arithmetic-shift-right (rename (bitwise-arithmetic-shift-left bitwise-arithmetic-shift))) (import (rnrs base) (rnrs r5rs) (rnrs control) (only (core primitives) bitwise-arithmetic-shift-left bitwise-and bitwise-not bitwise-ior bitwise-xor bitwise-length)) (define (bitwise-if ei1 ei2 ei3) (bitwise-ior (bitwise-and ei1 ei2) (bitwise-and (bitwise-not ei1) ei3))) (define (bitwise-bit-count ei) (bitwise-not (bitwise-bit-count (bitwise-not ei)))) (define (bitwise-first-bit-set n) (+ -1 (bitwise-length (bitwise-and n (- n))))) (define (bitwise-bit-set? n1 n2) (not (zero? (bitwise-and n1 n2)))) (define (bitwise-copy-bit ei1 ei2 ei3) (let* ((mask (bitwise-arithmetic-shift-left 1 ei2))) (bitwise-if mask (bitwise-arithmetic-shift-left ei3 ei2) ei1))) (define (bitwise-bit-field ei1 ei2 ei3) (let ((mask (bitwise-not (bitwise-arithmetic-shift-left -1 ei3)))) (bitwise-arithmetic-shift-right (bitwise-and ei1 mask) ei2))) (define (bitwise-copy-bit-field ei1 ei2 ei3 ei4) (let* ((to ei1) (start ei2) (end ei3) (from ei4) (mask1 (bitwise-arithmetic-shift-left -1 start)) (mask2 (bitwise-not (bitwise-arithmetic-shift-left -1 end))) (mask (bitwise-and mask1 mask2))) (bitwise-if mask (bitwise-arithmetic-shift-left from start) to))) (define (bitwise-rotate-bit-field ei1 ei2 ei3 ei4) (let* ((n ei1) (start ei2) (end ei3) (count ei4) (width (- end start))) (if (positive? width) (let* ((count (mod count width)) (field0 (bitwise-bit-field n start end)) (field1 (bitwise-arithmetic-shift-left field0 count)) (field2 (bitwise-arithmetic-shift-right field0 (- width count))) (field (bitwise-ior field1 field2))) (bitwise-copy-bit-field n start end field)) n))) (define bitwise-reverse-bit-field (let ((bit-reverse (lambda (k n) (do ((m (if (negative? n) (bitwise-not n) n) (bitwise-arithmetic-shift-left m -1)) (k (+ -1 k) (+ -1 k)) (rvs 0 (bitwise-ior (bitwise-arithmetic-shift-left rvs 1) (bitwise-and 1 m)))) ((negative? k) (if (negative? n) (bitwise-not rvs) rvs)))))) (lambda (ei1 ei2 ei3) (let ((width (- ei3 ei2))) (let ((mask (bitwise-not (bitwise-arithmetic-shift-left -1 width)))) (let ((zn (bitwise-and mask (bitwise-arithmetic-shift-left ei1 (- ei2))))) (bitwise-ior (bitwise-arithmetic-shift-left (bit-reverse width zn) ei2) (bitwise-and (bitwise-not (bitwise-arithmetic-shift-left mask ei2)) ei1)))))))) (define (bitwise-arithmetic-shift-right ei1 ei2) (bitwise-arithmetic-shift-left ei1 (- ei2))) )