(= (double-float-high-bits x) (double-float-high-bits y))))
\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 (lvar-dest result)))
- (unless (and (combination-p dest)
- (eq (lvar-fun-name (combination-fun dest))
- 'logand))
- (give-up-ir1-transform))
- (unless (some (lambda (arg)
- (csubtypep (lvar-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)))
-
+;;;; modular functions
(define-good-modular-fun logand)
(define-good-modular-fun logior)
+;;; FIXME: XOR? ANDC1, ANDC2? -- CSR, 2003-09-16
+
+#!-alpha
+(progn
+ (defknown sb!vm::ash-left-mod32 (integer (integer 0)) (unsigned-byte 32)
+ (foldable flushable movable))
+ (define-modular-fun-optimizer ash ((integer count) :width width)
+ (when (and (<= width 32)
+ (constant-lvar-p count) ; ?
+ (plusp (lvar-value count)))
+ (cut-to-width integer width)
+ 'sb!vm::ash-left-mod32)))
+#!+alpha
+(progn
+ (defknown sb!vm::ash-left-mod64 (integer (integer 0)) (unsigned-byte 64)
+ (foldable flushable movable))
+ (define-modular-fun-optimizer ash ((integer count) :width width)
+ (when (and (<= width 64)
+ (constant-lvar-p count) ; ?
+ (plusp (lvar-value count)))
+ (cut-to-width integer width)
+ 'sb!vm::ash-left-mod64)))
+
\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
(declare (type (unsigned-byte 32) num))
(let ((adds 0) (shifts 0)
(result nil) first-one)
- (labels ((tub32 (x) `(truly-the (unsigned-byte 32) ,x))
- (add (next-factor)
+ (labels ((add (next-factor)
(setf result
- (tub32
- (if result
- (progn (incf adds) `(+ ,result ,(tub32 next-factor)))
- next-factor)))))
+ (if result
+ (progn (incf adds) `(+ ,result ,next-factor))
+ next-factor))))
(declare (inline add))
(dotimes (bitpos 32)
(if first-one
(progn
(incf adds)
(incf shifts 2)
- `(- ,(tub32 `(ash ,arg ,bitpos))
- ,(tub32 `(ash ,arg ,first-one))))))
+ `(- (ash ,arg ,bitpos)
+ (ash ,arg ,first-one)))))
(setf first-one nil))
(when (logbitp bitpos num)
(setf first-one bitpos))))
(t
(incf shifts 2)
(incf adds)
- (add `(- ,(tub32 `(ash ,arg 31))
- ,(tub32 `(ash ,arg ,first-one))))))
+ (add `(- (ash ,arg 31)
+ (ash ,arg ,first-one)))))
(incf shifts)
(add `(ash ,arg 31))))
- (values result adds shifts)))
+ (values (if (plusp adds)
+ `(logand ,result #.(1- (ash 1 32))) ; using modular arithmetic
+ result)
+ adds
+ shifts)))