lib/rnrs/arithmetic/bitwise.ss
(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)))

)