don't close runtime dlhandle on Darwin

[sbcl.git] / src / compiler / x86-64 / arith.lisp

diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 3c6420f..9d48e29 100644 (file)
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -11,6 +11,12 @@
 
 (in-package "SB!VM")
 \f
+
+;; A fixnum that can be represented in tagged form by a signed 32-bit
+;; value and that can therefore be used as an immediate argument of
+;; arithmetic machine instructions.
+(deftype short-tagged-num () '(signed-byte #.(- 32 n-fixnum-tag-bits)))
+
 ;;;; unary operations
 
 (define-vop (fast-safe-arith-op)
@@ -110,13 +116,13 @@
 
 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
   (:args (x :target r :scs (any-reg)
-            :load-if (or (not (typep y '(signed-byte 29)))
+            :load-if (or (not (typep y 'short-tagged-num))
                          (not (sc-is x any-reg control-stack)))))
   (:info y)
   (:arg-types tagged-num (:constant fixnum))
   (:results (r :scs (any-reg)
                :load-if (or (not (location= x r))
-                            (not (typep y '(signed-byte 29))))))
+                            (not (typep y 'short-tagged-num)))))
   (:result-types tagged-num)
   (:note "inline fixnum arithmetic"))
 
@@ -157,7 +163,7 @@
                   (:translate ,translate)
                   (:generator 1
                   (move r x)
-                  (inst ,op r (if (typep y '(signed-byte 29))
+                  (inst ,op r (if (typep y 'short-tagged-num)
                                   (fixnumize y)
                                   (register-inline-constant :qword (fixnumize y))))))
                 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
@@ -228,20 +234,20 @@
 (define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
   (:translate +)
   (:args (x :target r :scs (any-reg)
-            :load-if (or (not (typep y '(signed-byte 29)))
+            :load-if (or (not (typep y 'short-tagged-num))
                          (not (sc-is x any-reg control-stack)))))
   (:info y)
   (:arg-types tagged-num (:constant fixnum))
   (:results (r :scs (any-reg)
                :load-if (or (not (location= x r))
-                            (not (typep y '(signed-byte 29))))))
+                            (not (typep y 'short-tagged-num)))))
   (:result-types tagged-num)
   (:note "inline fixnum arithmetic")
   (:generator 1
     (cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r))
-                (typep y '(signed-byte 29)))
+                (typep y 'short-tagged-num))
            (inst lea r (make-ea :qword :base x :disp (fixnumize y))))
-          ((typep y '(signed-byte 29))
+          ((typep y 'short-tagged-num)
            (move r x)
            (inst add r (fixnumize y)))
           (t
@@ -391,7 +397,7 @@
   (:note "inline fixnum arithmetic")
   (:generator 4
     (move r x)
-    (inst sar r 3)
+    (inst sar r n-fixnum-tag-bits)
     (inst imul r y)))
 
 (define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op)
@@ -510,8 +516,10 @@
     (inst idiv eax y)
     (if (location= quo eax)
         (inst shl eax n-fixnum-tag-bits)
-        (inst lea quo (make-ea :qword :index eax
-                               :scale (ash 1 n-fixnum-tag-bits))))
+        (if (= n-fixnum-tag-bits 1)
+            (inst lea quo (make-ea :qword :base eax :index eax))
+            (inst lea quo (make-ea :qword :index eax
+                                   :scale (ash 1 n-fixnum-tag-bits)))))
     (move rem edx)))
 
 (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op)
@@ -533,14 +541,16 @@
   (:generator 30
     (move eax x)
     (inst cqo)
-    (if (typep y '(signed-byte 29))
+    (if (typep y 'short-tagged-num)
         (inst mov y-arg (fixnumize y))
         (setf y-arg (register-inline-constant :qword (fixnumize y))))
     (inst idiv eax y-arg)
     (if (location= quo eax)
         (inst shl eax n-fixnum-tag-bits)
-        (inst lea quo (make-ea :qword :index eax
-                               :scale (ash 1 n-fixnum-tag-bits))))
+        (if (= n-fixnum-tag-bits 1)
+            (inst lea quo (make-ea :qword :base eax :index eax))
+            (inst lea quo (make-ea :qword :index eax
+                                   :scale (ash 1 n-fixnum-tag-bits)))))
     (move rem edx)))
 
 (define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op)
@@ -686,6 +696,7 @@
                       (progn
                         (inst sar result (- amount))
                         (inst and result (lognot fixnum-tag-mask)))))
+                 ;; shifting left (zero fill)
                  ((plusp amount)
                   (unless modularp
                     (aver (not "Impossible: fixnum ASH should not be called with
@@ -693,6 +704,7 @@ constant shift greater than word length")))
                   (if (sc-is result any-reg)
                       (zeroize result)
                       (inst mov result 0)))
+                 ;; shifting right (sign fill)
                  (t (inst sar result 63)
                     (inst and result (lognot fixnum-tag-mask))))))))
 
@@ -834,7 +846,7 @@ constant shift greater than word length")))
   (:generator 5
     (move result number)
     (move ecx amount)
-    (inst or ecx ecx)
+    (inst test ecx ecx)
     (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (inst cmp ecx 63)
@@ -863,7 +875,7 @@ constant shift greater than word length")))
   (:generator 5
     (move result number)
     (move ecx amount)
-    (inst or ecx ecx)
+    (inst test ecx ecx)
     (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (inst cmp ecx 63)
@@ -975,7 +987,7 @@ constant shift greater than word length")))
   (:generator 4
     (move result number)
     (move ecx amount)
-    (inst or ecx ecx)
+    (inst test ecx ecx)
     (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (zeroize zero)
@@ -1108,7 +1120,7 @@ constant shift greater than word length")))
 
 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
   (:args (x :scs (any-reg)
-            :load-if (or (not (typep y '(signed-byte 29)))
+            :load-if (or (not (typep y 'short-tagged-num))
                          (not (sc-is x any-reg control-stack)))))
   (:arg-types tagged-num (:constant fixnum))
   (:info y))
@@ -1160,7 +1172,7 @@ constant shift greater than word length")))
                                     (inst cmp x
                                           ,(case suffix
                                              (-c/fixnum
-                                                `(if (typep y '(signed-byte 29))
+                                                `(if (typep y 'short-tagged-num)
                                                      (fixnumize y)
                                                      (register-inline-constant
                                                       :qword (fixnumize y))))
@@ -1243,7 +1255,7 @@ constant shift greater than word length")))
 
 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
   (:args (x :scs (any-reg)
-            :load-if (or (not (typep y '(signed-byte 29)))
+            :load-if (or (not (typep y 'short-tagged-num))
                          (not (sc-is x any-reg descriptor-reg control-stack)))))
   (:arg-types tagged-num (:constant fixnum))
   (:info y)
@@ -1251,7 +1263,7 @@ constant shift greater than word length")))
   (:generator 2
     (cond ((and (sc-is x any-reg descriptor-reg) (zerop y))
            (inst test x x))  ; smaller instruction
-          ((typep y '(signed-byte 29))
+          ((typep y 'short-tagged-num)
            (inst cmp x (fixnumize y)))
           (t
            (inst cmp x (register-inline-constant :qword (fixnumize y)))))))
@@ -1500,7 +1512,7 @@ constant shift greater than word length")))
   (:arg-types unsigned-num)
   (:conditional :ns)
   (:generator 3
-    (inst or digit digit)))
+    (inst test digit digit)))
 
 
 ;;; For add and sub with carry the sc of carry argument is any-reg so
@@ -1664,7 +1676,7 @@ constant shift greater than word length")))
   (:result-types unsigned-num)
   (:generator 1
     (move digit fixnum)
-    (inst sar digit 3)))
+    (inst sar digit n-fixnum-tag-bits)))
 
 (define-vop (bignum-floor)
   (:translate sb!bignum:%bigfloor)
@@ -1700,7 +1712,7 @@ constant shift greater than word length")))
   (:generator 1
     (move res digit)
     (when (sc-is res any-reg control-stack)
-      (inst shl res 3))))
+      (inst shl res n-fixnum-tag-bits))))
 
 (define-vop (digit-ashr)
   (:translate sb!bignum:%ashr)