X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=ade76894452a3f916a0ae8dd25f7fc6d008b2467;hb=a4c3562138e342465826de31fb8c324ae8a4b594;hp=5e56a9929159d50213b8b1500686f45349175541;hpb=3a13d7769e03b21e81573e9d8f17c672961ef5e8;p=sbcl.git

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 5e56a99..ade7689 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -176,9 +176,16 @@
 		  (:translate ,translate)
 		  (:generator ,untagged-penalty
 		  (move r x)
-		  (inst ,op r y))))))
-
-  ;;(define-binop + 4 add)
+		  ,(if (eq translate 'logand)
+		       ;; for the -C/UNSIGNED=>UNSIGNED VOP, this case
+		       ;; is optimized away as an identity somewhere
+		       ;; along the lines.  However, this VOP is used in
+		       ;; -C/SIGNED=>UNSIGNED, below, when the
+		       ;; higher-level lisp code can't optimize away the
+		       ;; non-trivial identity.
+		       `(unless (= y #.(1- (ash 1 n-word-bits)))
+			  (inst ,op r y))
+		       `(inst ,op r y)))))))
   (define-binop - 4 sub)
   (define-binop logand 2 and)
   (define-binop logior 2 or)
@@ -249,7 +256,6 @@
 	   (move r x)
 	   (inst add r y)))))
 
-
 ;;;; Special logand cases: (logand signed unsigned) => unsigned
 
 (define-vop (fast-logand/signed-unsigned=>unsigned
@@ -794,6 +800,82 @@
 
     DONE))
 
+(in-package "SB!C")
+
+(defknown %lea (integer integer (member 1 2 4 8) (signed-byte 32))
+  integer
+  (foldable flushable movable))
+
+(defoptimizer (%lea derive-type) ((base index scale disp))
+  (when (and (constant-lvar-p scale)
+	     (constant-lvar-p disp))
+    (let ((scale (lvar-value scale))
+	  (disp (lvar-value disp))
+	  (base-type (lvar-type base))
+	  (index-type (lvar-type index)))
+      (when (and (numeric-type-p base-type)
+		 (numeric-type-p index-type))
+	(let ((base-lo (numeric-type-low base-type))
+	      (base-hi (numeric-type-high base-type))
+	      (index-lo (numeric-type-low index-type))
+	      (index-hi (numeric-type-high index-type)))
+	  (make-numeric-type :class 'integer
+			     :complexp :real
+			     :low (when (and base-lo index-lo)
+				    (+ base-lo (* index-lo scale) disp))
+			     :high (when (and base-hi index-hi)
+				     (+ base-hi (* index-hi scale) disp))))))))
+
+(defun %lea (base index scale disp)
+  (+ base (* index scale) disp))
+
+(in-package "SB!VM")
+
+(define-vop (%lea/unsigned=>unsigned)
+  (:translate %lea)
+  (:policy :fast-safe)
+  (:args (base :scs (unsigned-reg))
+	 (index :scs (unsigned-reg)))
+  (:info scale disp)
+  (:arg-types unsigned-num unsigned-num
+	      (:constant (member 1 2 4 8))
+	      (:constant (signed-byte 32)))
+  (:results (r :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 5
+    (inst lea r (make-ea :dword :base base :index index
+			 :scale scale :disp disp))))
+
+(define-vop (%lea/signed=>signed)
+  (:translate %lea)
+  (:policy :fast-safe)
+  (:args (base :scs (signed-reg))
+	 (index :scs (signed-reg)))
+  (:info scale disp)
+  (:arg-types signed-num signed-num
+	      (:constant (member 1 2 4 8))
+	      (:constant (signed-byte 32)))
+  (:results (r :scs (signed-reg)))
+  (:result-types signed-num)
+  (:generator 4
+    (inst lea r (make-ea :dword :base base :index index
+			 :scale scale :disp disp))))
+
+(define-vop (%lea/fixnum=>fixnum)
+  (:translate %lea)
+  (:policy :fast-safe)
+  (:args (base :scs (any-reg))
+	 (index :scs (any-reg)))
+  (:info scale disp)
+  (:arg-types tagged-num tagged-num
+	      (:constant (member 1 2 4 8))
+	      (:constant (signed-byte 32)))
+  (:results (r :scs (any-reg)))
+  (:result-types tagged-num)
+  (:generator 3
+    (inst lea r (make-ea :dword :base base :index index
+			 :scale scale :disp disp))))
+
 ;;; FIXME: before making knowledge of this too public, it needs to be
 ;;; fixed so that it's actually _faster_ than the non-CMOV version; at
 ;;; least on my Celeron-XXX laptop, this version is marginally slower
@@ -1082,39 +1164,6 @@
     (move result prev)
     (inst shrd result next :cl)))
 
-(define-source-transform 32bit-logical-not (x)
-  `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32))))
-
-(deftransform 32bit-logical-and ((x y))
-  '(logand x y))
-
-(define-source-transform 32bit-logical-nand (x y)
-  `(32bit-logical-not (32bit-logical-and ,x ,y)))
-
-(deftransform 32bit-logical-or ((x y))
-  '(logior x y))
-
-(define-source-transform 32bit-logical-nor (x y)
-  `(32bit-logical-not (32bit-logical-or ,x ,y)))
-
-(deftransform 32bit-logical-xor ((x y))
-  '(logxor x y))
-
-(define-source-transform 32bit-logical-eqv (x y)
-  `(32bit-logical-not (32bit-logical-xor ,x ,y)))
-
-(define-source-transform 32bit-logical-orc1 (x y)
-  `(32bit-logical-or (32bit-logical-not ,x) ,y))
-
-(define-source-transform 32bit-logical-orc2 (x y)
-  `(32bit-logical-or ,x (32bit-logical-not ,y)))
-
-(define-source-transform 32bit-logical-andc1 (x y)
-  `(32bit-logical-and (32bit-logical-not ,x) ,y))
-
-(define-source-transform 32bit-logical-andc2 (x y)
-  `(32bit-logical-and ,x (32bit-logical-not ,y)))
-
 ;;; Only the lower 5 bits of the shift amount are significant.
 (define-vop (shift-towards-someplace)
   (:policy :fast-safe)
@@ -1163,6 +1212,45 @@
              fast-ash-c/unsigned=>unsigned)
   (:translate ash-left-mod32))
 
+(define-vop (fast-ash-left-mod32/unsigned=>unsigned
+             fast-ash-left/unsigned=>unsigned))
+(deftransform ash-left-mod32 ((integer count)
+			      ((unsigned-byte 32) (unsigned-byte 5)))
+  (when (sb!c::constant-lvar-p count)
+    (sb!c::give-up-ir1-transform))
+  '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
+
+(in-package "SB!C")
+
+(defknown sb!vm::%lea-mod32 (integer integer (member 1 2 4 8) (signed-byte 32))
+  (unsigned-byte 32)
+  (foldable flushable movable))
+
+(define-modular-fun-optimizer %lea ((base index scale disp) :width width)
+  (when (and (<= width 32)
+	     (constant-lvar-p scale)
+	     (constant-lvar-p disp))
+    (cut-to-width base width)
+    (cut-to-width index width)
+    'sb!vm::%lea-mod32))
+
+#+sb-xc-host
+(defun sb!vm::%lea-mod32 (base index scale disp)
+  (ldb (byte 32 0) (%lea base index scale disp)))
+#-sb-xc-host
+(defun sb!vm::%lea-mod32 (base index scale disp)
+  (let ((base (logand base #xffffffff))
+	(index (logand index #xffffffff)))
+    ;; can't use modular version of %LEA, as we only have VOPs for
+    ;; constant SCALE and DISP.
+    (ldb (byte 32 0) (+ base (* index scale) disp))))
+
+(in-package "SB!VM")
+
+(define-vop (%lea-mod32/unsigned=>unsigned
+	     %lea/unsigned=>unsigned)
+  (:translate %lea-mod32))
+
 ;;; logical operations
 (define-modular-fun lognot-mod32 (x) lognot 32)
 (define-vop (lognot-mod32/unsigned=>unsigned)
@@ -1511,84 +1599,6 @@
 
 (in-package "SB!C")
 
-(defknown %lea ((or (signed-byte 32) (unsigned-byte 32))
-		(or (signed-byte 32) (unsigned-byte 32))
-		(member 1 2 4 8) (signed-byte 32))
-  (or (signed-byte 32) (unsigned-byte 32))
-  (foldable flushable))
-
-(defoptimizer (%lea derive-type) ((base index scale disp))
-  (when (and (constant-lvar-p scale)
-	     (constant-lvar-p disp))
-    (let ((scale (lvar-value scale))
-	  (disp (lvar-value disp))
-	  (base-type (lvar-type base))
-	  (index-type (lvar-type index)))
-      (when (and (numeric-type-p base-type)
-		 (numeric-type-p index-type))
-	(let ((base-lo (numeric-type-low base-type))
-	      (base-hi (numeric-type-high base-type))
-	      (index-lo (numeric-type-low index-type))
-	      (index-hi (numeric-type-high index-type)))
-	  (make-numeric-type :class 'integer
-			     :complexp :real
-			     :low (when (and base-lo index-lo)
-				    (+ base-lo (* index-lo scale) disp))
-			     :high (when (and base-hi index-hi)
-				     (+ base-hi (* index-hi scale) disp))))))))
-
-(defun %lea (base index scale disp)
-  (+ base (* index scale) disp))
-
-(in-package "SB!VM")
-
-(define-vop (%lea/unsigned=>unsigned)
-  (:translate %lea)
-  (:policy :fast-safe)
-  (:args (base :scs (unsigned-reg))
-	 (index :scs (unsigned-reg)))
-  (:info scale disp)
-  (:arg-types unsigned-num unsigned-num
-	      (:constant (member 1 2 4 8))
-	      (:constant (signed-byte 32)))
-  (:results (r :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:generator 5
-    (inst lea r (make-ea :dword :base base :index index
-			 :scale scale :disp disp))))
-
-(define-vop (%lea/signed=>signed)
-  (:translate %lea)
-  (:policy :fast-safe)
-  (:args (base :scs (signed-reg))
-	 (index :scs (signed-reg)))
-  (:info scale disp)
-  (:arg-types signed-num signed-num
-	      (:constant (member 1 2 4 8))
-	      (:constant (signed-byte 32)))
-  (:results (r :scs (signed-reg)))
-  (:result-types signed-num)
-  (:generator 4
-    (inst lea r (make-ea :dword :base base :index index
-			 :scale scale :disp disp))))
-
-(define-vop (%lea/fixnum=>fixnum)
-  (:translate %lea)
-  (:policy :fast-safe)
-  (:args (base :scs (any-reg))
-	 (index :scs (any-reg)))
-  (:info scale disp)
-  (:arg-types tagged-num tagged-num
-	      (:constant (member 1 2 4 8))
-	      (:constant (signed-byte 32)))
-  (:results (r :scs (any-reg)))
-  (:result-types tagged-num)
-  (:generator 3
-    (inst lea r (make-ea :dword :base base :index index
-			 :scale scale :disp disp))))
-
-(in-package "SB!C")
-
 ;;; This is essentially a straight implementation of the algorithm in
 ;;; "Strength Reduction of Multiplications by Integer Constants",
 ;;; Youfeng Wu, ACM SIGPLAN Notices, Vol. 30, No.2, February 1995.