[oct-cvs] Oct commit: oct qd-extra.lisp qd-fun.lisp qd-rep.lisp qd.lisp timing2.lisp

rtoy rtoy at common-lisp.net
Wed Nov 7 21:38:10 UTC 2007


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

Modified Files:
	qd-extra.lisp qd-fun.lisp qd-rep.lisp qd.lisp timing2.lisp 
Log Message:
Merge the changes from the THREE-ARG-BRANCH to HEAD.


--- /project/oct/cvsroot/oct/qd-extra.lisp	2007/10/26 15:48:15	1.5
+++ /project/oct/cvsroot/oct/qd-extra.lisp	2007/11/07 21:38:10	1.6
@@ -1099,14 +1099,14 @@
 ;; Time			Sparc	PPC	x86	PPC (fma)	Sparc2
 ;; exp-qd/reduce	2.06	 3.18	10.46	2.76		 6.12
 ;; expm1-qd/series	8.81	12.24	18.87	3.26		29.0
-;; expm1-qd/dup		5.68	 4.34	18.47	3.64		18.78
-;; exp-qd/pade          1.53
+;; expm1-qd/dup		5.68	 4.34	18.47	3.64		 9.77
+;; exp-qd/pade          1.53                                     4.51
 ;;
 ;; Consing (MB)		Sparc
 ;; exp-qd/reduce	 45   	 45   	 638   	44.4   		 45
 ;; expm1-qd/series	519   	519   	1201  	14.8   		519
 ;; expm1-qd/dup		 32   	 32   	1224   	32.0   		 32
-;; exp-qd/pade           44
+;; exp-qd/pade           44                                      44
 ;;
 ;; Speeds seem to vary quite a bit between architectures.
 ;;
--- /project/oct/cvsroot/oct/qd-fun.lisp	2007/10/18 14:38:56	1.90
+++ /project/oct/cvsroot/oct/qd-fun.lisp	2007/11/07 21:38:10	1.91
@@ -47,6 +47,7 @@
 
 #+cmu
 (declaim (ext:maybe-inline sqrt-qd))
+#+nil
 (defun sqrt-qd (a)
   "Square root of the (non-negative) quad-float"
   (declare (type %quad-double a)
@@ -79,6 +80,47 @@
 	(setf r (add-qd r (mul-qd r (sub-d-qd half (mul-qd h (sqr-qd r)))))))
       (scale-float-qd (mul-qd r new-a) (ash k -1)))))
 
+(defun sqrt-qd (a)
+  "Square root of the (non-negative) quad-float"
+  (declare (type %quad-double a)
+	   (optimize (speed 3) (space 0)))
+  ;; Perform the following Newton iteration:
+  ;;
+  ;;  x' = x + (1 - a * x^2) * x / 2
+  ;;
+  ;; which converges to 1/sqrt(a).
+  ;;
+  ;; However, there appear to be round-off errors when x is either
+  ;; very large or very small.  So let x = f*2^(2*k).  Then sqrt(x) =
+  ;; 2^k*sqrt(f), and sqrt(f) doesn't have round-off problems.
+  (when (zerop-qd a)
+    (return-from sqrt-qd a))
+  (when (float-infinity-p (qd-0 a))
+    (return-from sqrt-qd a))
+
+  (let* ((k (logandc2 (logb-finite (qd-0 a)) 1))
+	 (new-a (scale-float-qd a (- k))))
+    (assert (evenp k))
+    (let* ((r (make-qd-d (cl:/ (sqrt (the (double-float (0d0))
+				       (qd-0 new-a))))))
+	   (temp (%make-qd-d 0d0 0d0 0d0 0d0))
+	   (half 0.5d0)
+	   (h (mul-qd-d new-a half)))
+      (declare (type %quad-double r))
+      ;; Since we start with double-float precision, three more
+      ;; iterations should give us full accuracy.
+      (dotimes (k 3)
+	#+nil
+	(setf r (add-qd r (mul-qd r (sub-d-qd half (mul-qd h (sqr-qd r))))))
+	(sqr-qd r temp)
+	(mul-qd h temp temp)
+	(sub-d-qd half temp temp)
+	(mul-qd r temp temp)
+	(add-qd r temp r)
+	)
+      (mul-qd r new-a r)
+      (scale-float-qd r (ash k -1)))))
+
 (defun hypot-aux-qd (x y)
   (declare (type %quad-double x y))
   (let ((k (- (logb-finite (max (cl:abs (qd-0 x))
--- /project/oct/cvsroot/oct/qd-rep.lisp	2007/10/16 17:09:46	1.10
+++ /project/oct/cvsroot/oct/qd-rep.lisp	2007/11/07 21:38:10	1.11
@@ -81,6 +81,9 @@
 	   (kernel:%make-double-double-float a2 a3)))
 )
 
+(defmacro %store-qd-d (target q0 q1 q2 q3)
+  (declare (ignore target))
+  `(%make-qd-d ,q0 ,q1, q2, q3))
 
 (defun qd-parts (qd)
   "Extract the four doubles comprising a quad-double and return them
@@ -169,6 +172,15 @@
       (setf (aref ,a 3) ,a3)
       ,a)))
 
+(defmacro %store-qd-d (target q0 q1 q2 q3)
+  (let ((dest (gensym "TARGET-")))
+    `(let ((,dest ,target))
+       (setf (aref ,dest 0) ,q0)
+       (setf (aref ,dest 1) ,q1)
+       (setf (aref ,dest 2) ,q2)
+       (setf (aref ,dest 3) ,q3)
+       ,dest)))
+
 (defun qd-parts (qd)
   "Extract the four doubles comprising a quad-double and return them
   as multiple values.  The most significant double is the first value."
@@ -221,3 +233,81 @@
   (declare (ignore x))
   nil)
 ) ; end progn
+
+
+(macrolet
+    ((frob (qd qd-t)
+       #+cmu
+       `(define-compiler-macro ,qd (a b &optional c)
+	  (if c
+	      `(setf ,c (,',qd-t ,a ,b nil))
+	      `(,',qd-t ,a ,b nil)))
+       #-cmu
+       `(define-compiler-macro ,qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
+	  `(,',qd-t ,a ,b ,c))))
+  (frob add-qd add-qd-t)
+  (frob mul-qd mul-qd-t)
+  (frob div-qd div-qd-t)
+  (frob add-qd-d add-qd-d-t)
+  (frob mul-qd-d mul-qd-d-t))
+
+#+cmu
+(define-compiler-macro sub-qd (a b &optional c)
+  (if c
+      `(setf ,c (add-qd-t ,a (neg-qd ,b) nil))
+      `(add-qd-t ,a (neg-qd ,b) nil)))
+
+#-cmu
+(define-compiler-macro sub-qd (a b &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(add-qd-t ,a (neg-qd ,b) ,c))
+
+#+cmu
+(define-compiler-macro sqr-qd (a &optional c)
+  (if c
+      `(setf ,c (sqr-qd-t ,a nil))
+      `(sqr-qd-t ,a nil)))
+
+#-cmu
+(define-compiler-macro sqr-qd (a &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(sqr-qd-t ,a ,c))
+
+#+cmu
+(define-compiler-macro add-d-qd (a b &optional c)
+  (if c
+      `(setf ,c (add-qd-d ,b ,a))
+      `(add-qd-d ,b ,a)))
+
+#-cmu
+(define-compiler-macro add-d-qd (a b &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(add-qd-d ,b ,a ,c))
+
+#+cmu
+(define-compiler-macro sub-qd-d (a b &optional c)
+  (if c
+      `(setf ,c (add-qd-d ,a (cl:- ,b)))
+      `(add-qd-d ,a (cl:- ,b))))
+
+#-cmu
+(define-compiler-macro sub-qd-d (a b &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(add-qd-d ,a (cl:- ,b) ,c))
+
+#+cmu
+(define-compiler-macro sub-d-qd (a b &optional c)
+  (if c
+      `(setf ,c (add-d-qd ,a (neg-qd ,b)))
+      `(add-d-qd ,a (neg-qd ,b))))
+
+#-cmu
+(define-compiler-macro sub-d-qd (a b &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(add-d-qd ,a (neg-qd ,b) ,c))
+
+#+cmu
+(define-compiler-macro neg-qd (a &optional c)
+  (if c
+      `(setf ,c (neg-qd-t ,a nil))
+      `(neg-qd-t ,a nil)))
+
+#-cmu
+(define-compiler-macro neg-qd (a &optional (c #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  `(neg-qd-t ,a ,c))
+
--- /project/oct/cvsroot/oct/qd.lisp	2007/10/18 14:38:11	1.60
+++ /project/oct/cvsroot/oct/qd.lisp	2007/11/07 21:38:10	1.61
@@ -132,6 +132,7 @@
 		 add-d-qd
 		 add-dd-qd
 		 neg-qd
+		 neg-qd-t
 		 sub-qd
 		 sub-qd-dd
 		 sub-qd-d
@@ -159,13 +160,19 @@
 	 renorm-4
 	 renorm-5
 	 add-qd-d
+	 add-qd-d-t
 	 add-qd-dd
 	 add-qd
+	 add-qd-t
 	 mul-qd-d
+	 mul-qd-d-t
 	 mul-qd-dd
 	 mul-qd
+	 mul-qd-t
 	 sqr-qd
+	 sqr-qd-t
 	 div-qd
+	 div-qd-t
 	 div-qd-d
 	 div-qd-dd))
 
@@ -179,12 +186,15 @@
 			  make-qd-d
 			  add-qd-d add-d-qd add-qd-dd
 			  add-dd-qd
-			  add-qd
+			  add-qd add-qd-t
 			  neg-qd
 			  sub-qd sub-qd-dd sub-qd-d sub-d-qd
-			  mul-qd-d mul-qd-dd mul-qd
+			  mul-qd-d mul-qd-dd
+			  mul-qd
+			  mul-qd-t
 			  sqr-qd
 			  div-qd div-qd-d div-qd-dd
+			  div-qd-t
 			  make-qd-dd
 			  ))
 
@@ -293,13 +303,17 @@
 ;;;; Addition
 
 ;; Quad-double + double
-(defun add-qd-d (a b)
+(defun add-qd-d (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (add-qd-d-t a b target))
+  
+(defun add-qd-d-t (a b target)
   "Add a quad-double A and a double-float B"
   (declare (type %quad-double a)
 	   (double-float b)
 	   (optimize (speed 3)
 		     (space 0))
-	   (inline float-infinity-p))
+	   (inline float-infinity-p)
+	   #+cmu (ignore target))
   (let* ((c0 0d0)
 	 (e c0)
 	 (c1 c0)
@@ -309,21 +323,22 @@
     (two-sum c0 e (qd-0 a) b)
 
     (when (float-infinity-p c0)
-      (return-from add-qd-d (%make-qd-d c0 0d0 0d0 0d0)))
+      (return-from add-qd-d-t (%store-qd-d target c0 0d0 0d0 0d0)))
     (two-sum c1 e (qd-1 a) e)
     (two-sum c2 e (qd-2 a) e)
     (two-sum c3 e (qd-3 a) e)
     (multiple-value-bind (r0 r1 r2 r3)
 	(renorm-5 c0 c1 c2 c3 e)
       (if (and (zerop (qd-0 a)) (zerop b))
-	  (%make-qd-d c0 0d0 0d0 0d0)
-	  (%make-qd-d r0 r1 r2 r3)))))
+	  (%store-qd-d target c0 0d0 0d0 0d0)
+	  (%store-qd-d target r0 r1 r2 r3)))))
 
-(defun add-d-qd (a b)
+(defun add-d-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
   (declare (double-float a)
 	   (type %quad-double b)
-	   (optimize (speed 3)))
-  (add-qd-d b a))
+	   (optimize (speed 3))
+	   #+cmu (ignore target))
+  (add-qd-d b a #-cmu target))
 
 #+cmu
 (defun add-qd-dd (a b)
@@ -385,10 +400,16 @@
 ;; which don't do a very good job with dataflow.  CMUCL is one of
 ;; those compilers.
 
-(defun add-qd (a b)
+(defun add-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (add-qd-t a b target))
+
+
+(defun add-qd-t (a b target)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (ignore target))
   ;; This is the version that is NOT IEEE.  Should we use the IEEE
   ;; version?  It's quite a bit more complicated.
   ;;
@@ -407,7 +428,7 @@
 		 (inline float-infinity-p))
 
 	(when (float-infinity-p s0)
-	  (return-from add-qd (%make-qd-d s0 0d0 0d0 0d0)))
+	  (return-from add-qd-t (%store-qd-d target s0 0d0 0d0 0d0)))
 	(let ((v0 (cl:- s0 a0))
 	      (v1 (cl:- s1 a1))
 	      (v2 (cl:- s2 a2))
@@ -441,19 +462,27 @@
 		  (multiple-value-setq (s0 s1 s2 s3)
 		    (renorm-5 s0 s1 s2 s3 t0))
 		  (if (and (zerop a0) (zerop b0))
-		      (%make-qd-d (+ a0 b0) 0d0 0d0 0d0)
-		      (%make-qd-d s0 s1 s2 s3)))))))))))
+		      (%store-qd-d target (+ a0 b0) 0d0 0d0 0d0)
+		      (%store-qd-d target s0 s1 s2 s3)))))))))))
 
-(defun neg-qd (a)
-  (declare (type %quad-double a))
+;; Define some compiler macros to transform add-qd to add-qd-t
+;; directly.  For CMU, we always replace the parameter C with NIL
+;; because we don't use it.  For other Lisps, we create the necessary
+;; object and call add-qd-t.
+(defun neg-qd (a &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (neg-qd-t a target))
+
+(defun neg-qd-t (a target)
+  (declare (type %quad-double a)
+	   #+cmu (ignore target))
   (with-qd-parts (a0 a1 a2 a3)
       a
     (declare (double-float a0 a1 a2 a3))
-    (%make-qd-d (cl:- a0) (cl:- a1) (cl:- a2) (cl:- a3))))
+    (%store-qd-d target (cl:- a0) (cl:- a1) (cl:- a2) (cl:- a3))))
 
-(defun sub-qd (a b)
+(defun sub-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
   (declare (type %quad-double a b))
-  (add-qd a (neg-qd b)))
+  (add-qd-t a (neg-qd b) target))
 
 #+cmu
 (defun sub-qd-dd (a b)
@@ -461,16 +490,18 @@
 	   (type double-double-float b))
   (add-qd-dd a (cl:- b)))
 
-(defun sub-qd-d (a b)
+(defun sub-qd-d (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
   (declare (type %quad-double a)
-	   (type double-float b))
-  (add-qd-d a (cl:- b)))
+	   (type double-float b)
+	   #+cmu (ignore target))
+  (add-qd-d a (cl:- b) #-cmu target))
 
-(defun sub-d-qd (a b)
+(defun sub-d-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
   (declare (type double-float a)
-	   (type %quad-double b))
+	   (type %quad-double b)
+	   #+cmu (ignore target))
   ;; a - b = a + (-b)
-  (add-d-qd a (neg-qd b)))
+  (add-d-qd a (neg-qd b) #-cmu target))
   
 
 ;; Works
@@ -480,18 +511,22 @@
 ;; Clisp says
 ;; 14.142135623730950488016887242096980785696718753769480731766797379908L0
 ;;
-(defun mul-qd-d (a b)
+(defun mul-qd-d (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (mul-qd-d-t a b target))
+
+(defun mul-qd-d-t (a b target)
   "Multiply quad-double A with B"
   (declare (type %quad-double a)
 	   (double-float b)
 	   (optimize (speed 3)
 		     (space 0))
-	   (inline float-infinity-p))
+	   (inline float-infinity-p)
+	   #+cmu (ignore target))
   (multiple-value-bind (p0 q0)
       (two-prod (qd-0 a) b)
 
     (when (float-infinity-p p0)
-      (return-from mul-qd-d (%make-qd-d p0 0d0 0d0 0d0)))
+      (return-from mul-qd-d-t (%store-qd-d target p0 0d0 0d0 0d0)))
     (multiple-value-bind (p1 q1)
 	(two-prod (qd-1 a) b)
       (declare (double-float p1 q1))
@@ -511,8 +546,8 @@
 	    (multiple-value-bind (s0 s1 s2 s3)
 		(renorm-5 s0 s1 s2 s3 s4)
 	      (if (zerop s0)
-		  (%make-qd-d (float-sign p0 0d0) 0d0 0d0 0d0)
-		  (%make-qd-d s0 s1 s2 s3)))))))))
+		  (%store-qd-d target (float-sign p0 0d0) 0d0 0d0 0d0)
+		  (%store-qd-d target s0 s1 s2 s3)))))))))
 
 ;; a0 * b0                        0
 ;;      a0 * b1                   1
@@ -602,11 +637,17 @@
 ;;
 ;; Clisp says
 ;; 14.142135623730950488016887242096980785696718753769480731766797379908L0
-(defun mul-qd (a b)
+
+(defun mul-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (mul-qd-t a b target))
+
+(defun mul-qd-t (a b target)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
 		     (space 0))
-	   (inline float-infinity-p))
+	   (inline float-infinity-p)
+	   #+cmu
+	   (ignore target))
   (with-qd-parts (a0 a1 a2 a3)
       a
     (declare (double-float a0 a1 a2 a3))
@@ -617,7 +658,7 @@
 	  (two-prod a0 b0)
 	#+cmu
 	(when (float-infinity-p p0)
-	  (return-from mul-qd (%make-qd-d p0 0d0 0d0 0d0)))
+	  (return-from mul-qd-t (%store-qd-d target p0 0d0 0d0 0d0)))
 	(multiple-value-bind (p1 q1)
 	    (two-prod a0 b1)
 	  (multiple-value-bind (p2 q2)
@@ -662,8 +703,9 @@
 		      (multiple-value-bind (r0 r1 s0 s1)
 			  (renorm-5 p0 p1 s0 s1 s2)
 			(if (zerop r0)
-			    (%make-qd-d p0 0d0 0d0 0d0)
-			    (%make-qd-d r0 r1 s0 s1))))))))))))))
+			    (%store-qd-d target p0 0d0 0d0 0d0)
+			    (%store-qd-d target r0 r1 s0 s1))))))))))))))
+
 
 ;; This is the non-sloppy version.  I think this works just fine, but
 ;; since qd defaults to the sloppy multiplication version, we do the
@@ -766,11 +808,16 @@
 				    (multiple-value-call #'%make-qd-d
 				      (renorm-5 p0 p1 s0 t0 t1))))))))))))))))))))
 
-(defun sqr-qd (a)
+(defun sqr-qd (a &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (sqr-qd-t a target))
+
+(defun sqr-qd-t (a target)
   "Square A"
   (declare (type %quad-double a)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (ignore target))
   (multiple-value-bind (p0 q0)
       (two-sqr (qd-0 a))
     (multiple-value-bind (p1 q1)
@@ -810,14 +857,20 @@
 
 	      (multiple-value-bind (a0 a1 a2 a3)
 		  (renorm-5 p0 p1 p2 p3 p4)
-		(%make-qd-d a0 a1 a2 a3)))))))))
+		(%store-qd-d target a0 a1 a2 a3)))))))))
 	      
 
-(defun div-qd (a b)
+(defun div-qd (a b &optional (target #-cmu (%make-qd-d 0d0 0d0 0d0 0d0)))
+  (div-qd-t a b target))
+
+#+nil
+(defun div-qd-t (a b target)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
 		     (space 0))
-	   (inline float-infinity-p))
+	   (inline float-infinity-p)
+	   #+cmu
+	   (ignore target))
   (let ((a0 (qd-0 a))
 	(b0 (qd-0 b)))
     (let* ((q0 (cl:/ a0 b0))
@@ -825,18 +878,46 @@
 	   (q1 (cl:/ (qd-0 r) b0)))
 
       (when (float-infinity-p q0)
-	(return-from div-qd (%make-qd-d q0 0d0 0d0 0d0)))
+	(return-from div-qd-t (%store-qd-d target q0 0d0 0d0 0d0)))
       (setf r (sub-qd r (mul-qd-d b q1)))
       (let ((q2 (cl:/ (qd-0 r) b0)))
 	(setf r (sub-qd r (mul-qd-d b q2)))
 	(let ((q3 (cl:/ (qd-0 r) b0)))
 	  (multiple-value-bind (q0 q1 q2 q3)
 	      (renorm-4 q0 q1 q2 q3)
-	    (%make-qd-d q0 q1 q2 q3)))))))
+	    (%store-qd-d target q0 q1 q2 q3)))))))
+
+(defun div-qd-t (a b target)
+  (declare (type %quad-double a b)
+	   (optimize (speed 3)
+		     (space 0))
+	   (inline float-infinity-p)
+	   #+cmu
+	   (ignore target))
+  (let ((a0 (qd-0 a))
+	(b0 (qd-0 b)))
+    (let* ((q0 (cl:/ a0 b0))
+	   (r (%make-qd-d 0d0 0d0 0d0 0d0)))
+      (mul-qd-d b q0 r)
+      (sub-qd a r r)
+      (let* ((q1 (cl:/ (qd-0 r) b0))
+	     (temp (mul-qd-d b q1)))
+	(when (float-infinity-p q0)
+	  (return-from div-qd-t (%store-qd-d target q0 0d0 0d0 0d0)))
+	
+	(sub-qd r temp r)
+	(let ((q2 (cl:/ (qd-0 r) b0)))
+	  (mul-qd-d b q2 temp)
+	  (sub-qd r temp r)
+	  (let ((q3 (cl:/ (qd-0 r) b0)))
+	    (multiple-value-bind (q0 q1 q2 q3)
+		(renorm-4 q0 q1 q2 q3)
+	      (%store-qd-d target q0 q1 q2 q3))))))))
 
 (declaim (inline invert-qd))
 
-(defun invert-qd(v) ;; a quartic newton iteration for 1/v
+(defun invert-qd (v)
+  ;; a quartic newton iteration for 1/v
   ;; to invert v, start with a good guess, x.
   ;; let h= 1-v*x  ;; h is small
   ;; return x+ x*(h+h^2+h^3) . compute h3 in double-float
--- /project/oct/cvsroot/oct/timing2.lisp	2007/10/16 14:21:13	1.4
+++ /project/oct/cvsroot/oct/timing2.lisp	2007/11/07 21:38:10	1.5
@@ -117,140 +117,143 @@
 Test	    Time
 	qd	oct
 ----	-----------
-add	0.023	0.09
-mul	0.075	0.13
-div	0.299	0.29
-sqrt	0.105	0.11
-sin	0.115	0.14
-log	0.194	0.12
-
-Times are in sec for the test.  The default number of iterations were
-used.  Most of the timings match my expectations, including the log
-test.  Oct uses a different algorithm (Halley's method) which is
-faster (in Lisp) than the algorithm used in qd (Newtwon iteration).
+add	  0.23	  1.16
+mul	  0.749	  1.54
+div	  3.00	  3.11
+sqrt	 10.57	 12.2
+sin	 57.33	 64.5
+log	194	119
+
+Times are in microsec/operation for the test.  The default number of
+iterations were used.  Most of the timings match my expectations,
+including the log test.  Oct uses a different algorithm (Halley's
+method) which is faster (in Lisp) than the algorithm used in qd
+(Newtwon iteration).
 
+Not also that these times include the 3-arg versions of the routines.
 
 -------------------------------------------------------------------------------
 The raw data:
 
 The output from qd_timer -qd -v:
 
+Timing qd_real
+--------------
+
 Timing addition...
-n = 100000   t = 0.0231462
-b = 1.428571e+04
-100000 operations in 0.0231462 s.
-  0.231462 us
+n = 1000000   t = 0.236154
+b = 142857.142857
+1000000 operations in 0.236154 s.
+  0.236154 us
 
 Timing multiplication ...
-n = 100000   t = 0.0749929
-b = 2.718268e+00
-100000 operations in 0.0749929 s.
-  0.749929 us
+n = 1000000   t = 0.748933
+b = 2.718280
+1000000 operations in 0.748933 s.
+  0.748933 us
 
 Timing division ...
-n = 100000   t = 0.298858
-b = 0.367881
-100000 operations in 0.298858 s.
-  2.988580 us
+n = 1000000   t = 3.004328
+b = 0.367880
+1000000 operations in 3.004328 s.
+  3.004328 us
 
 Timing square root ...
-n = 10000   t = 0.105049
+n = 100000   t = 1.057170
 a = 2.821980
-10000 operations in 0.105049 s.
- 10.504860 us
+100000 operations in 1.057170 s.
+ 10.571696 us
 
 Timing sin ...
-n = 2000   t = 0.114943
+n = 20000   t = 1.146667
 a = 3.141593
-2000 operations in 0.114943 s.
- 57.471350 us
+20000 operations in 1.146667 s.
+ 57.333335 us
 
 Timing log ...
-n = 1000   t = 0.193698
+n = 10000   t = 1.939869
 a = -50.100000
-1000 operations in 0.193698 s.
-193.697800 us
-The output from CMUCL:
+10000 operations in 1.939869 s.
+193.986900 us
+
+--------------------------------------------------
+CMUCL results:
 
-QD> (time-add)
+CL-USER> (oct::time-add 1000000)
 
 ; Evaluation took:
-;   0.09 seconds of real time
-;   0.1 seconds of user run time
-;   0.0 seconds of system run time
-;   147,285,856 CPU cycles
+;   1.16 seconds of real time
+;   0.98 seconds of user run time
+;   0.18 seconds of system run time
+;   1,845,637,904 CPU cycles
 ;   0 page faults and
-;   7,200,016 bytes consed.
+;   72,000,248 bytes consed.
 ; 
-n = 100000
-b = #q14285.7142857142857142857142857142857142857142857142857142857142855q0
-NIL
-QD> (time-mul)
+n = 1000000
+b = #q142857.142857142857142857142857142857142857142857142857142857142854q0
+
+CL-USER> (oct::time-mul 1000000)
 
 ; Evaluation took:
-;   0.13 seconds of real time
-;   0.1 seconds of user run time
-;   0.02 seconds of system run time
-;   203,790,588 CPU cycles
+;   1.53 seconds of real time
+;   1.27 seconds of user run time
+;   0.25 seconds of system run time
+;   2,430,859,732 CPU cycles
 ;   0 page faults and
-;   7,200,824 bytes consed.
+;   72,000,248 bytes consed.
 ; 
-n = 100000
-b = #q2.71826823717448966803506482442604644797444693267782286300915989397q0
-NIL
-QD> (time-div)
+n = 1000000
+b = #q2.71828046931937688381979970845435639275164502668250771294016782123q0
+
+CL-USER> (oct::time-div 1000000)
 
 ; Evaluation took:
-;   0.29 seconds of real time
-;   0.28 seconds of user run time
-;   0.01 seconds of system run time
-;   460,956,912 CPU cycles
+;   3.11 seconds of real time
+;   2.94 seconds of user run time
+;   0.16 seconds of system run time
+;   4,957,512,968 CPU cycles
 ;   0 page faults and
-;   7,200,016 bytes consed.
+;   72,000,248 bytes consed.
 ; 
-n = 100000
-b = #q0.36788128056098406210328658773118942247132502490133718973918140856q0
-NIL
-QD> (time-sqrt 10000)
+n = 1000000
+b = #q0.367879625111086265804761271038216553876450599098470428879260437304q0
+CL-USER> (oct::time-sqrt 100000)
 
 ; Evaluation took:
-;   0.11 seconds of real time
-;   0.1 seconds of user run time
-;   0.0 seconds of system run time
-;   173,209,708 CPU cycles
+;   1.22 seconds of real time
+;   1.1 seconds of user run time
+;   0.1 seconds of system run time
+;   1,938,798,996 CPU cycles
 ;   0 page faults and
-;   2,402,560 bytes consed.
+;   24,000,128 bytes consed.
 ; 
-n = 10000
+n = 100000
 a = #q2.82198033014704783016853125515542796898998765943212617578596649019q0
-NIL
-QD> (time-sin)
+
+CL-USER> (oct::time-sin 20000)
 
 ; Evaluation took:
-;   0.14 seconds of real time
-;   0.14 seconds of user run time
-;   0.0 seconds of system run time
-;   213,378,476 CPU cycles
+;   1.29 seconds of real time
+;   1.24 seconds of user run time
+;   0.05 seconds of system run time
+;   2,053,157,408 CPU cycles
 ;   0 page faults and
-;   3,105,800 bytes consed.
+;   27,751,144 bytes consed.
 ; 
-n = 2000
-a = #q3.14159265358979323846264338327950288419716939937510582097494459409q0
-NIL
-QD> (time-log)
+n = 20000
+a = #q3.14159265358979323846264338327950288419716939937510582097494458294q0
+
+CL-USER> (oct::time-log 10000)
 
 ; Evaluation took:
-;   0.12 seconds of real time
-;   0.12 seconds of user run time
-;   0.01 seconds of system run time
-;   192,187,304 CPU cycles
+;   1.19 seconds of real time
+;   1.13 seconds of user run time
+;   0.04 seconds of system run time
+;   1,890,677,952 CPU cycles
 ;   0 page faults and
-;   1,621,792 bytes consed.
+;   16,197,536 bytes consed.
 ; 
-n = 1000
-a = #q-50.100000000000000000000000000000000000000000000000000000000208796q0
-NIL
-QD> 
+n = 10000
+a = #q-50.100000000000000000000000000000000000000000000000000000552824575q0
 
----------------------------------------------
 ||#




More information about the oct-cvs mailing list