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

[rtoy]

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

Modified Files:
	qd-fun.lisp qd-io.lisp qd.lisp 
Log Message:
qd-fun.lisp:
o Remove unused var R1 in EXP-QD/REDUCE.
o TAN-QD was calling ZEROP instead of ZEROP-QD.
o Comment out extra copy of ASINH-QD.

qd-io.lisp:
o Ignore unused var in QD-PRINT-EXPONENT and QD-READER.

qd.lisp:
o Remove extra version of DIV-QD.


--- /project/oct/cvsroot/oct/qd-fun.lisp	2007/08/25 17:08:48	1.79
+++ /project/oct/cvsroot/oct/qd-fun.lisp	2007/09/12 02:31:14	1.80
@@ -160,8 +160,6 @@
 
   (let* ((k 256)
 	 (z (truncate (qd-0 (nint-qd (div-qd a +qd-log2+)))))
-	 (r1 (sub-qd a (mul-qd-d +qd-log2+ (float z 1d0))))
-	 ;; r as above
 	 (r (div-qd-d (sub-qd a (mul-qd-d +qd-log2+ (float z 1d0)))
 		      (float k 1d0)))
 	 ;; For Taylor series.  p = r^2/2, the first term
@@ -740,7 +738,7 @@
 (defun tan-qd (r)
   "Tan(r)"
   (declare (type %quad-double r))
-  (if (zerop r)
+  (if (zerop-qd r)
       r
       (tan-qd/sincos r)))
   
@@ -810,6 +808,7 @@
 		(d (expm1-qd a2)))
 	   (div-qd d (add-qd-d d 2d0))))))
 
+#+(or)
 (defun asinh-qd (a)
   "Asinh(a)"
   (declare (type %quad-double a))
--- /project/oct/cvsroot/oct/qd-io.lisp	2007/08/27 17:49:19	1.14
+++ /project/oct/cvsroot/oct/qd-io.lisp	2007/09/12 02:31:14	1.15
@@ -151,6 +151,7 @@
 	    (scale r s m+ m-)))))))
 
 (defun qd-print-exponent (x exp stream)
+  (declare (ignore x))
   (let ((*print-radix* nil))
     (format stream "q~D" exp)))
 
@@ -461,6 +462,7 @@
 	(make-float sign int-part frac-part scale exp)))))
 
 (defun qd-reader (stream subchar arg)
+  (declare (ignore subchar arg))
   (read-qd stream))
 
 (defun qd-from-string (string)
--- /project/oct/cvsroot/oct/qd.lisp	2007/08/25 17:08:48	1.45
+++ /project/oct/cvsroot/oct/qd.lisp	2007/09/12 02:31:14	1.46
@@ -819,7 +819,6 @@
 		  (renorm-5 p0 p1 p2 p3 p4))))))))))
 	      
 
-#-cmu
 (defun div-qd (a b)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
@@ -840,25 +839,6 @@
 	      (renorm-4 q0 q1 q2 q3)
 	    (%make-qd-d q0 q1 q2 q3)))))))
 
-(defun div-qd (a b)
-  (declare (type %quad-double a b)
-	   (optimize (speed 3)
-		     (space 0)))
-  (let ((a0 (qd-0 a))
-	(b0 (qd-0 b)))
-    (let* ((q0 (cl:/ a0 b0))
-	   (r (sub-qd a (mul-qd-d b q0)))
-	   (q1 (cl:/ (qd-0 r) b0)))
-      (when (float-infinity-p q0)
-	(return-from div-qd (%make-qd-d 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)))))))
-
 ;; Non-sloppy divide
 #+(or)
 (defun div-qd (a b)