Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv23636
Modified Files: qd-const.lisp qd-dd.lisp qd-fun.lisp qd-io.lisp qd-rep.lisp qd-test.lisp qd.lisp Log Message: o Oops. Fix up a few IN-PACKAGE's for the new package names.
qd-fun.lisp: o Comment out the old sin/cos routines o Fix a few mistakes in accurate-sincos-qd o Rename accurate-sincos-qd to sincos-qd.
--- /project/oct/cvsroot/oct/qd-const.lisp 2007/10/14 18:38:14 1.18 +++ /project/oct/cvsroot/oct/qd-const.lisp 2007/10/15 18:53:43 1.19 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE.
-(in-package #:qdi) +(in-package #:octi)
(defconstant +qd-zero+ (make-qd-d 0d0)) --- /project/oct/cvsroot/oct/qd-dd.lisp 2007/09/16 05:04:04 1.10 +++ /project/oct/cvsroot/oct/qd-dd.lisp 2007/10/15 18:53:44 1.11 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE.
-(in-package #:qdi) +(in-package #:octi)
;;; double-double float routines needed for quad-double. ;;; --- /project/oct/cvsroot/oct/qd-fun.lisp 2007/10/15 18:21:46 1.84 +++ /project/oct/cvsroot/oct/qd-fun.lisp 2007/10/15 18:53:44 1.85 @@ -32,7 +32,7 @@ ;;; argument is real and the result is real. Behavior is undefined if ;;; this doesn't hold.
-(in-package #:qdi) +(in-package #:octi)
(defun logb-finite (x) "Same as logb but X is not infinity and non-zero and not a NaN, so @@ -370,7 +370,11 @@ (declare (type %quad-double a b)) (let ((n (nint-qd (div-qd a b)))) (values n (sub-qd a (mul-qd n b))))) - + +;; Old, original routines. These are correct, but they don't handle +;; large args because drem-qd isn't accurate enough. +#+(or) +(progn (defun sin-qd (a) "Sin(a)" (declare (type %quad-double a)) @@ -611,6 +615,7 @@ ;; cos(j*pi/2) = -1, sin(j*pi/2) = 0 (values (neg-qd s) (neg-qd c)))))))))))) +)
;; A more accurate implementation of sin and cos. We use a more ;; accurate argument reduction using 1584 bits of 2/pi. This makes @@ -848,21 +853,20 @@ ;; cos(j*pi/2) = 0, sin(j*pi/2) = -1 s))))))))
-(defun accurate-sincos-qd (a) +(defun sincos-qd (a) (declare (type %quad-double a)) (when (zerop-qd a) - (return-from accurate-sincos-qd + (return-from sincos-qd (values +qd-zero+ +qd-one+)))
(multiple-value-bind (j r) (rem-pi/2 a) (multiple-value-bind (k tmp) - (divrem-qd tmp +qd-pi/1024+) + (divrem-qd r +qd-pi/1024+) (let* ((k (truncate (qd-0 k))) - (abs-j (abs j)) (abs-k (abs k))) - (assert (<= abs-j 2)) + (assert (<= 0 j 3)) (assert (<= abs-k 256)) ;; Compute sin(s) and cos(s) (multiple-value-bind (sin-t cos-t) @@ -900,7 +904,7 @@ (format t "c = ~/qd::qd-format/~%" c)) ;; sin(x) = sin(s+k*pi/1024) * cos(j*pi/2) ;; + cos(s+k*pi/1024) * sin(j*pi/2) - (cond ((zerop abs-j) + (cond ((zerop j) ;; cos(j*pi/2) = 1, sin(j*pi/2) = 0 (values s c)) ((= j 1) @@ -912,7 +916,7 @@ (neg-qd c))) ((= j 3) ;; cos(j*pi/2) = 0, sin(j*pi/2) = -1 - (values (neg-qd c) s)))))))))) + (values (neg-qd c) s)))))))))
(defun atan2-qd/newton (y x) (declare (type %quad-double y x) --- /project/oct/cvsroot/oct/qd-io.lisp 2007/10/15 18:21:46 1.19 +++ /project/oct/cvsroot/oct/qd-io.lisp 2007/10/15 18:53:44 1.20 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE.
-(in-package #:qdi) +(in-package #:octi)
;; Smallest exponent for a double-float. (eval-when (:compile-toplevel :load-toplevel :execute) --- /project/oct/cvsroot/oct/qd-rep.lisp 2007/09/18 11:20:16 1.7 +++ /project/oct/cvsroot/oct/qd-rep.lisp 2007/10/15 18:53:44 1.8 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE.
-(in-package #:qdi) +(in-package #:octi)
;;; This file contains the actual representation of a %quad-double ;;; number. The only real requirement for a %quad-double number is an --- /project/oct/cvsroot/oct/qd-test.lisp 2007/10/15 18:21:47 1.20 +++ /project/oct/cvsroot/oct/qd-test.lisp 2007/10/15 18:53:44 1.21 @@ -24,7 +24,7 @@ ;;;; OTHER DEALINGS IN THE SOFTWARE.
-(in-package #:qdi) +(in-package #:octi)
;; Compute to how many bits EST and TRUE are equal. If they are ;; identical, return T. --- /project/oct/cvsroot/oct/qd.lisp 2007/10/15 15:45:33 1.56 +++ /project/oct/cvsroot/oct/qd.lisp 2007/10/15 18:53:44 1.57 @@ -36,7 +36,7 @@ ;;; to support quad-doubles.
-(in-package #:qdi) +(in-package #:octi)
#+cmu (eval-when (:compile-toplevel)