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

[rtoy]

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

Modified Files:
	qd-dd.lisp 
Log Message:
Add declarations.  Mostly to help Allegro generate much better code. 


--- /project/oct/cvsroot/oct/qd-dd.lisp	2007/08/25 17:08:48	1.4
+++ /project/oct/cvsroot/oct/qd-dd.lisp	2007/09/13 01:06:02	1.5
@@ -34,19 +34,23 @@
 (declaim (inline quick-two-sum))
 (defun quick-two-sum (a b)
   "Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
-  (declare (double-float a b))
+  (declare (double-float a b)
+	   (optimize (speed 3) (safety 0)))
   (let* ((s (+ a b))
 	 (e (- b (- s a))))
+    (declare (double-float s e))
     (values s e)))
 
 (declaim (inline two-sum))
 (defun two-sum (a b)
   "Computes fl(a+b) and err(a+b)"
-  (declare (double-float a b))
+  (declare (double-float a b)
+	   (optimize (speed 3) (safety 0)))
   (let* ((s (+ a b))
 	 (v (- s a))
 	 (e (+ (- a (- s v))
 	       (- b v))))
+    (declare (double-float s v e))
     (values s e)))
 
 (declaim (inline two-prod))
@@ -103,36 +107,46 @@
 	     (as (* a (scale-float 1d0 -27)))
 	     (a-hi (* (- tmp (- tmp as)) (expt 2 27)))
 	     (a-lo (- a a-hi)))
+	(declare (double-float tmp as a-hi a-lo))
 	(values a-hi a-lo))
       ;; Yozo's algorithm.
       (let* ((tmp (* a (+ 1 (expt 2 27))))
 	     (a-hi (- tmp (- tmp a)))
 	     (a-lo (- a a-hi)))
+	(declare (double-float tmp a-hi a-lo))
 	(values a-hi a-lo))))
 
 
 (defun two-prod (a b)
   "Compute fl(a*b) and err(a*b)"
-  (declare (double-float a b))
+  (declare (double-float a b)
+	   (optimize (speed 3) (safety 0)))
   (let ((p (* a b)))
+    (declare (double-float p))
     (multiple-value-bind (a-hi a-lo)
 	(split a)
+      (declare (double-float a-hi a-lo))
       (multiple-value-bind (b-hi b-lo)
 	  (split b)
+	(declare (double-float b-hi b-lo))
 	(let ((e (+ (+ (- (* a-hi b-hi) p)
 		       (* a-hi b-lo)
 		       (* a-lo b-hi))
 		    (* a-lo b-lo))))
+	  (declare (double-float e))
 	  (values p e))))))
 
 (declaim (inline two-sqr))
 (defun two-sqr (a)
   "Compute fl(a*a) and err(a*b).  This is a more efficient
   implementation of two-prod"
-  (declare (double-float a))
+  (declare (double-float a)
+	   (optimize (speed 3) (safety 0)))
   (let ((q (* a a)))
+    (declare (double-float q))
     (multiple-value-bind (a-hi a-lo)
 	(split a)
+      (declare (double-float a-hi a-lo))
       (values q (+ (+ (- (* a-hi a-hi) q)
 		      (* 2 a-hi a-lo))
 		   (* a-lo a-lo))))))