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)