private/src/bitfield32.ss
(define too-big32 (expt 2 32))

(define negative-one32 (sub1 too-big32))

(define uncomplement32
  (lambda (a)
    (if (negative?32 a) (- (negate32 a)) a)))

(define complement32
  (lambda (a)
    (if (negative? a) (negate32 (- a)) a)))

(define shear32 (lambda (a) (remainder a too-big32)))

(define and32
  (let ((too-big16 (expt 2 16)))
    (lambda (a b)
      (+ (* (fxlogand (quotient a too-big16) (quotient b too-big16))
	   too-big16)
	(fxlogand (remainder a too-big16) (remainder b too-big16))))))

(define or32
  (let ((too-big16 (expt 2 16)))
    (lambda (a b)
      (+ (* (fxlogor (quotient a too-big16) (quotient b too-big16))
	   too-big16)
	(fxlogor (remainder a too-big16) (remainder b too-big16))))))

(define not32 (lambda (a) (- negative-one32 a)))

(define sll32 (lambda (a n) (shear32 (* a (expt 2 n)))))

(define srl32 (lambda (a n) (quotient a (expt 2 n))))

(define sra32 (lambda (a n)
	       (if (negative?32 a)
		   (negate32 (srl32 (negate32 a) n))
		   (srl32 a n))))

(define negate32 (lambda (a) (shear32 (add1 (not32 a)))))

(define negative?32
  (lambda (a) (not (zero? (srl32 a 31)))))

(define add32 (lambda (a b) (shear32 (+ a b))))

(define sub32 (lambda (a b) (add32 a (negate32 b))))

(define less-than32
  (lambda (a b)
    (if (negative?32 a)
	(or (not (negative?32 b)) (< b a))
	(and (not (negative?32 b)) (< a b)))))

(define times32
  (lambda (a b)
    (shear32 (* a b))))

(define quotient32
  (lambda (a b)
    (shear32 (complement32
	      (quotient (uncomplement32 a)
		(uncomplement32 b))))))