cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[git] CMU Common Lisp branch master updated. snapshot-2014-09-1-g17f4533
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 17f45333fcd83fa81e82cf382bcc78cf20b3d826 (commit) from ac320f2c22d0532b7920257f0487c449028c81fc (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 17f45333fcd83fa81e82cf382bcc78cf20b3d826 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Sep 4 21:08:49 2014 -0700 Remove redundant entry and rephrase an entry. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 64e93a1..0327f5b 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -65,7 +65,8 @@ New in this release: * (cosh 1000d0) signals an overflow error as it should. Previously, it just incorrectly returned infinity. * Deprecating FLOAT-TRAPPING-NAN-P in favor of - FLOAT-SIGNALING-NAN-P. + FLOAT-SIGNALING-NAN-P. These kinds of numbers are called + signaling NaNs, not trapping NaNs. * Changed the printer to print "Signaling" instead of "Trapping" when printing a signaling NaN. * Various issues with the switch to using fdlibm have been @@ -78,10 +79,7 @@ New in this release: * On the ppc port, handle FP exceptions a bit better by not failing if cmucl is unable to interpret the instruction that caused the exception. - * FLOAT-TRAPPING-NAN-P is deprecated and is replaced by - FLOAT-SIGNALING-NAN-P. These kinds of numbers are called - signaling NaNs, not trapping NaNs. - * Microoptimization for sparc in converting a double-float to a + * Microoptimization for sparc in rounding a double-float to a 32-bit signed integer. * The compiler can now derive the type of ROUND. (But more work is needed.) ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-04-15-g77292df
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 77292dfb3ae1619c830a10a957d44962d5cc7b5a (commit) from a923563fe3475ea90faa7e8e3c378436f41daa39 (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 77292dfb3ae1619c830a10a957d44962d5cc7b5a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 12:36:31 2013 -0700 Fix compiler warning on sparc about 1st arg to madvise. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index 708e2fa..6909292 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -6999,7 +6999,7 @@ free_oldspace(void) page_start = (int *) page_address(first_page); - madvise(page_start, GC_PAGE_SIZE * (last_page - first_page), GENCGC_MADVISE); + madvise((void*) page_start, GC_PAGE_SIZE * (last_page - first_page), GENCGC_MADVISE); for (page = first_page; page < last_page; ++page) { page_start = (int *) page_address(page); *page_start = PAGE_NEEDS_ZEROING_MARKER; ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-03-13-g28740a7
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 28740a75c3a9948d9a6fea93f4fffde1453ea665 (commit) via 66a1d751cebc236a4e9da87fa26f0d3777075de1 (commit) from 9706477f9d5feebfbc8f7de353bab36b50b260bc (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 28740a75c3a9948d9a6fea93f4fffde1453ea665 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Mar 29 09:22:10 2014 -0700 Note dropping of x87 support after this snapshot. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index b5f697d..f7a012d 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -19,6 +19,9 @@ over the Internet, and is mostly in the public domain. New in this release: * Known issues: + * Support for x87 will be dropped after the 2014-04 snapshot. All + further snapshots will require an x86 chip that supports sse2. + SSE2 was introduced with the Pentium 4 in 2001. * Feature enhancements * Trig functions are signficantly faster. commit 66a1d751cebc236a4e9da87fa26f0d3777075de1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Mar 29 09:03:04 2014 -0700 Update from commit logs. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index b245312..b5f697d 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -68,17 +68,17 @@ New in this release: Incorrect results were returned under some conditions when the result TN was packed in the same location as one of the argument TNs. - * Type derivation for log now matches the actual returned - values. (Ticket #92). * The float constants for various limits are defined for double-double floats such as least-positive-double-double-float. * When reading very small float values, round to least-positive-foo-float if possible. + * (log -0w0) and (log 0w0) returns values analogous to the + double-float versions. * Trac Tickets: * Ticket #90 fixed. - * Ticket #92 fixed. + * Ticket #92 marked invalid.. * Ticket #87 fixed. * Ticket #94 fixed. * Ticket #93 fixed. ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp annotated tag snapshot-2014-03 created. snapshot-2014-03
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The annotated tag, snapshot-2014-03 has been created at 8bf942dd445bc486a85a314254ccde94094eda70 (tag) tagging 901d7539202d485429c76b4262d0f6e500826a07 (commit) replaces snapshot-2014-02 tagged by Raymond Toy on Sun Mar 2 09:58:32 2014 -0800 - Log ----------------------------------------------------------------- Snapshot 2014-03 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iEYEABECAAYFAlMTcVEACgkQJ5IjUmgZO7JFEACdHOLg6rIkrVge5JT9TfJLHEbf OuIAniSiHyjbyYg4v8G3NaKnMMtGuTbu =687T -----END PGP SIGNATURE----- Raymond Toy (17): Import lisp-unit. This is the version from quicklisp which marked it Add lisp-unit as a module. Use (require :lisp-unit) (or "lisp-unit") Add news about lisp-unit. Fix ticket:92 Update from commit logs. Fix ticket:87 Update from logs. Fix path so (require :lisp-unit) actually loads. Fix ticket 93. Fix ticket 94. Update from recent changes. Merge branch 'master' into rtoy-round-float-in-reader Fix ticket 93. Regenerated. Regenerate. Regenerated piglatin translation. Update from commit logs. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-02-7-g8e32631
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 8e32631b0fd464a6f753639f02ceb36d58eeabde (commit) via 53c2f46a97425ce7af98550529711de3293a5692 (commit) from f04a80287e33b51b08242d53e7ad7c1c2ec9c59e (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 8e32631b0fd464a6f753639f02ceb36d58eeabde Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Feb 9 17:20:35 2014 -0800 Update from logs. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index fdc8837..de3f682 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -24,6 +24,9 @@ New in this release: * Trig functions are signficantly faster. * Accuracy of trig functions improved. (Previously, they could be off by one or two ulp.) + * RUN-PROGRAM accepts :ELEMENT-TYPE to allow specifying the + element type for streams that are created for RUN-PROGRAM. (See + ticket:92) * Changes * Update to ASDF 3.0.3. @@ -69,6 +72,7 @@ New in this release: * Trac Tickets: * Ticket #90 fixed. * Ticket #92 fixed. + * Ticket #87 fixed. * Other changes: commit 53c2f46a97425ce7af98550529711de3293a5692 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Feb 9 17:18:49 2014 -0800 Fix ticket:87 Add {{{:ELEMENT-TYPE}}} keyword option to {{{RUN-PROGRAM}}} * src/code/run-program.lisp: * Add :element-type option, and use it as needed when creating input or output streams. * tests/trac.lisp: * Add tests. diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index c8f96e9..ee29dfa 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -456,7 +456,8 @@ &key (env *environment-list*) (wait t) pty input if-input-does-not-exist output (if-output-exists :error) (error :output) (if-error-exists :error) status-hook - (external-format :default)) + (external-format :default) + (element-type 'base-char)) "RUN-PROGRAM creates a new process and runs the unix program in the file specified by the simple-string PROGRAM. ARGS are the standard arguments that can be passed to a Unix program, for no arguments @@ -510,7 +511,11 @@ This is a function the system calls whenever the status of the process changes. The function takes the process as an argument. :external-format - - This is the external-format used for communication with the subprocess." + This is the external-format used for communication with the subprocess. + :element-type - + When a stream is created for :input or :output, the stream + uses this element-type instead of the default 'BASE-CHAR type. +" ;; Make sure the interrupt handler is installed. (system:enable-interrupt unix:sigchld #'sigchld-handler) @@ -531,13 +536,15 @@ (stdin input-stream) (get-descriptor-for input cookie :direction :input :if-does-not-exist if-input-does-not-exist - :external-format external-format) + :external-format external-format + :element-type element-type) (multiple-value-bind (stdout output-stream) (get-descriptor-for output cookie :direction :output :if-does-not-exist :create :if-exists if-output-exists - :external-format external-format) + :external-format external-format + :element-type element-type) (multiple-value-bind (stderr error-stream) (if (eq error :output) @@ -545,7 +552,8 @@ (get-descriptor-for error cookie :direction :output :if-does-not-exist :create :if-exists if-error-exists - :external-format external-format)) + :external-format external-format + :element-type element-type)) (multiple-value-bind (pty-name pty-stream) (open-pty pty cookie external-format) ;; Make sure we are not notified about the child death before @@ -652,6 +660,7 @@ ;;; (defun get-descriptor-for (object cookie &rest keys &key direction external-format + (element-type 'base-char) &allow-other-keys) (cond ((eq object t) ;; No new descriptor is needed. @@ -684,14 +693,18 @@ (push write-fd *close-on-error*) (let ((stream (system:make-fd-stream write-fd :output t :external-format - external-format))) + external-format + :element-type + element-type))) (values read-fd stream))) (:output (push read-fd *close-on-error*) (push write-fd *close-in-parent*) (let ((stream (system:make-fd-stream read-fd :input t :external-format - external-format))) + external-format + :element-type + element-type))) (values write-fd stream))) (t (unix:unix-close read-fd) diff --git a/tests/trac.lisp b/tests/trac.lisp index dfbbf8b..87e3ca7 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -274,6 +274,50 @@ (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) +(define-test trac.87.output + (:tag :trac) + (let ((path "/tmp/trac.87") + (string "Hello")) + (unwind-protect + (progn + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let* ((expected (stream:string-to-octets string :external-format :latin1)) + (octets (make-array (length expected) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :output :stream + :element-type '(unsigned-byte 8)))) + (read-sequence octets (ext:process-output proc)) + (assert-equalp + expected + octets))) + (delete-file path)))) + +(define-test trac.87.input + (:tag :trac) + (let ((path "/tmp/trac.87") + (string "Hello")) + (unwind-protect + (progn + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (write-string string s)) + (let ((octets (stream:string-to-octets string :external-format :latin1)) + (output (make-array (length string) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list path) + :input :stream + :output :stream + :element-type '(unsigned-byte 8)))) + (write-sequence octets (ext:process-input proc)) + (read-sequence output (ext:process-output proc)) + (assert-equalp + octets + output))) + (delete-file path)))) + (define-test trac.92 (:tag :trac) (let ((f (compile nil @@ -283,3 +327,4 @@ (assert-equal 'double-float (third (kernel:%function-type f))))) + ----------------------------------------------------------------------- Summary of changes: src/code/run-program.lisp | 27 +++++++++++++++++------ src/general-info/release-20f.txt | 4 ++++ tests/trac.lisp | 45 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 7 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-1-g0cf9036
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 0cf9036d307ffcf6690851b114607b7571706799 (commit) from 19d7d37b313c6c252653a6f39f7fbc9c344469f3 (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 0cf9036d307ffcf6690851b114607b7571706799 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Jun 23 21:26:39 2014 -0700 Change max gen to GC to 3; add inteface to set it. * lisp/gencgc.c * Set number of generations to GC to 3 instead of NUM_GENERATIONS - 1. * Add simple interface to allow user to set the number of generations and return the old value. * code/gc.lisp: * Add Lisp interface to set the number of generations to GC. diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 5c200d4..b12daba 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -612,4 +612,7 @@ (gen c-call:int) (trigger-age c-call:int)) (alien:def-alien-routine set-min-mem-age c-call:void (gen c-call:int) (min-mem-age c-call:double)) +(alien:def-alien-routine set-max-gen-to-gc c-call:unsigned-int + (gen c-call:int)) + ) diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index cdc95e0..cc071dd 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -594,7 +594,8 @@ struct generation_stats { * The oldest generation that will currently be GCed by default. * Valid values are: 0, 1, ... (NUM_GENERATIONS - 1) * - * The default of (NUM_GENERATIONS - 1) enables GC on all generations. + * A value of NUM_GENERATIONS - 1 enables GC on all generations; the + * default is less. * * Setting this to 0 effectively disables the generational nature of * the GC. In some applications generational GC may not be useful @@ -604,7 +605,9 @@ struct generation_stats { * into an older generation so an unnecessary GC of this long-lived * data can be avoided. */ -unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; +#define DEFAULT_OLDEST_GEN_TO_GC 3 + +unsigned int gencgc_oldest_gen_to_gc = DEFAULT_OLDEST_GEN_TO_GC; /* @@ -8433,3 +8436,23 @@ get_page_table_info(int page, int* flags, int* bytes) *flags = page_table[page].flags; *bytes = page_table[page].bytes_used; } + +/* + * Set the oldest generation to gc to the given value. If the value + * is illegal, the appropriate limit is used instead. The old value + * is returned. + */ +unsigned int set_max_gen_to_gc(int gen) +{ + unsigned int previous = gencgc_oldest_gen_to_gc; + + if (gen < 0) { + gencgc_oldest_gen_to_gc = 0; + } else if (gen >= NUM_GENERATIONS - 1) { + gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; + } else { + gencgc_oldest_gen_to_gc = gen; + } + + return previous; +} ----------------------------------------------------------------------- Summary of changes: src/code/gc.lisp | 3 +++ src/lisp/gencgc.c | 27 +++++++++++++++++++++++++-- 2 files changed, 28 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch rtoy-lisp-trig updated. snapshot-2013-12-a-10-g1266d1f
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, rtoy-lisp-trig has been updated via 1266d1ff1eb938136e8ae684eb9e3be8009ec350 (commit) from 6ec982de562b883722c7efc85d44f9fada24b9ef (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 1266d1ff1eb938136e8ae684eb9e3be8009ec350 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 17 13:10:30 2013 -0800 Convert to using lisp-unit. diff --git a/src/tests/trig.lisp b/src/tests/trig.lisp index 57a5355..41e444a 100644 --- a/src/tests/trig.lisp +++ b/src/tests/trig.lisp @@ -1,238 +1,193 @@ -(rt:deftest sin.1 - (sin 0d0) - 0d0) - -(rt:deftest sin.2 - (sin -0d0) - -0d0) - -(rt:deftest sin.3 - ;; Tests the case for |x| < 2^-27, but not 0. - (sin (scale-float 1d0 -28)) - #.(scale-float 1d0 -28)) - -(rt:deftest sin.4 - ;; Just a random test, without argument reduction - (sin .5d0) - 0.479425538604203d0) - -(rt:deftest sin.5 - ;; Test for arg near pi/2 - (sin (/ pi 2)) - 1d0) - -(rt:deftest sin.red.0 - ;; Test for argument reduction with n mod 4 = 0 - (sin (* 7/4 pi)) - -7.07106781186547675943154203316156531867416581156d-1) - -(rt:deftest sin.red.1 +(defpackage :trig-tests + (:use :cl :lisp-unit)) + +(in-package "TRIG-TESTS") + +(define-test sin.signed-zeroes + "Test sin for 0d0 and -0d0" + (:tag :sin :signed-zeroes) + (assert-eql 0d0 (sin 0d0)) + (assert-eql -0d0 (sin -0d0))) + + +(define-test sin.very-small + "Tests sin for the case of |x| < 2^-27, but not 0." + (:tag :sin) + (assert-eql (scale-float 1d0 -28) + (sin (scale-float 1d0 -28)))) + +(define-test sin.no-reduction + "Test sin for small args without reduction" + (:tag :sin) + (assert-eql 0.479425538604203d0 + (sin .5d0)) + (assert-eql -0.479425538604203d0 + (sin -0.5d0))) + +(define-test sin.pi/2 + "Test for arg near pi/2" + (:tag :sin) + (assert-eql 1d0 (sin (/ pi 2)))) + +(define-test sin.arg-reduction + "Test for sin with arg reduction" + (:tag :sin) + ;; Test for argument reduction with n mod 4 = 0 + (assert-eql -7.07106781186547675943154203316156531867416581156d-1 + (sin (* 7/4 pi))) ;; Test for argument reduction with n mod 4 = 1 - (sin (* 9/4 pi)) - 7.07106781186547329560731709118834541043171055432d-1) - -(rt:deftest sin.red.2 - ;; Test for argument reduction with n mod 4 = 2 - (sin (* 11/4 pi)) - 7.07106781186548390575743300374993861263439430213d-1) - -(rt:deftest sin.red.3 - ;; Test for argument reduction with n mod 4 = 3 - (sin (* 13/4 pi)) - -7.07106781186547871002109559079472349116005337743d-1) - -(rt:deftest sin.misc.1 - ;; Test for argument reduction - (sin (scale-float 1d0 120)) - 0.377820109360752d0) - -(rt:deftest cos.1 - (cos 0d0) - 1d0) - -(rt:deftest cos.2 - (cos -0d0) - 1d0) - -(rt:deftest cos.3 - ;; Test for |x| < 2^-27 - (cos (scale-float 1d0 -28)) - 1d0) - -(rt:deftest cos.4 - ;; Test for branch |x| < .3 - (cos 0.25d0) - 0.9689124217106447d0) - -(rt:deftest cos.5 - ;; Test for branch |x| > .3 and \x| < .78125 - (cos 0.5d0) - 8.7758256189037271611628158260382965199164519711d-1) - -(rt:deftest cos.6 - ;; Test for branch |x| > .3 and |x| > .78125 - (cos 0.785d0) - 0.7073882691671998d0) - -(rt:deftest cos.7 - ;; Random test near pi/2 - (cos (/ pi 2)) - 6.123233995736766d-17) - -(rt:deftest cos.misc.1 - ;; Test for argument reduction - (cos (scale-float 1d0 120)) - -0.9258790228548379d0) - -(rt:deftest cos.red.0 + (assert-eql 7.07106781186547329560731709118834541043171055432d-1 + (sin (* 9/4 pi))) + ;; Test for argument reduction with n mod 4 = 2 + (assert-eql 7.07106781186548390575743300374993861263439430213d-1 + (sin (* 11/4 pi))) + ;; Test for argument reduction with n mod 4 = 3 + (assert-eql -7.07106781186547871002109559079472349116005337743d-1 + (sin (* 13/4 pi))) + ;; Test for argument reduction, big value + (assert-eql 0.377820109360752d0 + (sin (scale-float 1d0 120)))) + +(define-test sin.exceptions + "Test sin for exceptional values" + (:tag :sin :exceptions) + (kernel::with-float-traps-masked () + (assert-error 'floating-point-invalid-operation (sin ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation (sin ext:double-float-negative-infinity)))) + +(define-test cos.signed-zeroes + "Test cos for 0d0 and -0d0" + (:tag :cos :signed-zeroes) + (assert-eql 1d0 (cos 0d0)) + (assert-eql 1d0 (cos -0d0))) + +(define-test cos.very-small + "Test cos for |x| < 2^-27" + (:tag :cos) + (assert-eql 1d0 (cos (scale-float 1d0 -28)))) + +(define-test cos.code-paths + "Tests various code paths in cos evaluation" + (:tag :cos) + ;; Test for branch |x| < .3 + (assert-eql 0.9689124217106447d0 + (cos 0.25d0)) + ;; Test for branch |x| > .3 and \x| < .78125 + (assert-eql 8.7758256189037271611628158260382965199164519711d-1 + (cos 0.5d0)) + ;; Test for branch |x| > .3 and |x| > .78125 + (assert-eql 0.7073882691671998d0 + (cos 0.785d0))) + +(define-test cos.pi/2 + "Test cos(pi/2)" + (:tag :cos) + (assert-eql 6.123233995736766d-17 + (cos (/ pi 2)))) + +(define-test cos.arg-reduction + "Test for cos with arg reduction" + (:tag :cos) ;; Test for argument reduction with n mod 4 = 0 - (cos (* 7/4 pi)) - 7.07106781186547372858534520893509069186435867941d-1) + (assert-eql 7.07106781186547372858534520893509069186435867941d-1 + (cos (* 7/4 pi))) + ;; Test for argument reduction with n mod 4 = 1 + (assert-eql 7.0710678118654771924095701509080985020443197242d-1 + (cos (* 9/4 pi))) + ;; Test for argument reduction with n mod 4 = 2 + (assert-eql -7.07106781186546658225945423833643190916000739026d-1 + (cos (* 11/4 pi))) + ;; Test for argument reduction with n mod 4 = 3 + (assert-eql -7.07106781186547177799579165130055836531929091466d-1 + (cos (* 13/4 pi))) + ;; Test for argument reduction + (assert-eql -0.9258790228548379d0 + (cos (scale-float 1d0 120)))) + +(define-test tan.signed-zeroes + "Test tan for 0d0 and -0d0" + (:tag :tan :signed-zeroes) + (assert-eql 0d0 (tan 0d0)) + (assert-eql -0d0 (tan -0d0))) + +(define-test tan.very-small + "Test for tan, |x| < 2^-28" + (:tag :tan) + (assert-eql (scale-float 1d0 -29) + (tan (scale-float 1d0 -29))) + (assert-eql (scale-float -1d0 -29) + (tan (scale-float -1d0 -29)))) + +(define-test tan.pi/2 + "Test for tan(pi/2)" + (:tag :tan) + (assert-eql 1.63312393531953697559677370415289165308640681049d16 + (tan (/ pi 2)))) + +(define-test tan.code-paths + "Tests for various code paths in tan" + (:tag :tan) + ;; |x| < .6744 + (assert-eql 5.4630248984379051325517946578028538329755172018d-1 + (tan 0.5d0)) + ;; |x = 11/16 = 0.6875 > .6744 + (assert-eql 8.21141801589894121911423965374711700875371645309d-1 + (tan (float 11/16 1d0))) + ;; This was found by maxima's testsuite. A bug in kernel-tan when + ;; returning cot(x). + (assert-eql 2.0000000000000028604455051971538975562294147582d0 + (tan 1.107148717794091d0))) + +(define-test tan.arg-reduction + "Test for tan with arg reduction" + (:tag :tan) + ;; Test for argument reduction with n even + (assert-eql -1.00000000000000042862637970157370388940976433505d0 + (tan (* 7/4 pi))) + ;; Test for argument reduction with n odd + (assert-eql 9.99999999999999448908940383691222098948324989275d-1 + (tan (* 9/4 pi))) + (assert-eql -4.08066388841804238545143494525595117765084022768d-1 + (tan (scale-float 1d0 120)))) + + +(define-test sincos.signed-zeroes + "Test sincos at 0d0, -0d0" + (:tag :sincos :signed-zeroes) + (assert-equal '(0d0 1d0) + (multiple-value-list (kernel::%sincos 0d0))) + (assert-equal '(-0d0 1d0) + (multiple-value-list (kernel::%sincos -0d0)))) + +(defun sincos-test (limit n) + (let (results) + (dotimes (k n) + (let* ((x (random limit)) + (s-exp (sin x)) + (c-exp (cos x))) + (multiple-value-bind (s c) + (kernel::%sincos x) + (unless (and (eql s s-exp) + (eql c c-exp)) + (push (list x + (list s s-exp) + (list c c-exp)) + results))))) + results)) + +(define-test sincos.consistent + "Test sincos is consistent with sin and cos" + (:tag :sincos) + ;; Small values + (assert-eql nil + (sincos-test (/ pi 4) 1000)) + ;; Medium + (assert-eql nil + (sincos-test 16d0 1000)) + ;; Large + (assert-eql nil + (sincos-test (scale-float 1d0 120) 1000)) + ;; Very large + (assert-eql nil + (sincos-test (scale-float 1d0 1023) 1000))) -(rt:deftest cos.red.1 - ;; Test for argument reduction with n mod 4 = 1 - (cos (* 9/4 pi)) - 7.0710678118654771924095701509080985020443197242d-1) - -(rt:deftest cos.red.2 - ;; Test for argument reduction with n mod 4 = 2 - (cos (* 11/4 pi)) - -7.07106781186546658225945423833643190916000739026d-1) - -(rt:deftest cos.red.3 - ;; Test for argument reduction with n mod 4 = 3 - (cos (* 13/4 pi)) - -7.07106781186547177799579165130055836531929091466d-1) - -(rt:deftest tan.1 - (tan 0d0) - 0d0) - -(rt:deftest tan.2 - (tan -0d0) - -0d0) - -(rt:deftest tan.3 - ;; |x| < 2^-28 - (tan (scale-float 1d0 -29)) - #.(scale-float 1d0 -29)) - -(rt:deftest tan.4 - ;; |x| < .6744 - (tan 0.5d0) - 5.4630248984379051325517946578028538329755172018d-1) - -(rt:deftest tan.5 - ;; |x = 11/16 = 0.6875 > .6744 - (tan (float 11/16 1d0)) - 8.21141801589894121911423965374711700875371645309d-1) - -(rt:deftest tan.6 - ;; This was found by maxima's testsuite. A bug in kernel-tan when - ;; returning cot(x). - (tan 1.107148717794091d0) - 2.0000000000000028604455051971538975562294147582d0) - -(rt:deftest tan.red.0 - ;; Test for argument reduction with n even - (tan (* 7/4 pi)) - -1.00000000000000042862637970157370388940976433505d0) - -(rt:deftest tan.red.1 - ;; Test for argument reduction with n odd - (tan (* 9/4 pi)) - 9.99999999999999448908940383691222098948324989275d-1) - -(rt:deftest tan.misc.1 - (tan (scale-float 1d0 120)) - -4.08066388841804238545143494525595117765084022768d-1) - - -(rt:deftest sincos.0 - (multiple-value-list (kernel::%sincos -0d0)) - (-0d0 1d0)) - -(rt:deftest sincos.1 - (let (results) - (dotimes (k 1000) - (let* ((x (random (/ pi 4))) - (s-exp (sin x)) - (c-exp (cos x))) - (multiple-value-bind (s c) - (kernel::%sincos x) - (unless (and (= s s-exp) - (= c c-exp)) - (push (list x - (list s s-exp) - (list c c-exp)) - results))))) - results) - nil) - -(rt:deftest sincos.2 - (let (results) - (dotimes (k 1000) - (let* ((x (random 16d0)) - (s-exp (sin x)) - (c-exp (cos x))) - (multiple-value-bind (s c) - (kernel::%sincos x) - (unless (and (= s s-exp) - (= c c-exp)) - (push (list x - (list s s-exp) - (list c c-exp)) - results))))) - results) - nil) - -(rt:deftest sincos.3 - (let (results) - (dotimes (k 1000) - (let* ((x (random (scale-float 1d0 120))) - (s-exp (sin x)) - (c-exp (cos x))) - (multiple-value-bind (s c) - (kernel::%sincos x) - (unless (and (= s s-exp) - (= c c-exp)) - (push (list x - (list s s-exp) - (list c c-exp)) - results))))) - results) - nil) - -(rt:deftest sincos.3a - (let (results) - (dotimes (k 1000) - (let* ((x (- (random (scale-float 1d0 120)))) - (s-exp (sin x)) - (c-exp (cos x))) - (multiple-value-bind (s c) - (kernel::%sincos x) - (unless (and (= s s-exp) - (= c c-exp)) - (push (list x - (list s s-exp) - (list c c-exp)) - results))))) - results) - nil) - -(rt:deftest sincos.4 - (let (results) - (dotimes (k 1000) - (let* ((x (random (scale-float 1d0 1023))) - (s-exp (sin x)) - (c-exp (cos x))) - (multiple-value-bind (s c) - (kernel::%sincos x) - (unless (and (= s s-exp) - (= c c-exp)) - (push (list x - (list s s-exp) - (list c c-exp)) - results))))) - results) - nil) ----------------------------------------------------------------------- Summary of changes: src/tests/trig.lisp | 425 +++++++++++++++++++++++---------------------------- 1 file changed, 190 insertions(+), 235 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-12-g2451162
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 24511623e8c3ba1752339d2613bbd18ef27859b0 (commit) from 32ad743155af81b7c3e2ee31726272a85e8f3247 (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 24511623e8c3ba1752339d2613bbd18ef27859b0 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 13:50:47 2014 -0700 Add fdlibm's log10. * src/code/irrat.lisp: * Define %log10 to use fdlibm's log10 * src/lisp/GNUmakefile * Compile e_log10 * tests/trig.lisp * Add tests for %log10. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 2591907..61d4314 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -81,7 +81,7 @@ ;;; Exponential and Logarithmic. (def-math-rtn ("__ieee754_exp" %exp) 1) (def-math-rtn ("__ieee754_log" %log) 1) -(def-math-rtn "log10" 1) +(def-math-rtn ("__ieee754_log10" %log10) 1) (def-math-rtn ("__ieee754_pow" %pow) 2) #-(or x86 sparc-v7 sparc-v8 sparc-v9) diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile index c557d3b..d0d6104 100644 --- a/src/lisp/GNUmakefile +++ b/src/lisp/GNUmakefile @@ -12,6 +12,7 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ e_acosh.c s_asinh.c e_atanh.c \ e_atan2.c \ e_rem_pio2.c k_rem_pio2.c \ + e_log10.c \ setexception.c SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ diff --git a/tests/trig.lisp b/tests/trig.lisp index 861a298..cdebe39 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -1006,3 +1006,24 @@ (assert-true (ext:float-nan-p (kernel:%atan *qnan*))) (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%atan *snan*))))) + +(define-test %log10.exceptions + (:tag :fdlibm) + ;; %log10(2^k) = k + (dotimes (k 23) + (assert-equalp k + (kernel:%log10 (float (expt 10 k) 1d0)))) + (assert-error 'division-by-zero + (kernel:%log10 0d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%log10 -1d0)) + (assert-true (ext:float-nan-p (kernel:%log10 *qnan*))) + (assert-equal ext:double-float-positive-infinity + (kernel:%log10 ext:double-float-positive-infinity)) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-negative-infinity + (kernel:%log10 0d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%log10 -0d0))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log10 -1d0))))) ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 2 +- src/lisp/GNUmakefile | 1 + tests/trig.lisp | 21 +++++++++++++++++++++ 3 files changed, 23 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-31-g9b6ad20
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 9b6ad20132565202c72dec2dd2d8c6ee287c1601 (commit) from 0abe7883718b87b3dee2d8e3fb698183cbbca932 (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 9b6ad20132565202c72dec2dd2d8c6ee287c1601 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Aug 25 19:31:03 2014 -0700 Deprecate FLOAT-TRAPPING-NAN-P in favor of FLOAT-SIGNALING-NAN-P. These numbers are called signaling, not trapping NaN in almost all usages. * code/exports.lisp: * Export FLOAT-SIGNALING-NAN-P. * code/float.lisp: * Implement FLOAT-SIGNALING-NAN-P. * Make FLOAT-TRAPPING-NAN-P an inline call to the FLOAT-SIGNALING-NAN-P and add a docstring to say it is deprecated. * code/print.lisp: * Print "Signaling" instead of "Trapping". * i18n/locale/cmucl.pot: * Regenerated due to the changes in docstrings. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 0f224f6..d3c8fa7 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1416,7 +1416,8 @@ "DOUBLE-FLOAT-NEGATIVE-INFINITY" "LONG-FLOAT-NEGATIVE-INFINITY" "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES" "FLOAT-DENORMALIZED-P" "FLOAT-INFINITY-P" - "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P" + "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P" + "FLOAT-SIGNALING-NAN-P" "WITH-FLOAT-TRAPS-MASKED") ;; More float extensions #+double-double diff --git a/src/code/float.lisp b/src/code/float.lisp index 9a7080d..cace1a4 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -57,7 +57,8 @@ single-float-negative-infinity short-float-negative-infinity double-float-negative-infinity long-float-negative-infinity set-floating-point-modes float-denormalized-p float-nan-p - float-trapping-nan-p float-infinity-p)) + float-trapping-nan-p float-infinity-p + float-signaling-nan-p)) #+double-double (export '(least-positive-normalized-double-double-float @@ -285,7 +286,7 @@ ;;;; Float predicates and environment query: (declaim (maybe-inline float-denormalized-p float-infinity-p float-nan-p - float-trapping-nan-p)) + float-signaling-nan-p)) ;;; FLOAT-DENORMALIZED-P -- Public ;;; @@ -344,7 +345,7 @@ #+double-double (float-infinity-p (double-double-hi x))) - (frob float-nan-p "Return true if the float X is a NaN (Not a Number)." + (frob float-nan-p "Return true if the float X is a quiet or signaling NaN (Not a Number)." (not (zerop (ldb vm:single-float-significand-byte bits))) (or (not (zerop (ldb vm:double-float-significand-byte hi))) (not (zerop lo))) @@ -354,8 +355,8 @@ #+double-double (float-nan-p (double-double-hi x))) - (frob float-trapping-nan-p - "Return true if the float X is a trapping NaN (Not a Number)." + (frob float-signaling-nan-p + "Return true if the float X is a signaling NaN (Not a Number)." (zerop (logand (ldb vm:single-float-significand-byte bits) vm:single-float-trapping-nan-bit)) (zerop (logand (ldb vm:double-float-significand-byte hi) @@ -364,8 +365,12 @@ (zerop (logand (ldb vm:long-float-significand-byte hi) vm:long-float-trapping-nan-bit)) #+double-double - (float-trapping-nan-p (double-double-hi x)))) + (float-signaling-nan-p (double-double-hi x)))) +(declaim (inline float-trapping-nan-p)) +(defun float-trapping-nan-p (x) + "Deprecated. Use FLOAT-SIGNALING-NAN-P instead." + (float-signaling-nan-p x)) ;;; FLOAT-PRECISION -- Public ;;; @@ -928,7 +933,7 @@ ;; Infinity is infinity, no matter how small... x) ((float-nan-p x) - (when (and (float-trapping-nan-p x) + (when (and (float-signaling-nan-p x) (vm:current-float-trap :invalid)) (error 'floating-point-invalid-operation :operation 'scale-float :operands (list x exp))) diff --git a/src/code/print.lisp b/src/code/print.lisp index f2a1205..778d827 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1732,7 +1732,7 @@ radix-R. If you have a power-list then pass it in as PL." (defun output-float-nan (x stream) (print-unreadable-object (x stream) (write-string (float-format-name x) stream) - (write-string (if (float-trapping-nan-p x) " Trapping" " Quiet") stream) + (write-string (if (float-signaling-nan-p x) " Signaling" " Quiet") stream) (write-string " NaN" stream))) diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 7179f1f..14c64b8 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -64,6 +64,10 @@ New in this release: CMUCL will not run on chips without SSE2 anymore. * (cosh 1000d0) signals an overflow error as it should. Previously, it just incorrectly returned infinity. + * Deprecating FLOAT-TRAPPING-NAN-P in favor of + FLOAT-SIGNALING-NAN-P. + * Changed the printer to print "Signaling" instead of "Trapping" + when printing a signaling NaN. * ANSI compliance fixes: * The values on the branch cuts for the inverse trig and diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 15366ac..a885634 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -4783,11 +4783,15 @@ msgid "Return true if the float X is an infinity (+ or -)." msgstr "" #: src/code/float.lisp -msgid "Return true if the float X is a NaN (Not a Number)." +msgid "Return true if the float X is a quiet or signaling NaN (Not a Number)." msgstr "" #: src/code/float.lisp -msgid "Return true if the float X is a trapping NaN (Not a Number)." +msgid "Return true if the float X is a signaling NaN (Not a Number)." +msgstr "" + +#: src/code/float.lisp +msgid "Deprecated. Use FLOAT-SIGNALING-NAN-P instead." msgstr "" #: src/code/float.lisp ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 3 ++- src/code/float.lisp | 19 ++++++++++++------- src/code/print.lisp | 2 +- src/general-info/release-20f.txt | 4 ++++ src/i18n/locale/cmucl.pot | 8 ++++++-- 5 files changed, 25 insertions(+), 11 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-96-g4b8c616
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

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 "CMU Common Lisp". The branch, master has been updated via 4b8c616db3f31214542a2793fa7365e464990f74 (commit) from c355485f5a73b92f3bf9a5fdc726bec9ffc15857 (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 4b8c616db3f31214542a2793fa7365e464990f74 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Aug 4 20:39:05 2014 -0700 Document that the argument/result timespec starts at 0, not 1. diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 0b202de..bc679f0 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -1669,9 +1669,9 @@ :To Time-Spec Specify the beginning or end of the operand's lifetime. :From can only be used with results, and :To only with arguments. The default - for the N'th argument/result is (:ARGUMENT N)/(:RESULT N). These - options are necessary primarily when operands are read or written out - of order. + for the N'th argument/result is (:ARGUMENT N)/(:RESULT N). (The + first argument/result is number 0.) These options are necessary + primarily when operands are read or written out of order. :Conditional This is used in place of :RESULTS with conditional branch VOPs. There ----------------------------------------------------------------------- Summary of changes: src/compiler/meta-vmdef.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs