-;;;; 32-bit operations
-#!-(or ppc 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)))
+;;;; modular functions
+(define-good-modular-fun logand :unsigned)
+(define-good-modular-fun logior :unsigned)
+;;; FIXME: XOR? ANDC1, ANDC2? -- CSR, 2003-09-16
+
+(macrolet
+ ((def (name class width)
+ (let ((type (ecase class
+ (:unsigned 'unsigned-byte)
+ (:signed 'signed-byte))))
+ `(progn
+ (defknown ,name (integer (integer 0)) (,type ,width)
+ (foldable flushable movable))
+ (define-modular-fun-optimizer ash ((integer count) ,class :width width)
+ (when (and (<= width ,width)
+ (or (and (constant-lvar-p count)
+ (plusp (lvar-value count)))
+ (csubtypep (lvar-type count)
+ (specifier-type '(and unsigned-byte fixnum)))))
+ (cut-to-width integer ,class width)
+ ',name))
+ (setf (gethash ',name (modular-class-versions (find-modular-class ',class)))
+ `(ash ,',width))))))
+ ;; This should really be dependent on SB!VM:N-WORD-BITS, but since we
+ ;; don't have a true Alpha64 port yet, we'll have to stick to
+ ;; SB!VM:N-MACHINE-WORD-BITS for the time being. --njf, 2004-08-14
+ #!+#.(cl:if (cl:= 32 sb!vm:n-machine-word-bits) '(and) '(or))
+ (progn
+ #!+x86 (def sb!vm::ash-left-smod30 :signed 30)
+ (def sb!vm::ash-left-mod32 :unsigned 32))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-machine-word-bits) '(and) '(or))
+ (progn
+ #!+x86-64 (def sb!vm::ash-left-smod61 :signed 61)
+ (def sb!vm::ash-left-mod64 :unsigned 64)))
+
+\f
+;;;; word-wise logical operations
+
+;;; These transforms assume the presence of modular arithmetic to
+;;; generate efficient code.
+
+(define-source-transform word-logical-not (x)
+ `(logand (lognot (the sb!vm:word ,x)) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-and ((x y))
+ '(logand x y))
+
+(deftransform word-logical-nand ((x y))
+ '(logand (lognand x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-or ((x y))
+ '(logior x y))
+
+(deftransform word-logical-nor ((x y))
+ '(logand (lognor x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-xor ((x y))
+ '(logxor x y))
+
+(deftransform word-logical-eqv ((x y))
+ '(logand (logeqv x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-orc1 ((x y))
+ '(logand (logorc1 x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-orc2 ((x y))
+ '(logand (logorc2 x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-andc1 ((x y))
+ '(logand (logandc1 x y) #.(1- (ash 1 sb!vm:n-word-bits))))
+
+(deftransform word-logical-andc2 ((x y))
+ '(logand (logandc2 x y) #.(1- (ash 1 sb!vm:n-word-bits))))