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

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 5e56a99..565a2e9 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -794,6 +794,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
@@ -1163,6 +1239,37 @@
              fast-ash-c/unsigned=>unsigned)
   (:translate ash-left-mod32))
 
+(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 +1618,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.