bitwise.scm 1.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445
  1. ; Copyright (c) 1993-2007 by Richard Kelsey and Jonathan Rees. See file COPYING.
  2. ; Bitwise operators written in vanilla Scheme.
  3. ; Written for clarity and simplicity, not for speed.
  4. ; No need to use these in Scheme 48 since Scheme 48's virtual machine
  5. ; provides fast machine-level implementations.
  6. (define (bitwise-not i)
  7. (- -1 i))
  8. (define (bitwise-and x y)
  9. (cond ((= x 0) 0)
  10. ((= x -1) y)
  11. (else
  12. (+ (* (bitwise-and (arithmetic-shift x -1)
  13. (arithmetic-shift y -1))
  14. 2)
  15. (* (modulo x 2) (modulo y 2))))))
  16. (define (bitwise-ior x y)
  17. (bitwise-not (bitwise-and (bitwise-not x)
  18. (bitwise-not y))))
  19. (define (bitwise-xor x y)
  20. (bitwise-and (bitwise-not (bitwise-and x y))
  21. (bitwise-ior x y)))
  22. (define (bitwise-eqv x y)
  23. (bitwise-not (bitwise-xor x y)))
  24. (define (arithmetic-shift n m)
  25. (floor (* n (expt 2 m))))
  26. (define (count-bits x) ; Count 1's in the positive 2's comp rep
  27. (let ((x (if (< x 0) (bitwise-not x) x)))
  28. (do ((x x (arithmetic-shift x 1))
  29. (result 0 (+ result (modulo x 2))))
  30. ((= x 0) result))))
  31. ;(define (integer-length integer) ...) ;?