February 2011 - oct-cvs - mailman3.common-lisp.net

[oct-scm] [oct-git]OCT: A portable Lisp implementation for quad-double precision floats branch master updated. 6ab0812b935e4fa1c63ba9f5d58f7e66eb6f375b
by Raymond Toy 12 Feb '11

12 Feb '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "OCT: A portable Lisp implementation for quad-double precision floats". The branch, master has been updated via 6ab0812b935e4fa1c63ba9f5d58f7e66eb6f375b (commit) via 738d3980f615a396fa87b62fa6e8edc5a1a59f2f (commit) via bf28d710e15cc99061b17bd46c68f4945afcfe80 (commit) from 0804332c622d188cd923e2101ce354f9732d7371 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 6ab0812b935e4fa1c63ba9f5d58f7e66eb6f375b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Feb 13 01:33:47 2011 -0500 The TARGET parameter is not a %QUAD-DOUBLE if we're not using arrays to represent a %quad-double. diff --git a/qd.lisp b/qd.lisp index 0e58e4a..2b72769 100644 --- a/qd.lisp +++ b/qd.lisp @@ -315,7 +315,7 @@ If TARGET is given, TARGET is destructively modified to contain the result." (defun add-qd-d-t (a b target) "Add a quad-double A and a double-float B" - (declare (type %quad-double a target) + (declare (type %quad-double a #+oct-array target) (double-float b) (optimize (speed 3) (space 0)) @@ -416,7 +416,7 @@ If TARGET is given, TARGET is destructively modified to contain the result." (defun add-qd-t (a b target) - (declare (type %quad-double a b target) + (declare (type %quad-double a b #+oct-array target) (optimize (speed 3) (space 0)) #+(and cmu (not oct-array)) @@ -482,7 +482,7 @@ If TARGET is given, TARGET is destructively modified to contain the result." (neg-qd-t a target)) (defun neg-qd-t (a target) - (declare (type %quad-double a target) + (declare (type %quad-double a #+oct-array target) #+(and cmu (not oct-array)) (ignore target)) (with-qd-parts (a0 a1 a2 a3) a @@ -542,7 +542,7 @@ If TARGET is given, TARGET is destructively modified to contain the result." (defun mul-qd-d-t (a b target) "Multiply quad-double A with B" - (declare (type %quad-double a target) + (declare (type %quad-double a #+oct-array target) (double-float b) (optimize (speed 3) (space 0)) @@ -670,7 +670,7 @@ If TARGET is given, TARGET is destructively modified to contain the result." (mul-qd-t a b target)) (defun mul-qd-t (a b target) - (declare (type %quad-double a b target) + (declare (type %quad-double a b #+oct-array target) (optimize (speed 3) (space 0)) (inline float-infinity-p) @@ -843,7 +843,7 @@ it is destructively modified with the result." (defun sqr-qd-t (a target) "Square A" - (declare (type %quad-double a target) + (declare (type %quad-double a #+oct-array target) (optimize (speed 3) (space 0)) #+(and cmu (not oct-array)) @@ -920,7 +920,7 @@ If TARGET is given, it destrutively modified with the result." (%store-qd-d target q0 q1 q2 q3))))))) (defun div-qd-t (a b target) - (declare (type %quad-double a b target) + (declare (type %quad-double a b #+oct-array target) (optimize (speed 3) (space 0)) (inline float-infinity-p) commit 738d3980f615a396fa87b62fa6e8edc5a1a59f2f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Feb 13 01:11:21 2011 -0500 Ignore *~. diff --git a/.gitignore b/.gitignore index 44c8368..39ef52b 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,6 @@ *.sparcf *.fasl *.err +*~ + commit bf28d710e15cc99061b17bd46c68f4945afcfe80 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Feb 13 01:10:31 2011 -0500 Ignore *.err files. diff --git a/.gitignore b/.gitignore index 77c698b..44c8368 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ *.x86f *.sparcf *.fasl +*.err + ----------------------------------------------------------------------- Summary of changes: .gitignore | 4 ++++ qd.lisp | 14 +++++++------- 2 files changed, 11 insertions(+), 7 deletions(-) hooks/post-receive -- OCT: A portable Lisp implementation for quad-double precision floats

1 0

[oct-scm] [oct-git]OCT: A portable Lisp implementation for quad-double precision floats branch master updated. 0804332c622d188cd923e2101ce354f9732d7371
by Raymond Toy 10 Feb '11

10 Feb '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "OCT: A portable Lisp implementation for quad-double precision floats". The branch, master has been updated via 0804332c622d188cd923e2101ce354f9732d7371 (commit) from 60c71048cdad98a46dec988dd46739b28b479683 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 0804332c622d188cd923e2101ce354f9732d7371 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 10 21:48:25 2011 -0500 Fix typo and add tests for atanh o Fix typo in number in for test oct.atan-branch-pos.2 o Add tests for atanh branch cuts. diff --git a/rt-tests.lisp b/rt-tests.lisp index 3368c3d..b87100e 100644 --- a/rt-tests.lisp +++ b/rt-tests.lisp @@ -724,7 +724,7 @@ (rt:deftest oct.atan-branch-pos.2 (let ((true (cl:atan #c(1d-20 2d0)))) - (check-signs #'atan #q(0d0 2 0d0) true)) + (check-signs #'atan #q(0d0 2d0) true)) t) (rt:deftest oct.atan-branch-pos.3 @@ -737,7 +737,24 @@ (check-signs #'atan #q(-0d0 2d0) true)) t) +;; Test x < -1 +(rt:deftest oct.atanh-branch-neg.1 + (let ((true (cl:atanh #c(-2d0 -1d-20)))) + (check-signs #'atanh -2d0 true)) + t) +(rt:deftest oct.atanh-branch-neg.2 + (let ((true (cl:atanh #c(-2d0 -1d-20)))) + (check-signs #'atanh #q-2 true)) + t) +;; Test x > 1 +(rt:deftest oct.atanh-branch-pos.1 + (let ((true (cl:atanh #c(2d0 1d-20)))) + (check-signs #'atanh 2d0 true)) + t) - +(rt:deftest oct.atanh-branch-pos.2 + (let ((true (cl:atanh #c(2d0 1d-20)))) + (check-signs #'atanh #q2 true)) + t) ----------------------------------------------------------------------- Summary of changes: rt-tests.lisp | 21 +++++++++++++++++++-- 1 files changed, 19 insertions(+), 2 deletions(-) hooks/post-receive -- OCT: A portable Lisp implementation for quad-double precision floats

1 0

[oct-cvs] [SCM] OCT: A portable Lisp implementation for quad-double precision floats branch master updated. 60c71048cdad98a46dec988dd46739b28b479683
by Raymond Toy 10 Feb '11

10 Feb '11

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "OCT: A portable Lisp implementation for quad-double precision floats". The branch, master has been updated via 60c71048cdad98a46dec988dd46739b28b479683 (commit) from c0616d4d0d668655893d703a2612bfa4c25a74a4 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 60c71048cdad98a46dec988dd46739b28b479683 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Feb 10 10:36:47 2011 -0500 Ignore more fasl files ----------------------------------------------------------------------- Summary of changes: .gitignore | 3 +++ 1 files changed, 3 insertions(+), 0 deletions(-) hooks/post-receive -- OCT: A portable Lisp implementation for quad-double precision floats

1 0

[oct-cvs] Oct commit: oct oct.asd oct.system qd-package.lisp
by rtoy 09 Feb '11

09 Feb '11

Update of /project/oct/cvsroot/oct In directory cl-net:/tmp/cvs-serv5714 Modified Files: oct.asd oct.system qd-package.lisp Log Message: Move the configuration stuff out of the system definition files and place them in qd-package.lisp. --- /project/oct/cvsroot/oct/oct.asd 2010/06/15 17:38:21 1.4 +++ /project/oct/cvsroot/oct/oct.asd 2011/02/09 19:36:15 1.5 @@ -1,6 +1,6 @@ ;;;; -*- Mode: lisp -*- ;;;; -;;;; Copyright (c) 2007 Raymond Toy +;;;; Copyright (c) 2007, 2011 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation @@ -26,36 +26,6 @@ ;;; This is the asdf definition for oct. I don't normally use this, ;;; so it might be out of date. Use at your own risk. -;; If you want all core functions to be inline (like the C++ code -;; does), add :qd-inline to *features* by enabling the following line. -;; This makes compilation much, much slower, but the resulting code -;; conses much less and is significantly faster. -#+(not (and cmu x86)) -(eval-when (:load-toplevel :compile-toplevel :execute) - (pushnew :qd-inline *features*)) - -;; To be able to inline all the functions, we need to make -;; *inline-expansion-limit* much larger. -;; -;; Not sure we really want to inline everything, but the QD C++ code -;; inlines all of the functions so we do the same. This makes CMUCL -;; take a very long time to compile the code, and the resulting -;; functions are huge. (I think div-qd is 8 KB, and sqrt-qd is a -;; whopping 30 KB!) -;; -#+(and cmu qd-inline) -(eval-when (:load-toplevel :compile-toplevel :execute) - (setf ext:*inline-expansion-limit* 1600)) - -;; -;; For all Lisps other than CMUCL, oct uses arrays to store the -;; quad-double values. This is denoted by the feature :oct-array. -;; For CMUCL, quad-doubles can be stored in a (complex -;; double-double-float) object, which is an extension in CMUCL. -;; If you want CMUCL to use an array too, add :oct-array to *features*. -#-cmu -(pushnew :oct-array *features*) - (defpackage #:oct-system (:use #:cl)) @@ -66,7 +36,7 @@ :author "Raymond Toy" :maintainer "See <http://www.common-lisp.net/project/oct>" :licence "MIT" - :version "0.0" ; No real version yet + :version "2011-02-09" ; Just use the date :components ((:file "qd-package") (:file "qd-rep" :depends-on ("qd-package")) --- /project/oct/cvsroot/oct/oct.system 2010/06/15 18:26:39 1.25 +++ /project/oct/cvsroot/oct/oct.system 2011/02/09 19:36:15 1.26 @@ -24,37 +24,6 @@ ;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:cl-user) -;; If you want all core functions to be inline (like the C++ code -;; does), add :qd-inline to *features* by enabling the following line. -;; This makes compilation much, much slower, but the resulting code -;; conses much less and is significantly faster. -#+(not (and cmu x86)) -(eval-when (:load-toplevel :compile-toplevel :execute) - (pushnew :qd-inline *features*)) - -;; To be able to inline all the functions, we need to make -;; *inline-expansion-limit* much larger. -;; -;; Not sure we really want to inline everything, but the QD C++ code -;; inlines all of the functions so we do the same. This makes CMUCL -;; take a very long time to compile the code, and the resulting -;; functions are huge. (I think div-qd is 8 KB, and sqrt-qd is a -;; whopping 30 KB!) -;; -#+(and cmu qd-inline) -(eval-when (:load-toplevel :compile-toplevel :execute) - (setf ext:*inline-expansion-limit* 1600)) - -;; -;; For all Lisps other than CMUCL, oct uses arrays to store the -;; quad-double values. This is denoted by the feature :oct-array. -;; For CMUCL, quad-doubles can be stored in a (complex -;; double-double-float) object, which is an extension in CMUCL. -;; If you want CMUCL to use an array too, add :oct-array to *features*. -#-cmu -(pushnew :oct-array *features*) - - (mk:defsystem oct :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) :components --- /project/oct/cvsroot/oct/qd-package.lisp 2007/10/16 02:39:22 1.44 +++ /project/oct/cvsroot/oct/qd-package.lisp 2011/02/09 19:36:15 1.45 @@ -1,6 +1,6 @@ ;;;; -*- Mode: lisp -*- ;;;; -;;;; Copyright (c) 2007 Raymond Toy +;;;; Copyright (c) 2007, 2011 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation @@ -23,6 +23,36 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. +;; If you want all core functions to be inline (like the C++ code +;; does), add :qd-inline to *features* by enabling the following line. +;; This makes compilation much, much slower, but the resulting code +;; conses much less and is significantly faster. +#+(not (and cmu x86)) +(eval-when (:load-toplevel :compile-toplevel :execute) + (pushnew :qd-inline *features*)) + +;; To be able to inline all the functions, we need to make +;; *inline-expansion-limit* much larger. +;; +;; Not sure we really want to inline everything, but the QD C++ code +;; inlines all of the functions so we do the same. This makes CMUCL +;; take a very long time to compile the code, and the resulting +;; functions are huge. (I think div-qd is 8 KB, and sqrt-qd is a +;; whopping 30 KB!) +;; +#+(and cmu qd-inline) +(eval-when (:load-toplevel :compile-toplevel :execute) + (setf ext:*inline-expansion-limit* 1600)) + +;; +;; For all Lisps other than CMUCL, oct uses arrays to store the +;; quad-double values. This is denoted by the feature :oct-array. +;; For CMUCL, quad-doubles can be stored in a (complex +;; double-double-float) object, which is an extension in CMUCL. +;; If you want CMUCL to use an array too, add :oct-array to *features*. +#-cmu +(pushnew :oct-array *features*) + (defpackage #:oct-internal (:use #:cl) (:nicknames #:octi)

1 0

[oct-cvs] Oct commit: oct rt-tests.lisp
by rtoy 09 Feb '11

09 Feb '11

Update of /project/oct/cvsroot/oct In directory cl-net:/tmp/cvs-serv613 Modified Files: rt-tests.lisp Log Message: Add additional tests. These are taken from branch-test.lisp. --- /project/oct/cvsroot/oct/rt-tests.lisp 2007/10/15 18:21:47 1.5 +++ /project/oct/cvsroot/oct/rt-tests.lisp 2011/02/09 19:29:05 1.6 @@ -1,6 +1,6 @@ ;;;; -*- Mode: lisp -*- ;;;; -;;;; Copyright (c) 2007 Raymond Toy +;;;; Copyright (c) 2007,2011 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation @@ -574,3 +574,170 @@ (list frac exp s))) nil) +;;; +;;; Add a few tests for the branch cuts. Many of these tests assume +;;; that Lisp has support for signed zeroes. If not, these tests are +;;; probably wrong. + +(defun check-signs (fun arg expected) + (let* ((z (funcall fun arg)) + (x (realpart z)) + (y (imagpart z))) + (if (and (= (float-sign x) (float-sign (realpart expected))) + (= (float-sign y) (float-sign (imagpart expected)))) + t + (list z expected fun arg)))) + +;; asin has a branch cut on the real axis |x|>1. For x < -1, it is +;; continuous with quadrant II; for x > 1, continuous with quadrant +;; IV. +(rt:deftest oct.asin-branch-neg.1 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin -2d0 true)) + t) + +(rt:deftest oct.asin-branch-neg.2 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin #q-2 true)) + t) + +(rt:deftest oct.asin-branch-neg.3 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin #c(-2d0 0d0) true)) + t) + +(rt:deftest oct.asin-branch-neg.4 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin #q(-2 0) true)) + t) + +(rt:deftest oct.asin-branch-neg.5 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin #c(-2d0 -0d0) (conjugate true))) + t) + +(rt:deftest oct.asin-branch-neg.6 + (let ((true (cl:asin #c(-2d0 1d-20)))) + (check-signs #'asin #q(-2d0 -0d0) (conjugate true))) + t) + +(rt:deftest oct.asin-branch-pos.1 + (let ((true (cl:asin #c(2d0 -1d-20)))) + (check-signs #'asin #c(2d0 0d0) (conjugate true))) + t) + +(rt:deftest oct.asin-branch-pos.2 + (let ((true (cl:asin #c(2d0 -1d-20)))) + (check-signs #'asin #q(2 0d0) (conjugate true))) + t) + +(rt:deftest oct.asin-branch-pos.3 + (let ((true (cl:asin #c(2d0 -1d-20)))) + (check-signs #'asin #c(2d0 -0d0) true)) + t) + +(rt:deftest oct.asin-branch-pos.4 + (let ((true (cl:asin #c(2d0 -1d-20)))) + (check-signs #'asin #q(2d0 -0d0) true)) + t) + +;; acos branch cut is the real axis, |x| > 1. For x < -1, it is +;; continuous with quadrant II; for x > 1, quadrant IV. + +(rt:deftest oct.acos-branch-neg.1 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos -2d0 true)) + t) + +(rt:deftest oct.acos-branch-neg.2 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos #q-2 true)) + t) + +(rt:deftest oct.acos-branch-neg.3 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos #c(-2d0 0d0) true)) + t) + +(rt:deftest oct.acos-branch-neg.4 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos #q(-2 0) true)) + t) + +(rt:deftest oct.acos-branch-neg.5 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos #c(-2d0 -0d0) (conjugate true))) + t) + +(rt:deftest oct.acos-branch-neg.6 + (let ((true (cl:acos #c(-2d0 1d-20)))) + (check-signs #'acos #q(-2d0 -0d0) (conjugate true))) + t) + +(rt:deftest oct.acos-branch-pos.1 + (let ((true (cl:acos #c(2d0 -1d-20)))) + (check-signs #'acos #c(2d0 0d0) (conjugate true))) + t) + +(rt:deftest oct.acos-branch-pos.2 + (let ((true (cl:acos #c(2d0 -1d-20)))) + (check-signs #'acos #q(2 0d0) (conjugate true))) + t) + +(rt:deftest oct.acos-branch-pos.3 + (let ((true (cl:acos #c(2d0 -1d-20)))) + (check-signs #'acos #c(2d0 -0d0) true)) + t) + +(rt:deftest oct.acos-branch-pos.4 + (let ((true (cl:acos #c(2d0 -1d-20)))) + (check-signs #'acos #q(2d0 -0d0) true)) + t) + +;; atan branch cut is the imaginary axis, |y| > 1. For y < -1, it is +;; continuous with quadrant IV; for x > 1, quadrant II. + +(rt:deftest oct.atan-branch-neg.1 + (let ((true (cl:atan #c(1d-20 -2d0)))) + (check-signs #'atan #c(0d0 -2d0) true)) + t) + +(rt:deftest oct.atan-branch-neg.2 + (let ((true (cl:atan #c(1d-20 -2d0)))) + (check-signs #'atan #q(0 -2) true)) + t) + +(rt:deftest oct.atan-branch-neg.3 + (let ((true (cl:atan #c(-1d-20 -2d0)))) + (check-signs #'atan #c(-0d0 -2d0) true)) + t) + +(rt:deftest oct.atan-branch-neg.4 + (let ((true (cl:atan #c(-1d-20 -2d0)))) + (check-signs #'atan #q(-0d0 -2d0) true)) + t) + +(rt:deftest oct.atan-branch-pos.1 + (let ((true (cl:atan #c(1d-20 2d0)))) + (check-signs #'atan #c(0d0 2d0) true)) + t) + +(rt:deftest oct.atan-branch-pos.2 + (let ((true (cl:atan #c(1d-20 2d0)))) + (check-signs #'atan #q(0d0 2 0d0) true)) + t) + +(rt:deftest oct.atan-branch-pos.3 + (let ((true (cl:atan #c(-1d-20 2d0)))) + (check-signs #'atan #c(-0d0 2d0) true)) + t) + +(rt:deftest oct.atan-branch-pos.4 + (let ((true (cl:atan #c(-1d-20 2d0)))) + (check-signs #'atan #q(-0d0 2d0) true)) + t) + + + + +

1 0

[oct-cvs] Oct commit: oct qd-io.lisp
by rtoy 09 Feb '11

09 Feb '11

Update of /project/oct/cvsroot/oct In directory cl-net:/tmp/cvs-serv367 Modified Files: qd-io.lisp Log Message: Change MAKE-FLOAT to multiply by the sign AFTER we've created the quad-double. This way we create signed quad-double zeroes correctly. Previously, the sign was applied to the rational which loses the sign if the rational is 0. --- /project/oct/cvsroot/oct/qd-io.lisp 2008/07/16 21:02:07 1.22 +++ /project/oct/cvsroot/oct/qd-io.lisp 2011/02/09 19:28:00 1.23 @@ -1,6 +1,6 @@ ;;;; -*- Mode: lisp -*- ;;;; -;;;; Copyright (c) 2007 Raymond Toy +;;;; Copyright (c) 2007, 2011 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation @@ -402,10 +402,11 @@ (declare (type (member -1 1) sign) (type unsigned-byte int-part frac-part) (fixnum scale exp)) - (rational-to-qd (* sign - (* (+ int-part (/ frac-part (expt 10 scale))) - (expt 10 exp))))) - + (let ((qd (rational-to-qd (* (+ int-part (/ frac-part (expt 10 scale))) + (expt 10 exp))))) + (if (minusp sign) + (neg-qd qd) + qd))) ;; This seems to work, but really needs to be rewritten! (defun read-qd (stream)

1 0