X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fnumbers.lisp;h=751b6f2c40b683405e58cafee738d9f762ff3ef3;hb=6cc71ab8ffad49f43895ad0a1df6885c81876687;hp=cf807c11cd3a77d5352e73c36c6a7262017004fe;hpb=eb105cf1d0fdb3769fea9f7a4df29ce82e93189b;p=sbcl.git

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index cf807c1..751b6f2 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1008,8 +1008,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))))
@@ -1024,7 +1025,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
@@ -1263,7 +1269,20 @@
 
 (defun two-arg-lcm (n m)
   (declare (integer n m))
-  (* (truncate (max n m) (gcd n m)) (min n m)))
+  (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
@@ -1271,8 +1290,8 @@
 ;;; of 0 before the dispatch so that the bignum code doesn't have to worry
 ;;; about "small bignum" zeros.
 (defun two-arg-gcd (u v)
-  (cond ((eql u 0) v)
-	((eql v 0) u)
+  (cond ((eql u 0) (abs v))
+	((eql v 0) (abs u))
 	(t
 	 (number-dispatch ((u integer) (v integer))
 	   ((fixnum fixnum)