[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-serv11825

Modified Files:
	integers.lisp 
Log Message:
Fixed one-operand - and two-operand / on ratios.

Date: Tue Oct 12 12:51:47 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.98 movitz/losp/muerte/integers.lisp:1.99
--- movitz/losp/muerte/integers.lisp:1.98	Mon Oct 11 15:52:50 2004
+++ movitz/losp/muerte/integers.lisp	Tue Oct 12 12:51:47 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.98 2004/10/11 13:52:50 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.99 2004/10/12 10:51:47 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -688,44 +688,23 @@
   (declare (dynamic-extent subtrahends))
   (numargs-case
    (1 (x)
-      (macrolet
-	  ((do-it ()
-	     `(with-inline-assembly (:returns :eax)
-		(:compile-form (:result-mode :eax) x)
-		(:testb ,movitz:+movitz-fixnum-zmask+ :al)
-		(:jnz '(:sub-program (not-fixnum)
-			(:leal (:eax ,(- (movitz:tag :other))) :ecx)
-			(:testb 7 :cl)
-			(:jnz '(:sub-program (not-a-number)
-				(:compile-form (:result-mode :ignore)
-				 (if (typep x 'ratio)
-				     (make-rational (- (%ratio-numerator x))
-				      (%ratio-denominator x))
-				   (error 'type-error :expected-type 'number :datum x)))))
-			(:movl (:eax ,movitz:+other-type-offset+) :ecx)
-			(:cmpb ,(movitz:tag :bignum) :cl)
-			(:jne 'not-a-number)
-			(:cmpl ,(dpb 4 (byte 16 16) (movitz:tag :bignum 0)) :ecx)
-			(:jne 'not-most-negative-fixnum)
-			(:cmpl ,(- most-negative-fixnum) (:eax (:offset movitz-bignum bigit0)))
-			(:jne 'not-most-negative-fixnum)
-			(:movl ,(ldb (byte 32 0)
-				 (* most-negative-fixnum movitz::+movitz-fixnum-factor+))
-			 :eax)
-			(:jmp 'fix-ok)
-			not-most-negative-fixnum
-			(:compile-form (:result-mode :eax)
-			 (copy-bignum x))
-			(:notb (:eax (:offset movitz-bignum sign)))
-			(:jmp 'fix-ok)))
-		(:negl :eax)
-		(:jo '(:sub-program (fix-overflow)
-		       (:compile-form (:result-mode :eax)
-			,(1+ movitz:+movitz-most-positive-fixnum+))
-		       (:jmp 'fix-ok)))
-	       fix-ok
-		)))
-	(do-it)))
+      (etypecase x
+	(fixnum
+	 (macrolet
+	     ((do-it ()
+		`(with-inline-assembly (:returns :eax)
+		   (:compile-form (:result-mode :eax) x)
+		   (:negl :eax)
+		   (:jo '(:sub-program (fix-overflow)
+			  (:compile-form (:result-mode :eax)
+			   ,(1+ movitz:+movitz-most-positive-fixnum+))
+			  (:jmp 'fix-ok)))
+		  fix-ok)))
+	   (do-it)))
+	(bignum
+	 (%bignum-negate (copy-bignum x)))
+	(ratio
+	 (make-ratio (- (ratio-numerator x)) (ratio-denominator x)))))
    (2 (minuend subtrahend)
       (macrolet
 	  ((do-it ()
@@ -1421,9 +1400,11 @@
    (2 (x y)
       (multiple-value-bind (q r)
 	  (truncate x y)
-	(if (= 0 r)
-	    q
-	  (make-rational x y))))
+	(cond
+	 ((= 0 r)
+	  q)
+	 (t (make-rational (* (numerator x) (denominator y))
+			   (* (denominator x) (numerator y)))))))
    (t (number &rest denominators)
       (declare (dynamic-extent denominators))
       (cond