[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv11410

Modified Files:
	integers.lisp 
Log Message:
Fixed bogus abs compiler-macro. Tuned up gcd a bit.

Date: Wed Jul 14 05:03:58 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.55 movitz/losp/muerte/integers.lisp:1.56
--- movitz/losp/muerte/integers.lisp:1.55	Wed Jul 14 04:01:43 2004
+++ movitz/losp/muerte/integers.lisp	Wed Jul 14 05:03:58 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: integers.lisp,v 1.55 2004/07/14 11:01:43 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.56 2004/07/14 12:03:58 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -942,7 +942,7 @@
 
 (define-compiler-macro abs (x)
   `(let ((x ,x))
-     (if (>= 0 x) x (- x))))
+     (if (>= x 0) x (- x))))
 
 (defun abs (x)
   (abs x))
@@ -1427,7 +1427,14 @@
 		       (setf q (1+ q)
 			     r (- r divisor))
 		     (setf q (+ q guess)
-			   r (- r (* divisor guess))))))))))))))
+			   r (- r (* divisor guess))))))))))
+	(((integer * -1) (integer 0 *))
+	 (- (truncate (- number) divisor)))
+	(((integer 0 *) (integer * -1))
+	 (- (truncate number (- divisor))))
+	(((integer * -1) (integer * -1))
+	 (truncate (- number) (- divisor)))
+	))))
 
 (defun / (number &rest denominators)
   (declare (dynamic-extent denominators))
@@ -2275,20 +2282,18 @@
 	   (u (abs u) (truncate u 2))
 	   (v (abs v) (truncate v 2)))
 	  ((or (oddp u) (oddp v))
-	   (do ((temp (if (oddp u) (- v) (ash u -1))
-		      (ash temp -1)))
+	   (do ((temp (if (oddp u)
+			  (- v)
+			(truncate u 2))
+		      (truncate temp 2)))
 	       (nil)
-	     (declare (fixnum temp))
 	     (when (oddp temp)
 	       (if (plusp temp)
 		   (setq u temp)
 		 (setq v (- temp)))
 	       (setq temp (- u v))
 	       (when (zerop temp)
-		 (let ((res (ash u k)))
-		   (declare (type (signed-byte 31) res)
-			    (optimize (inhibit-warnings 3)))
-		   (return res))))))))
+		 (return (ash u k))))))))
    (t (&rest numbers)
       (declare (dynamic-extent numbers))
       (do ((gcd (car numbers)