[oct-cvs] Oct commit: oct qd.lisp

rtoy rtoy at common-lisp.net
Sun Sep 16 14:23:25 UTC 2007


Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv2951

Modified Files:
	qd.lisp 
Log Message:
o Remove old code.
o Inline float-infinity-p.


--- /project/oct/cvsroot/oct/qd.lisp	2007/09/16 05:04:05	1.48
+++ /project/oct/cvsroot/oct/qd.lisp	2007/09/16 14:23:24	1.49
@@ -53,18 +53,6 @@
     (c::two-sum ,x ,y)))
 
 
-#+nil
-(defun three-sum (a b c)
-  (declare (double-float a b c)
-	   (optimize (speed 3)))
-  (multiple-value-bind (t1 t2)
-      (two-sum a b)
-    (multiple-value-bind (a t3)
-	(two-sum c t1)
-      (multiple-value-bind (b c)
-	  (two-sum t2 t3)
-	(values a b c)))))
-
 (defun three-sum (a b c)
   (declare (double-float a b c)
 	   (optimize (speed 3)))
@@ -77,16 +65,6 @@
     (two-sum b c t2 t3)
     (values a b c)))
 
-#+nil
-(defun three-sum2 (a b c)
-  (declare (double-float a b c)
-	   (optimize (speed 3)))
-  (multiple-value-bind (t1 t2)
-      (two-sum a b)
-    (multiple-value-bind (a t3)
-	(two-sum c t1)
-      (values a (cl:+ t2 t3) c))))
-
 (defun three-sum2 (a b c)
   (declare (double-float a b c)
 	   (optimize (speed 3)))
@@ -293,7 +271,9 @@
   (declare (type %quad-double a)
 	   (double-float b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   (let* ((c0 0d0)
 	 (e c0)
 	 (c1 c0)
@@ -393,7 +373,9 @@
 	    (s1 (cl:+ a1 b1))
 	    (s2 (cl:+ a2 b2))
 	    (s3 (cl:+ a3 b3)))
-	(declare (double-float s0 s1 s2 s3))
+	(declare (double-float s0 s1 s2 s3)
+		 #+cmu
+		 (inline ext:float-infinity-p))
 	#+cmu
 	(when (float-infinity-p s0)
 	  (return-from add-qd (%make-qd-d s0 0d0 0d0 0d0)))
@@ -471,7 +453,9 @@
   (declare (type %quad-double a)
 	   (double-float b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   (multiple-value-bind (p0 q0)
       (two-prod (qd-0 a) b)
     #+cmu
@@ -590,7 +574,9 @@
 (defun mul-qd (a b)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   (multiple-value-bind (a0 a1 a2 a3)
       (qd-parts a)
     (multiple-value-bind (b0 b1 b2 b3)
@@ -800,7 +786,9 @@
 (defun div-qd (a b)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   (let ((a0 (qd-0 a))
 	(b0 (qd-0 b)))
     (let* ((q0 (cl:/ a0 b0))
@@ -841,7 +829,9 @@
   (declare (type %quad-double a)
 	   (double-float b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   ;; Compute approximate quotient using high order doubles, then
   ;; correct it 3 times using the remainder.  Analogous to long
   ;; division.
@@ -877,7 +867,9 @@
   (declare (type %quad-double a)
 	   (double-double-float b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (inline ext:float-infinity-p))
   (let* ((q0 (cl:/ (qd-0 a) (kernel:double-double-hi b)))
 	 (r (sub-qd-dd a (cl:* b q0))))
     (when (float-infinity-p q0)




More information about the oct-cvs mailing list