+\f
+;;;; 32-bit operations
+#!-x86 ; on X86 it is a modular function
+(deftransform lognot ((x) ((unsigned-byte 32)) *
+ :node node
+ :result result)
+ "32-bit implementation"
+ (let ((dest (continuation-dest result)))
+ (unless (and (combination-p dest)
+ (eq (continuation-fun-name (combination-fun dest))
+ 'logand))
+ (give-up-ir1-transform))
+ (unless (some (lambda (arg)
+ (csubtypep (continuation-type arg)
+ (specifier-type '(unsigned-byte 32))))
+ (combination-args dest))
+ (give-up-ir1-transform))
+ (setf (node-derived-type node)
+ (values-specifier-type '(values (unsigned-byte 32) &optional)))
+ '(32bit-logical-not x)))
+
+(define-good-modular-fun logand)
+(define-good-modular-fun logior)
+\f
+;;; There are two different ways the multiplier can be recoded. The
+;;; more obvious is to shift X by the correct amount for each bit set
+;;; in Y and to sum the results. But if there is a string of bits that
+;;; are all set, you can add X shifted by one more then the bit
+;;; position of the first set bit and subtract X shifted by the bit
+;;; position of the last set bit. We can't use this second method when
+;;; the high order bit is bit 31 because shifting by 32 doesn't work
+;;; too well.
+(defun ub32-strength-reduce-constant-multiply (arg num)
+ (declare (type (unsigned-byte 32) numb))
+ (let ((adds 0) (shifts 0)
+ (result nil) first-one)
+ (labels ((tub32 (x) `(truly-the (unsigned-byte 32) ,x))
+ (add (next-factor)
+ (setf result
+ (tub32
+ (if result
+ (progn (incf adds) `(+ ,result ,(tub32 next-factor)))
+ next-factor)))))
+ (declare (inline add))
+ (dotimes (bitpos 32)
+ (if first-one
+ (when (not (logbitp bitpos num))
+ (add (if (= (1+ first-one) bitpos)
+ ;; There is only a single bit in the string.
+ (progn (incf shifts) `(ash ,arg ,first-one))
+ ;; There are at least two.
+ (progn
+ (incf adds)
+ (incf shifts 2)
+ `(- ,(tub32 `(ash ,arg ,bitpos))
+ ,(tub32 `(ash ,arg ,first-one))))))
+ (setf first-one nil))
+ (when (logbitp bitpos num)
+ (setf first-one bitpos))))
+ (when first-one
+ (cond ((= first-one 31))
+ ((= first-one 30) (incf shifts) (add `(ash ,arg 30)))
+ (t
+ (incf shifts 2)
+ (incf adds)
+ (add `(- ,(tub32 `(ash ,arg 31))
+ ,(tub32 `(ash ,arg ,first-one))))))
+ (incf shifts)
+ (add `(ash ,arg 31))))
+ (values result adds shifts)))