[oct-cvs] Oct commit: oct qd-const.lisp qd-dd.lisp qd-fun.lisp qd-io.lisp qd-rep.lisp qd-test.lisp qd.lisp
rtoy
rtoy at common-lisp.net
Mon Oct 15 18:53:44 UTC 2007
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)
More information about the oct-cvs
mailing list