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

13 Sep 2007

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))))))

    