X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=5522134a50c53af037cd063ab156b07ef2db6d6d;hb=224466fab9dc4e8b3faf13a121f827f198811bf6;hp=f3adc3bcae6d69661f5acbc65d70ac69d1b27d98;hpb=4b58efcd710097cf7cc9b1a1bed8b0e1bd6eb3b8;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index f3adc3b..5522134 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1004,8 +1004,9 @@
   if INTEGER is negative."
   (etypecase integer
     (fixnum
-     (logcount (truly-the (integer 0 #.(max most-positive-fixnum
-					    (lognot most-negative-fixnum)))
+     (logcount (truly-the (integer 0
+				   #.(max sb!xc:most-positive-fixnum
+					  (lognot sb!xc:most-negative-fixnum)))
 			  (if (minusp (truly-the fixnum integer))
 			      (lognot (truly-the fixnum integer))
 			      integer))))
@@ -1020,7 +1021,12 @@
 (defun logbitp (index integer)
   #!+sb-doc
   "Predicate returns T if bit index of integer is a 1."
-  (logbitp index integer))
+  (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 bignum) (bignum-logbitp index integer))
+    ((bignum (foreach fixnum bignum)) (minusp integer))))
 
 (defun ash (integer count)
   #!+sb-doc
@@ -1259,13 +1265,20 @@
 
 (defun two-arg-lcm (n m)
   (declare (integer n m))
-  (let ((m (abs m))
-        (n (abs n)))
-    (multiple-value-bind (max min)
-        (if (> m n)
-            (values m n)
-            (values n m))
-      (* (truncate max (gcd n m)) min))))
+  (if (or (zerop n) (zerop m))
+      0
+      ;; KLUDGE: I'm going to assume that it was written this way
+      ;; originally for a reason.  However, this is a somewhat
+      ;; complicated way of writing the algorithm in the CLHS page for
+      ;; LCM, and I don't know why.  To be investigated.  -- CSR,
+      ;; 2003-09-11
+      (let ((m (abs m))
+	    (n (abs n)))
+	(multiple-value-bind (max min)
+	    (if (> m n)
+		(values m n)
+		(values n m))
+	  (* (truncate max (gcd n m)) min)))))
 
 ;;; Do the GCD of two integer arguments. With fixnum arguments, we use the
 ;;; binary GCD algorithm from Knuth's seminumerical algorithms (slightly
@@ -1345,16 +1358,13 @@
 #.
 (collect ((forms))
   (flet ((definition (name lambda-list width pattern)
-           ;; We rely on (SUBTYPEP `(UNSIGNED-BYTE ,WIDTH)
-           ;;                      'BIGNUM-ELEMENT-TYPE)
            `(defun ,name ,lambda-list
               (flet ((prepare-argument (x)
                        (declare (integer x))
                        (etypecase x
                          ((unsigned-byte ,width) x)
-                         (bignum-element-type (logand x ,pattern))
                          (fixnum (logand x ,pattern))
-                         (bignum (logand (%bignum-ref x 0) ,pattern)))))
+                         (bignum (logand x ,pattern)))))
                 (,name ,@(loop for arg in lambda-list
                                collect `(prepare-argument ,arg)))))))
     (loop for infos being each hash-value of sb!c::*modular-funs*