X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=865fade3538f9bd0fac03dcb59fa782defa03488;hb=b7a8f5313a83dea33ce60551a4fb987b415c2cc6;hp=e8234cb03a9b429252a82f4b600a63433a971799;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index e8234cb..865fade 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -731,9 +731,9 @@
   (:policy :fast-safe)
   (:args (arg :scs (signed-reg) :target res))
   (:arg-types signed-num)
-  (:results (res :scs (any-reg)))
-  (:result-types positive-fixnum)
-  (:generator 30
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 28
     (move res arg)
     (inst cmp res 0)
     (inst jmp :ge POS)
@@ -742,7 +742,23 @@
     (inst bsr res res)
     (inst jmp :z zero)
     (inst inc res)
-    (inst shl res 2)
+    (inst jmp done)
+    ZERO
+    (inst xor res res)
+    DONE))
+
+(define-vop (unsigned-byte-32-len)
+  (:translate integer-length)
+  (:note "inline (unsigned-byte 32) integer-length")
+  (:policy :fast-safe)
+  (:args (arg :scs (unsigned-reg)))
+  (:arg-types unsigned-num)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 26
+    (inst bsr res arg)
+    (inst jmp :z zero)
+    (inst inc res)
     (inst jmp done)
     ZERO
     (inst xor res res)
@@ -842,28 +858,28 @@
 (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned)
 	     `(progn
 		,@(mapcar
-		   #'(lambda (suffix cost signed)
-		       `(define-vop (;; FIXME: These could be done more
-				     ;; cleanly with SYMBOLICATE.
-				     ,(intern (format nil "~:@(FAST-IF-~A~A~)"
-						      tran suffix))
-				     ,(intern
-				       (format nil "~:@(FAST-CONDITIONAL~A~)"
-					       suffix)))
-			  (:translate ,tran)
-			  (:generator ,cost
-				      (inst cmp x
-					    ,(if (eq suffix '-c/fixnum)
-						 '(fixnumize y)
-						 'y))
-				      (inst jmp (if not-p
-						    ,(if signed
-							 not-cond
-							 not-unsigned)
-						    ,(if signed
-							 cond
-							 unsigned))
-					    target))))
+		   (lambda (suffix cost signed)
+		     `(define-vop (;; FIXME: These could be done more
+				   ;; cleanly with SYMBOLICATE.
+				   ,(intern (format nil "~:@(FAST-IF-~A~A~)"
+						    tran suffix))
+				   ,(intern
+				     (format nil "~:@(FAST-CONDITIONAL~A~)"
+					     suffix)))
+			(:translate ,tran)
+			(:generator ,cost
+				    (inst cmp x
+					  ,(if (eq suffix '-c/fixnum)
+					       '(fixnumize y)
+					       'y))
+				    (inst jmp (if not-p
+						  ,(if signed
+						       not-cond
+						       not-unsigned)
+						  ,(if signed
+						       cond
+						       unsigned))
+					  target))))
 		   '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
 		   '(4 3 6 5 6 5)
 		   '(t t t t nil nil)))))
@@ -1004,7 +1020,7 @@
     (move r x)
     (inst and r y)))
 
-(def-source-transform 32bit-logical-nand (x y)
+(define-source-transform 32bit-logical-nand (x y)
   `(32bit-logical-not (32bit-logical-and ,x ,y)))
 
 (define-vop (32bit-logical-or 32bit-logical)
@@ -1013,7 +1029,7 @@
     (move r x)
     (inst or r y)))
 
-(def-source-transform 32bit-logical-nor (x y)
+(define-source-transform 32bit-logical-nor (x y)
   `(32bit-logical-not (32bit-logical-or ,x ,y)))
 
 (define-vop (32bit-logical-xor 32bit-logical)
@@ -1022,19 +1038,19 @@
     (move r x)
     (inst xor r y)))
 
-(def-source-transform 32bit-logical-eqv (x y)
+(define-source-transform 32bit-logical-eqv (x y)
   `(32bit-logical-not (32bit-logical-xor ,x ,y)))
 
-(def-source-transform 32bit-logical-orc1 (x y)
+(define-source-transform 32bit-logical-orc1 (x y)
   `(32bit-logical-or (32bit-logical-not ,x) ,y))
 
-(def-source-transform 32bit-logical-orc2 (x y)
+(define-source-transform 32bit-logical-orc2 (x y)
   `(32bit-logical-or ,x (32bit-logical-not ,y)))
 
-(def-source-transform 32bit-logical-andc1 (x y)
+(define-source-transform 32bit-logical-andc1 (x y)
   `(32bit-logical-and (32bit-logical-not ,x) ,y))
 
-(def-source-transform 32bit-logical-andc2 (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.
@@ -1296,14 +1312,14 @@
 
 ;;;; static functions
 
-(define-static-function two-arg-/ (x y) :translate /)
+(define-static-fun two-arg-/ (x y) :translate /)
 
-(define-static-function two-arg-gcd (x y) :translate gcd)
-(define-static-function two-arg-lcm (x y) :translate lcm)
+(define-static-fun two-arg-gcd (x y) :translate gcd)
+(define-static-fun two-arg-lcm (x y) :translate lcm)
 
-(define-static-function two-arg-and (x y) :translate logand)
-(define-static-function two-arg-ior (x y) :translate logior)
-(define-static-function two-arg-xor (x y) :translate logxor)
+(define-static-fun two-arg-and (x y) :translate logand)
+(define-static-fun two-arg-ior (x y) :translate logior)
+(define-static-fun two-arg-xor (x y) :translate logxor)
 
 
 ;;; Support for the Mersenne Twister, MT19937, random number generator
@@ -1332,9 +1348,9 @@
   (:result-types unsigned-num)
   (:generator 50
     (inst mov k (make-ea :dword :base state
-			 :disp (- (* (+ 2 sb!vm:vector-data-offset)
-				     sb!vm:word-bytes)
-				  sb!vm:other-pointer-lowtag)))
+			 :disp (- (* (+ 2 vector-data-offset)
+				     n-word-bytes)
+				  other-pointer-lowtag)))
     (inst cmp k 624)
     (inst jmp :ne no-update)
     (inst mov tmp state)	; The state is passed in EAX.
@@ -1344,23 +1360,23 @@
     NO-UPDATE
     ;; y = ptgfsr[k++];
     (inst mov y (make-ea :dword :base state :index k :scale 4
-			 :disp (- (* (+ 3 sb!vm:vector-data-offset)
-				     sb!vm:word-bytes)
-				  sb!vm:other-pointer-lowtag)))
+			 :disp (- (* (+ 3 vector-data-offset)
+				     n-word-bytes)
+				  other-pointer-lowtag)))
     ;; y ^= (y >> 11);
     (inst shr y 11)
     (inst xor y (make-ea :dword :base state :index k :scale 4
-			 :disp (- (* (+ 3 sb!vm:vector-data-offset)
-				     sb!vm:word-bytes)
-				  sb!vm:other-pointer-lowtag)))
+			 :disp (- (* (+ 3 vector-data-offset)
+				     n-word-bytes)
+				  other-pointer-lowtag)))
     ;; y ^= (y << 7) & #x9d2c5680
     (inst mov tmp y)
     (inst inc k)
     (inst shl tmp 7)
     (inst mov (make-ea :dword :base state
-		       :disp (- (* (+ 2 sb!vm:vector-data-offset)
-				   sb!vm:word-bytes)
-				sb!vm:other-pointer-lowtag))
+		       :disp (- (* (+ 2 vector-data-offset)
+				   n-word-bytes)
+				other-pointer-lowtag))
 	  k)
     (inst and tmp #x9d2c5680)
     (inst xor y tmp)