[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