arch-assem.S: Update fun-end breakpoint magic for pickier make-lisp-obj.

[sbcl.git] / src / code / numbers.lisp

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index ecf558d..7bb61f9 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -590,6 +590,15 @@
         (foreach single-float double-float #!+long-float long-float))
        (truncate-float (dispatch-type divisor))))))
 
+;; Only inline when no VOP exists
+#!-multiply-high-vops (declaim (inline %multiply-high))
+(defun %multiply-high (x y)
+  (declare (type word x y))
+  #!-multiply-high-vops
+  (values (sb!bignum:%multiply x y))
+  #!+multiply-high-vops
+  (%multiply-high x y))
+
 ;;; Declare these guys inline to let them get optimized a little.
 ;;; ROUND and FROUND are not declared inline since they seem too
 ;;; obscure and too big to inline-expand by default. Also, this gives
@@ -1076,9 +1085,9 @@ the first."
   #!+sb-doc
   "Predicate returns T if bit index of integer is a 1."
   (number-dispatch ((index integer) (integer integer))
-    ((fixnum fixnum) (if (> index #.(- sb!vm:n-word-bits sb!vm:n-lowtag-bits))
-                         (minusp integer)
-                         (not (zerop (logand integer (ash 1 index))))))
+    ((fixnum fixnum) (if (< index sb!vm:n-positive-fixnum-bits)
+                         (not (zerop (logand integer (ash 1 index))))
+                         (minusp integer)))
     ((fixnum bignum) (bignum-logbitp index integer))
     ((bignum (foreach fixnum bignum)) (minusp integer))))
 
@@ -1487,14 +1496,9 @@ the first."
     (bignum (ldb (byte 64 0)
                  (ash (logand integer #xffffffffffffffff) amount)))))
 
-#!+x86
-(defun sb!vm::ash-left-smod30 (integer amount)
-  (etypecase integer
-    ((signed-byte 30) (sb!c::mask-signed-field 30 (ash integer amount)))
-    (integer (sb!c::mask-signed-field 30 (ash (sb!c::mask-signed-field 30 integer) amount)))))
-
-#!+x86-64
-(defun sb!vm::ash-left-smod61 (integer amount)
-  (etypecase integer
-    ((signed-byte 61) (sb!c::mask-signed-field 61 (ash integer amount)))
-    (integer (sb!c::mask-signed-field 61 (ash (sb!c::mask-signed-field 61 integer) amount)))))
+#!+(or x86 x86-64)
+(defun sb!vm::ash-left-modfx (integer amount)
+  (let ((fixnum-width (- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)))
+    (etypecase integer
+      (fixnum (sb!c::mask-signed-field fixnum-width (ash integer amount)))
+      (integer (sb!c::mask-signed-field fixnum-width (ash (sb!c::mask-signed-field fixnum-width integer) amount))))))