- cmucl-cvs - mailman3.common-lisp.net

[git] CMU Common Lisp branch master updated. snapshot-2014-08-40-gb48c235
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 b48c235255ef3e9cf0f47446a3adf8ce0abbe07f (commit) from 074f4d0bac83c1f2f8aff49ec9dd6e23950106fc (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 b48c235255ef3e9cf0f47446a3adf8ce0abbe07f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 27 20:45:10 2014 -0700 Add function to run selected tests. Makes it a bit easier to run a selected set instead of all tests. diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 46ec3a3..50f1ce6 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -5,6 +5,11 @@ ;;;; ;;;; lisp -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)' ;;;; +;;;; +;;;; To run selected tests: +;;;; +;;;; lisp -noinit -load tests/run-tests.lisp -eval '(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test <list>))' +;;;; ;;;; Note that you cannot run these tests from a binary created during ;;;; a build process. You must run ;;;; @@ -25,6 +30,7 @@ #:load-test-files #:run-loaded-tests #:run-all-tests + #:run-test #:print-test-results)) (in-package :cmucl-test-runner) @@ -65,8 +71,16 @@ test-results)) (nreverse test-results))) +;; Run selected tests +(defun run-test (&rest tests) + (let (test-results) + (dolist (test tests) + (push (lisp-unit:run-tests :all test) + test-results)) + (print-test-results (nreverse test-results) :verbose t))) + ;; Print out a summary of test results produced from RUN-LOADED-TESTS. -(defun print-test-results (results &key verbose) +(defun print-test-results (results &key verbose exitp) (let ((passed 0) (failed 0) (execute-errors 0) @@ -106,9 +120,11 @@ (format t "~2&Execute failures: ~S~%" execute-error-tests) (dolist (result results) (lisp-unit:print-errors result))) - (unix:unix-exit 1)) + (when exitp + (unix:unix-exit 1))) (t - (unix:unix-exit 0))))) + (when exitp + (unix:unix-exit 0)))))) ;; Look through all the files in the TEST-DIRECTORY and load them. ;; Then run all of the tests. For each file, it ia assumed that a @@ -116,7 +132,7 @@ ;; pathname-name of the file. (defun run-all-tests (&key (test-directory #P"tests/") (verbose t)) (load-test-files test-directory) - (print-test-results (run-loaded-tests) :verbose t)) + (print-test-results (run-loaded-tests) :verbose t :exitp t)) ;;(run-all-tests) ;;(quit) ----------------------------------------------------------------------- Summary of changes: tests/run-tests.lisp | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-9-g128d65b
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 128d65bef6e7d5c4d2701f05b2944bd5ec2223c9 (commit) from 2e182540e895f16b26224ba11b2f38de93ab2672 (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 128d65bef6e7d5c4d2701f05b2944bd5ec2223c9 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 12:51:45 2014 -0700 Import e_log10.c from netlib as is. diff --git a/src/lisp/e_log10.c b/src/lisp/e_log10.c new file mode 100644 index 0000000..dc7e312 --- /dev/null +++ b/src/lisp/e_log10.c @@ -0,0 +1,91 @@ + +/* @(#)e_log10.c 1.3 95/01/18 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* __ieee754_log10(x) + * Return the base 10 logarithm of x + * + * Method : + * Let log10_2hi = leading 40 bits of log10(2) and + * log10_2lo = log10(2) - log10_2hi, + * ivln10 = 1/log(10) rounded. + * Then + * n = ilogb(x), + * if(n<0) n = n+1; + * x = scalbn(x,-n); + * log10(x) := n*log10_2hi + (n*log10_2lo + ivln10*log(x)) + * + * Note 1: + * To guarantee log10(10**n)=n, where 10**n is normal, the rounding + * mode must set to Round-to-Nearest. + * Note 2: + * [1/log(10)] rounded to 53 bits has error .198 ulps; + * log10 is monotonic at all binary break points. + * + * Special cases: + * log10(x) is NaN with signal if x < 0; + * log10(+INF) is +INF with no signal; log10(0) is -INF with signal; + * log10(NaN) is that NaN with no signal; + * log10(10**N) = N for N=0,1,...,22. + * + * Constants: + * The hexadecimal values are the intended ones for the following constants. + * The decimal values may be used, provided that the compiler will convert + * from decimal to binary accurately enough to produce the hexadecimal values + * shown. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double +#else +static double +#endif +two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ +ivln10 = 4.34294481903251816668e-01, /* 0x3FDBCB7B, 0x1526E50E */ +log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */ +log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */ + +static double zero = 0.0; + +#ifdef __STDC__ + double __ieee754_log10(double x) +#else + double __ieee754_log10(x) + double x; +#endif +{ + double y,z; + int i,k,hx; + unsigned lx; + + hx = __HI(x); /* high word of x */ + lx = __LO(x); /* low word of x */ + + k=0; + if (hx < 0x00100000) { /* x < 2**-1022 */ + if (((hx&0x7fffffff)|lx)==0) + return -two54/zero; /* log(+-0)=-inf */ + if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ + k -= 54; x *= two54; /* subnormal number, scale up x */ + hx = __HI(x); /* high word of x */ + } + if (hx >= 0x7ff00000) return x+x; + k += (hx>>20)-1023; + i = ((unsigned)k&0x80000000)>>31; + hx = (hx&0x000fffff)|((0x3ff-i)<<20); + y = (double)(k+i); + __HI(x) = hx; + z = y*log10_2lo + ivln10*__ieee754_log(x); + return z+y*log10_2hi; +} ----------------------------------------------------------------------- Summary of changes: src/lisp/e_log10.c | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 src/lisp/e_log10.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-07-2-g02e58f6
by cshapiro＠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 02e58f652b6626d5b71f84def88cd8cd2a25bffd (commit) from f36a31aaf95b60e2cc210648d951b41d3112a73a (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 02e58f652b6626d5b71f84def88cd8cd2a25bffd Author: Carl Shapiro <cshapiro(a)common-lisp.net> Date: Wed Jul 31 23:12:00 2013 -0700 Improve and clean-up some move VOPs. * Remove the name dependence on EAX in move-to-word/integer. * Change move-from-signed to do a fixnum check using one branch instead of two. * Remove move-from-signed and move-from-unsigned assembly routines and the commented out code that refers to them. diff --git a/src/assembly/x86/alloc.lisp b/src/assembly/x86/alloc.lisp index 32ec7af..2a90fe9 100644 --- a/src/assembly/x86/alloc.lisp +++ b/src/assembly/x86/alloc.lisp @@ -1,4 +1,4 @@ -;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*- +;;; -*- Package: X86 -*- ;;; ;;; ********************************************************************** ;;; This code was written as part of the CMU Common Lisp project at @@ -17,58 +17,7 @@ ;;; ;;; Debugged by Paul F. Werkowski -- Spring 1995. ;;; -(in-package :x86) - -;;;; From from signed/unsigned +(in-package "X86") -#+assembler ; we don't want a vop for this one. -(define-assembly-routine - (move-from-signed) - ((:temp eax unsigned-reg eax-offset) - (:temp ebx unsigned-reg ebx-offset)) - (inst mov ebx eax) - (inst shl ebx 1) - (inst jmp :o bignum) - (inst shl ebx 1) - (inst jmp :o bignum) - (inst ret) - BIGNUM - - (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) - - (inst ret)) - -#+assembler ; we don't want a vop for this one either. -(define-assembly-routine - (move-from-unsigned) - ((:temp eax unsigned-reg eax-offset) - (:temp ebx unsigned-reg ebx-offset)) - - (inst test eax #xe0000000) - (inst jmp :nz bignum) - ;; Fixnum - (inst mov ebx eax) - (inst shl ebx 2) - (inst ret) - - BIGNUM - ;;; Note: On the mips port space for a two word bignum is always - ;;; allocated and the header size is set to either one or two words - ;;; as appropriate. On the mips port this is faster, and smaller - ;;; inline, but produces more garbage. The inline x86 version uses - ;;; the same approach, but here we save garbage and allocate the - ;;; smallest possible bignum. - (inst jmp :ns one-word-bignum) - (inst mov ebx eax) - - ;; Two word bignum - (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 2)) - (storew eax ebx bignum-digits-offset other-pointer-type)) - (inst ret) - - ONE-WORD-BIGNUM - (with-fixed-allocation (ebx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) - (inst ret)) +;;; But we do everything inline now that we have a better pseudo-atomic. diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 2ff54ee..e40d62d 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -232,20 +232,17 @@ ;;; Arg is a fixnum or bignum, figure out which and load if necessary. (define-vop (move-to-word/integer) - (:args (x :scs (descriptor-reg) :target eax)) + (:args (x :scs (descriptor-reg) :target y)) (:results (y :scs (signed-reg unsigned-reg))) (:note _N"integer to untagged word coercion") - (:temporary (:sc unsigned-reg :offset eax-offset - :from (:argument 0) :to (:result 0) :target y) eax) (:generator 4 - (move eax x) - (inst test al-tn 3) - (inst jmp :z fixnum) - (loadw y eax bignum-digits-offset other-pointer-type) + (inst test x 3) + (inst jmp :nz BIGNUM) + (move y x) + (inst sar y 2) (inst jmp done) - FIXNUM - (inst sar eax 2) - (move y eax) + BIGNUM + (loadw y x bignum-digits-offset other-pointer-type) DONE)) ;;; (define-move-vop move-to-word/integer :move @@ -278,45 +275,30 @@ ;;; Result may be a bignum, so we have to check. Use a worst-case cost to make ;;; sure people know they may be number consing. ;;; -#+nil (define-vop (move-from-signed) - (:args (x :scs (signed-reg unsigned-reg) :target eax)) - (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)) eax) - (:temporary (:sc unsigned-reg :offset ebx-offset :to (:result 0) :target y) - ebx) - (:temporary (:sc unsigned-reg :offset ecx-offset - :from (:argument 0) :to (:result 0)) ecx) - (:ignore ecx) + (:args (x :scs (signed-reg unsigned-reg) :to :save)) + (:temporary (:sc unsigned-reg) temp) (:results (y :scs (any-reg descriptor-reg))) (:note _N"signed word to integer coercion") - (:generator 20 - (move eax x) - (inst call (make-fixup 'move-from-signed :assembly-routine)) - (move y ebx))) -;;; -;;; Faster inline version, -(define-vop (move-from-signed) - (:args (x :scs (signed-reg unsigned-reg) :to :result)) - (:results (y :scs (any-reg descriptor-reg) :from :argument)) - (:note _N"signed word to integer coercion") (:node-var node) (:generator 20 - (assert (not (location= x y))) - (let ((bignum (gen-label)) - (done (gen-label))) - (inst mov y x) - (inst shl y 1) - (inst jmp :o bignum) - (inst shl y 1) - (inst jmp :o bignum) - (emit-label done) - - (assemble (*elsewhere*) - (emit-label bignum) - (with-fixed-allocation - (y bignum-type (+ bignum-digits-offset 1) node) - (storew x y bignum-digits-offset other-pointer-type)) - (inst jmp done))))) + (assert (not (location= x y))) + (assert (not (location= x temp))) + (assert (not (location= y temp))) + (let ((bignum (gen-label)) + (done (gen-label))) + (inst lea temp (make-ea :dword :base x :disp #x20000000)) + (inst cmp temp #x40000000) + (inst jmp :nb bignum) + (inst lea y (make-ea :dword :index x :scale 4)) + (emit-label done) + + (assemble (*elsewhere*) + (emit-label bignum) + (with-fixed-allocation (y bignum-type + (+ bignum-digits-offset 1) node) + (storew x y bignum-digits-offset other-pointer-type)) + (inst jmp done))))) ;;; (define-move-vop move-from-signed :move (signed-reg) (descriptor-reg)) @@ -325,23 +307,6 @@ ;;; Check for fixnum, and possibly allocate one or two word bignum result. Use ;;; a worst-case cost to make sure people know they may be number consing. ;;; -#+nil -(define-vop (move-from-unsigned) - (:args (x :scs (signed-reg unsigned-reg) :target eax)) - (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)) eax) - (:temporary (:sc unsigned-reg :offset ebx-offset :to (:result 0) :target y) - ebx) - (:temporary (:sc unsigned-reg :offset ecx-offset - :from (:argument 0) :to (:result 0)) ecx) - (:ignore ecx) - (:results (y :scs (any-reg descriptor-reg))) - (:note _N"unsigned word to integer coercion") - (:generator 20 - (move eax x) - (inst call (make-fixup 'move-from-unsigned :assembly-routine)) - (move y ebx))) -;;; -;;; Faster inline version. (define-vop (move-from-unsigned) (:args (x :scs (signed-reg unsigned-reg) :to :save)) (:temporary (:sc unsigned-reg) alloc) ----------------------------------------------------------------------- Summary of changes: src/assembly/x86/alloc.lisp | 57 ++-------------------------- src/compiler/x86/move.lisp | 87 +++++++++++++------------------------------ 2 files changed, 29 insertions(+), 115 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-10-gab44683
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 ab446830b129ca3607c4342c24849ca8554db7ce (commit) from 375ce218ab639fbc0b433942dbb7398a0bcd0177 (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 ab446830b129ca3607c4342c24849ca8554db7ce Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 15 20:06:40 2014 -0700 Micro optimize float bits getters. When the float is in a register, we don't have to store it to memory to get at the parts. SSE2 has instructions to move from an XMM register to a general purpose register. diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index 76bcc31..876b19d 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -1199,7 +1199,6 @@ (:args (float :scs (single-reg descriptor-reg) :load-if (not (sc-is float single-stack)))) (:results (bits :scs (signed-reg))) - (:temporary (:sc signed-stack :from :argument :to :result) stack-temp) (:arg-types single-float) (:result-types signed-num) (:translate single-float-bits) @@ -1210,8 +1209,7 @@ (signed-reg (sc-case float (single-reg - (inst movss stack-temp float) - (inst mov bits stack-temp)) + (inst movd bits float)) (single-stack (move bits float)) (descriptor-reg @@ -1226,7 +1224,7 @@ (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) (:results (hi-bits :scs (signed-reg))) - (:temporary (:sc double-stack) temp) + (:temporary (:sc double-reg) temp) (:arg-types double-float) (:result-types signed-num) (:translate double-float-high-bits) @@ -1235,11 +1233,9 @@ (:generator 5 (sc-case float (double-reg - (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 2 (tn-offset temp)) - word-bytes))))) - (inst movsd where float)) - (loadw hi-bits ebp-tn (- (1+ (tn-offset temp))))) + (inst movq temp float) + (inst psrlq temp 32) + (inst movd hi-bits temp)) (double-stack (loadw hi-bits ebp-tn (- (1+ (tn-offset float))))) (descriptor-reg @@ -1250,7 +1246,6 @@ (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) (:results (lo-bits :scs (unsigned-reg))) - (:temporary (:sc double-stack) temp) (:arg-types double-float) (:result-types unsigned-num) (:translate double-float-low-bits) @@ -1259,11 +1254,7 @@ (:generator 5 (sc-case float (double-reg - (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 2 (tn-offset temp)) - word-bytes))))) - (inst movsd where float)) - (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp))))) + (inst movd lo-bits float)) (double-stack (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) (descriptor-reg @@ -1278,19 +1269,17 @@ (lo-bits :scs (unsigned-reg))) (:arg-types double-float) (:result-types signed-num unsigned-num) - (:temporary (:sc double-stack) temp) + (:temporary (:sc double-reg) temp) (:translate kernel::double-float-bits) (:policy :fast-safe) (:vop-var vop) (:generator 5 (sc-case float (double-reg - (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 2 (tn-offset temp)) - word-bytes))))) - (inst movsd where float)) - (loadw hi-bits ebp-tn (- (+ 1 (tn-offset temp)))) - (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp))))) + (inst movq temp float) + (inst movd lo-bits temp) + (inst psrlq temp 32) + (inst movd hi-bits temp)) (double-stack (loadw hi-bits ebp-tn (- (+ 1 (tn-offset float)))) (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) @@ -1299,6 +1288,7 @@ vm:other-pointer-type) (loadw lo-bits float vm:double-float-value-slot vm:other-pointer-type))))) + ;;;; Float mode hackery: ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/float-sse2.lisp | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-75-g6b52c89
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 6b52c890ac41ba5deedd8b6ebaf33d4955fcfbd9 (commit) via 6f434b0e3a56af69c1e32eefc158cc74c5464da3 (commit) from fdc6db4b7af14ce1ceb6e38e92135335a4921fa3 (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 6b52c890ac41ba5deedd8b6ebaf33d4955fcfbd9 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 16:59:44 2014 -0700 Use fdlibm atan2. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 4ea134e..5f24bf9 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -68,7 +68,7 @@ (def-math-rtn ("fdlibm_cos" %cos) 1) (def-math-rtn ("fdlibm_tan" %tan) 1) (def-math-rtn ("fdlibm_atan" %atan) 1) -(def-math-rtn "atan2" 2) +(def-math-rtn ("__ieee754_atan2" %atan2) 2) (def-math-rtn ("__ieee754_asin" %asin) 1) (def-math-rtn ("__ieee754_acos" %acos) 1) (def-math-rtn ("__ieee754_sinh" %sinh) 1) commit 6f434b0e3a56af69c1e32eefc158cc74c5464da3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 16:59:14 2014 -0700 Compile the fdlibm atan2. . diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index d260368..a76280d 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -22,7 +22,8 @@ OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ s_log1p.c s_expm1.c e_pow.c e_exp.c e_log.c \ e_acos.c e_asin.c s_atan.c \ e_cosh.c e_sinh.c s_tanh.c \ - e_acosh.c s_asinh.c e_atanh.c + e_acosh.c s_asinh.c e_atanh.c \ + e_atan2.c k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -72,3 +73,6 @@ e_asinh.o : s_asinh.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< e_atanh.o : e_atanh.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +e_atan2.o : e_atan2.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 2 +- src/lisp/Config.x86_darwin | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-11-2-g20ee8ef
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 20ee8ef20cd01a0be841695d6beaf98968e5be31 (commit) from 373bc974935a33ff1515d0d1cce2af8f7d910c04 (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 20ee8ef20cd01a0be841695d6beaf98968e5be31 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Nov 7 22:33:42 2013 -0800 Add shortcut for (expt -1 power). diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 67ca060..927a5fb 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -318,11 +318,13 @@ ;;; of power are calculated as positive integers, and inverted if negative. ;;; (defun intexp (base power) - ;; Handle the special case of 1^power. Maxima sometimes does this, - ;; and there's no need to cause a continuable error in this case. - ;; Should we also handle (-1)^power? + ;; Handle the special case of 1^power and (-1)^power. Maxima + ;; sometimes does this, and there's no need to cause a continuable + ;; error in this case. (when (eql base 1) (return-from intexp base)) + (when (eql base -1) + (return-from intexp (if (oddp power) -1 1))) (when (> (abs power) *intexp-maximum-exponent*) ;; Allow user the option to continue with calculation, possibly ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp annotated tag snapshot-2014-08 created. snapshot-2014-08
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-08 has been created at 3d3259cd2f0d437388b69ecf50feedc73246096d (tag) tagging 98319835e05b93ea62e17f6bc3da4144f96ac2c5 (commit) replaces snapshot-2014-06 tagged by Raymond Toy on Thu Aug 7 21:30:43 2014 -0700 - Log ----------------------------------------------------------------- Snapshot 2014-08 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iEYEABECAAYFAlPkUnoACgkQJ5IjUmgZO7JzgwCgt4mPwW0Qx0sI3qtsXPOttVrq klAAnAxpd/KCElQ6ggJf82ZSVlhRBOJm =4mEx -----END PGP SIGNATURE----- Raymond Toy (101): Change max gen to GC to 3; add inteface to set it. Fix declaration of min-av-mem-age in generation-stats. Import fdlibm trig functions; as is, from netlib. Update to use unions, using the style of e_rem_pio2.c. Add declarations for the fdlibm trig functions. Compile fdlibm trig functions on linux and darwin. Darwin doesn't need fdlibm because the system library is good. Add implmeentation of sincos in C. Comment out all of the trig functions in lisp in favor of calling out Oops. Didn't comment out quite enough. Add sincos for x86 linux. For consistency with sincos, we need to include the fdlibm trig ppc doesn't have sincos in libm so use our own version. Oops. Need k_sin and k_cos for sincos. Add rest of fdblim trig functios so that sincos is consistent with sin Put back the deftransforms for sin/cos/tan so we can call out directly Add fdlibm trig for sparc. Add fdlibm trig routines for NetBSD. Fix stupid typo that causes sin to converted to asin. All platforms have sincos now, so remove the deftransform for cis that Add declaration to ignore unused variable. Rename sin/cos/tan/sincos so we don't collide with libm. Add include guard. Some cleanup of the trig code. Comment code, add license header, and conform to cmucl C style. Ignore emacs ~ files and fasls. Finally remove the Lisp implementation of the trig functions that are Add expm1 to match log1p. All platforms seem to have expm1 as well. Remove the mathcalls section. It's not used and some of it (log1p) is Update to 3.1.3. Fix ticket ##104: Source location for define-condition Add README to document the naming convention of boot files. Add info for cross-compile scripts. CLEAR-OUTPUT should call STREAM-CLEAR-OUTPUT for Gray streams. Implement CLEAR-OUTPUT for FD-STREAM's. Add tests for CLEAR-OUTPUT. Import log1p from fdlibm, as is. Import expm1 from fdlibm, as is. Modify to use unions and change name to include fdlibm prefix. Compile s_log1p and s_expm1. Use fdlibm versions of log1p and expm1. Import pow (ieee754_pow) from fdlibm, as is. Update to use unions. Compile e_pow as a part of lisp. Use __ieee754_pow instead of pow. Compile the new fdlibm routines. Compile the new fdlibm routines. Compile the new fdlibm routines. Add fdlibm routines e_exp and e_log, as is. Update to use unions. Compile fdlibm routines e_exp.c and e_log.c Use the fdlibm routines for exp and log. Import inverse trig functions from fdlibm, as is. Use unions to access the high and low parts of a double. Compile the asin, acos, and atan routines. Use the fdlibm asin, acos, and atan routines. Initialize t to get rid of a compiler warning from clang. Initialize k to get rid of a compiler warning from clang. Remove the sccsid variable. Add some braces to silence the warning from clang about dangling else Add some braces to silence the warning from clang about dangling else Import hyperbolic functions from fdlibm, as is. Use unions to access the high and low parts of a double and update Add parens around && expressions to silence a clang warning. Compile the fdlibm hyperbolic functions. Use fdlibm hyperbolic functions instead of libm. Import inverse hyperbolic functions from fdlibm, as is. Fix up the inverse hyperbolics. Compile the fdlibm inverse hyperbolics. Use the fdlibm inverse hyperbolic functions. Import atan2 function from fdlibm, as is. Fix up atan2 by using unions. Use fdlibm_atan instead of atan. Compile the fdlibm atan2. Use fdlibm atan2. Use correct flags to generate sse2 instructions in the C code and Clean up config files. Remove the list of fdlibm files from here because they're in Forgot to remove e_rem_pio2 and friends. -march=pentium4 imples -msse2, so drop the latter. Update netbsd config. Untested. Forgot to remove e_rem_pio2 and friends from a few more Config files Remove CC_REM_PIO2 and add new CPPFLAGS to force compiling with sse2 add -mtune=generic to get optimization for the most common x86 Update from commit logs. Initialize c to get rid of a compiler warning on Linux with gcc 4.4.1. Add parens around operands of | to silence a compiler warning with gcc Initilize hi and lo to get rid of a compiler warning from gcc 4.4.1 on Fix aliasing issue noted by gcc 4.4.1 on Linux. Fix aliasing issue noted by gcc 4.4.1 on Linux. Oops. Fix typo by removing the extraneous comma that was left in. Fix bug in DOUBLE-FLOAT-BITS vop. Remove -mtune=generic from Config.x86_common. Update LDFLAGS for NetBSD so motifd will build and run correctly on Oops. x86-assem needs -m32. Document that the argument/result timespec starts at 0, not 1. Simplify SSE2-FLOATING-POINT-MODES vop by removing an unneeded Addresses ticket #84 for Linux. Fix typo and add -m32 to LDFLAGS. Remove commented-out LDFLAGS. Regenerated and updated. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-43-gca2bf8c
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 ca2bf8c29d22aaf44caf31f1d7b6ba77ab418be5 (commit) from 894af6c4aaa3b83f3c13d2e59735c33f79abdc20 (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 ca2bf8c29d22aaf44caf31f1d7b6ba77ab418be5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 24 12:57:45 2013 -0800 Fix ticket:90 src/code/irrat.lisp: src/code/irrat-dd.lisp: * Remove the special case that made atanh continuous with quadrant III for x < -1 on the branch cut. tests/trig.lisp: * Update tests for atanh * Rename rel-or-abs-error to close-to. diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index 024ec93..dbe9159 100644 --- a/src/code/irrat-dd.lisp +++ b/src/code/irrat-dd.lisp @@ -1663,63 +1663,59 @@ Z may be any number, but the result is always a complex." (defun dd-complex-atanh (z) _N"Compute atanh z = (log(1+z) - log(1-z))/2" (declare (number z)) - (cond ((and (realp z) (< z -1)) - ;; ATANH is continuous with quadrant III in this case. - (dd-complex-atanh (complex z -0d0))) - (t - (let* ( ;; Constants - (theta (/ (sqrt most-positive-double-float) 4.0w0)) - (rho (/ 4.0w0 (sqrt most-positive-double-float))) - (half-pi dd-pi/2) - (rp (float (realpart z) 1.0w0)) - (beta (float-sign rp 1.0w0)) - (x (* beta rp)) - (y (* beta (- (float (imagpart z) 1.0w0)))) - (eta 0.0w0) - (nu 0.0w0)) - ;; Shouldn't need this declare. - (declare (double-double-float x y)) - (locally - (declare (optimize (speed 3) - (inhibit-warnings 3))) - (cond ((or (> x theta) - (> (abs y) theta)) - ;; To avoid overflow... - (setf nu (float-sign y half-pi)) - ;; eta is real part of 1/(x + iy). This is x/(x^2+y^2), - ;; which can cause overflow. Arrange this computation so - ;; that it won't overflow. - (setf eta (let* ((x-bigger (> x (abs y))) - (r (if x-bigger (/ y x) (/ x y))) - (d (+ 1.0d0 (* r r)))) - (if x-bigger - (/ (/ x) d) - (/ (/ r y) d))))) - ((= x 1.0w0) - ;; Should this be changed so that if y is zero, eta is set - ;; to +infinity instead of approx 176? In any case - ;; tanh(176) is 1.0d0 within working precision. - (let ((t1 (+ 4w0 (square y))) - (t2 (+ (abs y) rho))) - (setf eta (dd-%log (/ (sqrt (sqrt t1)) - (sqrt t2)))) - (setf nu (* 0.5d0 - (float-sign y - (+ half-pi (dd-%atan (* 0.5d0 t2)))))))) - (t - (let ((t1 (+ (abs y) rho))) - ;; Normal case using log1p(x) = log(1 + x) - (setf eta (* 0.25d0 - (dd-%log1p (/ (* 4.0d0 x) - (+ (square (- 1.0d0 x)) - (square t1)))))) - (setf nu (* 0.5d0 - (dd-%atan2 (* 2.0d0 y) - (- (* (- 1.0d0 x) - (+ 1.0d0 x)) - (square t1)))))))) - (complex (* beta eta) - (- (* beta nu)))))))) + (let* ( ;; Constants + (theta (/ (sqrt most-positive-double-float) 4.0w0)) + (rho (/ 4.0w0 (sqrt most-positive-double-float))) + (half-pi dd-pi/2) + (rp (float (realpart z) 1.0w0)) + (beta (float-sign rp 1.0w0)) + (x (* beta rp)) + (y (* beta (- (float (imagpart z) 1.0w0)))) + (eta 0.0w0) + (nu 0.0w0)) + ;; Shouldn't need this declare. + (declare (double-double-float x y)) + (locally + (declare (optimize (speed 3) + (inhibit-warnings 3))) + (cond ((or (> x theta) + (> (abs y) theta)) + ;; To avoid overflow... + (setf nu (float-sign y half-pi)) + ;; eta is real part of 1/(x + iy). This is x/(x^2+y^2), + ;; which can cause overflow. Arrange this computation so + ;; that it won't overflow. + (setf eta (let* ((x-bigger (> x (abs y))) + (r (if x-bigger (/ y x) (/ x y))) + (d (+ 1.0d0 (* r r)))) + (if x-bigger + (/ (/ x) d) + (/ (/ r y) d))))) + ((= x 1.0w0) + ;; Should this be changed so that if y is zero, eta is set + ;; to +infinity instead of approx 176? In any case + ;; tanh(176) is 1.0d0 within working precision. + (let ((t1 (+ 4w0 (square y))) + (t2 (+ (abs y) rho))) + (setf eta (dd-%log (/ (sqrt (sqrt t1)) + (sqrt t2)))) + (setf nu (* 0.5d0 + (float-sign y + (+ half-pi (dd-%atan (* 0.5d0 t2)))))))) + (t + (let ((t1 (+ (abs y) rho))) + ;; Normal case using log1p(x) = log(1 + x) + (setf eta (* 0.25d0 + (dd-%log1p (/ (* 4.0d0 x) + (+ (square (- 1.0d0 x)) + (square t1)))))) + (setf nu (* 0.5d0 + (dd-%atan2 (* 2.0d0 y) + (- (* (- 1.0d0 x) + (+ 1.0d0 x)) + (square t1)))))))) + (complex (* beta eta) + (- (* beta nu)))))) (defun dd-complex-tanh (z) _N"Compute tanh z = sinh z / cosh z" diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index ff23a5e..e4e744d 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -1741,62 +1741,59 @@ Z may be any number, but the result is always a complex." (when (typep z '(or double-double-float (complex double-double-float))) (return-from complex-atanh (dd-complex-atanh z))) - (if (and (realp z) (< z -1)) - ;; atanh is continuous in quadrant III in this case. - (complex-atanh (complex z -0f0)) - (let* ( ;; Constants - (theta (/ (sqrt most-positive-double-float) 4.0d0)) - (rho (/ 4.0d0 (sqrt most-positive-double-float))) - (half-pi (/ pi 2.0d0)) - (rp (float (realpart z) 1.0d0)) - (beta (float-sign rp 1.0d0)) - (x (* beta rp)) - (y (* beta (- (float (imagpart z) 1.0d0)))) - (eta 0.0d0) - (nu 0.0d0)) - ;; Shouldn't need this declare. - (declare (double-float x y)) - (locally - (declare (optimize (speed 3))) - (cond ((or (> x theta) - (> (abs y) theta)) - ;; To avoid overflow... - (setf nu (float-sign y half-pi)) - ;; eta is real part of 1/(x + iy). This is x/(x^2+y^2), - ;; which can cause overflow. Arrange this computation so - ;; that it won't overflow. - (setf eta (let* ((x-bigger (> x (abs y))) - (r (if x-bigger (/ y x) (/ x y))) - (d (+ 1.0d0 (* r r)))) - (if x-bigger - (/ (/ x) d) - (/ (/ r y) d))))) - ((= x 1.0d0) - ;; Should this be changed so that if y is zero, eta is set - ;; to +infinity instead of approx 176? In any case - ;; tanh(176) is 1.0d0 within working precision. - (let ((t1 (+ 4d0 (square y))) - (t2 (+ (abs y) rho))) - (setf eta (log (/ (sqrt (sqrt t1)) - (sqrt t2)))) - (setf nu (* 0.5d0 - (float-sign y - (+ half-pi (atan (* 0.5d0 t2)))))))) - (t - (let ((t1 (+ (abs y) rho))) - ;; Normal case using log1p(x) = log(1 + x) - (setf eta (* 0.25d0 - (%log1p (/ (* 4.0d0 x) - (+ (square (- 1.0d0 x)) - (square t1)))))) - (setf nu (* 0.5d0 - (atan (* 2.0d0 y) - (- (* (- 1.0d0 x) - (+ 1.0d0 x)) - (square t1)))))))) - (coerce-to-complex-type (* beta eta) - (- (* beta nu)) - z))))) + (let* ( ;; Constants + (theta (/ (sqrt most-positive-double-float) 4.0d0)) + (rho (/ 4.0d0 (sqrt most-positive-double-float))) + (half-pi (/ pi 2.0d0)) + (rp (float (realpart z) 1.0d0)) + (beta (float-sign rp 1.0d0)) + (x (* beta rp)) + (y (* beta (- (float (imagpart z) 1.0d0)))) + (eta 0.0d0) + (nu 0.0d0)) + ;; Shouldn't need this declare. + (declare (double-float x y)) + (locally + (declare (optimize (speed 3))) + (cond ((or (> x theta) + (> (abs y) theta)) + ;; To avoid overflow... + (setf nu (float-sign y half-pi)) + ;; eta is real part of 1/(x + iy). This is x/(x^2+y^2), + ;; which can cause overflow. Arrange this computation so + ;; that it won't overflow. + (setf eta (let* ((x-bigger (> x (abs y))) + (r (if x-bigger (/ y x) (/ x y))) + (d (+ 1.0d0 (* r r)))) + (if x-bigger + (/ (/ x) d) + (/ (/ r y) d))))) + ((= x 1.0d0) + ;; Should this be changed so that if y is zero, eta is set + ;; to +infinity instead of approx 176? In any case + ;; tanh(176) is 1.0d0 within working precision. + (let ((t1 (+ 4d0 (square y))) + (t2 (+ (abs y) rho))) + (setf eta (log (/ (sqrt (sqrt t1)) + (sqrt t2)))) + (setf nu (* 0.5d0 + (float-sign y + (+ half-pi (atan (* 0.5d0 t2)))))))) + (t + (let ((t1 (+ (abs y) rho))) + ;; Normal case using log1p(x) = log(1 + x) + (setf eta (* 0.25d0 + (%log1p (/ (* 4.0d0 x) + (+ (square (- 1.0d0 x)) + (square t1)))))) + (setf nu (* 0.5d0 + (atan (* 2.0d0 y) + (- (* (- 1.0d0 x) + (+ 1.0d0 x)) + (square t1)))))))) + (coerce-to-complex-type (* beta eta) + (- (* beta nu)) + z)))) (defun complex-tanh (z) "Compute tanh z = sinh z / cosh z" diff --git a/tests/trig.lisp b/tests/trig.lisp index 05437e5..df76231 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -215,18 +215,20 @@ (assert-eql nil (sincos-test (scale-float 1d0 1023) 1000))) -;; Compute the relative error between actual and expected if expected -;; is not zero. Otherwise, return absolute error between actual and -;; expected. If the error is less than the threshold, return T. -;; Otherwise return the actual (relative or absolute) error. -(defun rel-or-abs-error (actual expected &optional (threshold double-float-epsilon)) +(defun close-to (actual expected &optional (threshold double-float-epsilon)) + "Determine if Actual is close to Expected. If Expected is not zero, + then close-to returns t if |Actual - Expected|/|Expected| <= + Threshold. If Expected is 0, then close-to returns T if |Actual - + Expected| <= threshold. In either of these conditions does not + hold, then a list of the actual error (relative or absolute), the + actual value and the expected value is returned." (let ((err (if (zerop expected) (abs (- actual expected)) (/ (abs (- actual expected)) (abs expected))))) (if (<= err threshold) t - err))) + (list err actual expected)))) ;;; Tests for double-double-floats @@ -239,11 +241,11 @@ (define-test dd-sin.no-reduction "Test sin for small args without reduction" (:tag :sin :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin .5w0) 4.794255386042030002732879352155713880818033679406006751886166131w-1 1w-32)) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin -0.5w0) -4.794255386042030002732879352155713880818033679406006751886166131w-1 1w-32))) @@ -251,7 +253,7 @@ (define-test dd-sin.pi/2 "Test for arg near pi/2" (:tag :sin :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (/ kernel:dd-pi 2)) 1w0 1w-50))) @@ -265,27 +267,27 @@ "Test for sin with arg reduction" (:tag :sin :double-double) ;; Test for argument reduction with n mod 4 = 0 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (* 7/4 kernel:dd-pi)) -7.07106781186547524400844362104849691328261037289050238659653433w-1 0w0)) ;; Test for argument reduction with n mod 4 = 1 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (* 9/4 kernel:dd-pi)) 7.07106781186547524400844362104858161816423215627023442400880643w-1 0w0)) ;; Test for argument reduction with n mod 4 = 2 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (* 11/4 kernel:dd-pi)) 7.071067811865475244008443621048998682901731241858306822215522497w-1 8.716w-33)) ;; Test for argument reduction with n mod 4 = 3 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (* 13/4 kernel:dd-pi)) -7.071067811865475244008443621048777109664479707052746581685893187w-1 8.716w-33)) ;; Test for argument reduction, big value - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (sin (scale-float 1w0 120)) 3.778201093607520226555484700569229919605866976512306642257987199w-1 8.156w-33))) @@ -299,11 +301,11 @@ (define-test dd-cos.no-reduction "Test cos for small args without reduction" (:tag :cos :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos .5w0) 8.775825618903727161162815826038296519916451971097440529976108683w-1 0w0)) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos -0.5w0) 8.775825618903727161162815826038296519916451971097440529976108683w-1 0w0))) @@ -311,7 +313,7 @@ (define-test dd-cos.pi/2 "Test for arg near pi/2" (:tag :cos :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (/ kernel:dd-pi 2)) -1.497384904859169777320797133937725094986669701841027904483071358w-33 0w0))) @@ -320,27 +322,27 @@ "Test for cos with arg reduction" (:tag :cos :double-double) ;; Test for argument reduction with n mod 4 = 0 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (* 7/4 kernel:dd-pi)) 7.07106781186547524400844362104849691328261037289050238659653433w-1 0w0)) ;; Test for argument reduction with n mod 4 = 1 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (* 9/4 kernel:dd-pi)) 7.07106781186547524400844362104858161816423215627023442400880643w-1 3.487w-32)) ;; Test for argument reduction with n mod 4 = 2 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (* 11/4 kernel:dd-pi)) -7.071067811865475244008443621048998682901731241858306822215522497w-1 1.482w-31)) ;; Test for argument reduction with n mod 4 = 3 - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (* 13/4 kernel:dd-pi)) -7.071067811865475244008443621048777109664479707052746581685893187w-1 7.845w-32)) ;; Test for argument reduction, big value - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (cos (scale-float 1w0 120)) -9.258790228548378673038617641074149467308332099286564602360493726w-1 0w0))) @@ -354,11 +356,11 @@ (define-test dd-tan.no-reduction "Test tan for small args without reduction" (:tag :tan :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan .5w0) 5.463024898437905132551794657802853832975517201797912461640913859w-1 0w0)) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan -0.5w0) -5.463024898437905132551794657802853832975517201797912461640913859w-1 0w0))) @@ -366,7 +368,7 @@ (define-test dd-tan.pi/2 "Test for arg near pi/2" (:tag :tan :double-double) - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan (/ kernel:dd-pi 2)) -6.67830961000672557834948096545679895621313886078988606234681001w32 0w0))) @@ -375,17 +377,17 @@ "Test for tan with arg reduction" (:tag :tan :double-double) ;; Test for argument reduction with n even - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan (* 7/4 kernel:dd-pi)) -1.000000000000000000000000000000001844257310064121018312678894979w0 3.422w-49)) ;; Test for argument reduction with n odd - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan (* 9/4 kernel:dd-pi)) 1.000000000000000000000000000000025802415787810837455445433037983w0 0w0)) ;; Test for argument reduction, big value - (assert-eq t (rel-or-abs-error + (assert-eq t (close-to (tan (scale-float 1w0 120)) -4.080663888418042385451434945255951177650840227682488471558860153w-1 1.888w-33))) @@ -753,7 +755,8 @@ ;; Thus, atanh(-2) is continuous with Quadrant II, NOT continuous with ;; Quadrant III! ;; -;; What do we do? +;; The formula, however, is clear. We will use the formula and ignore +;; the text in the CLHS. (defun atanh-def (z) (r*z 1/2 (- (log (1+z z)) @@ -761,19 +764,19 @@ (define-test branch-cut.atanh (:tag :atanh :branch-cuts) - ;; Test for x < -1, which is continuous with Quadrant III. Use the - ;; the value at #c(-2d0 -1d-20) as the reference. + ;; Test for x < -1, which is continuous with Quadrant II. Use the + ;; the value at #c(-2d0 +1d-20) as the reference. (multiple-value-bind (tr ti) - (get-signs (atanh-def #c(-2d0 -1d-20))) + (get-signs (atanh-def #c(-2d0 1d-20))) (assert-true (check-signs #'atanh -2d0 tr ti)) (assert-true (check-signs #'atanh -2w0 tr ti)) - (assert-true (check-signs #'atanh #c(-2d0 -0d0) tr ti)) - (assert-true (check-signs #'atanh #c(-2w0 -0w0) tr ti))) + (assert-true (check-signs #'atanh #c(-2d0 +0d0) tr ti)) + (assert-true (check-signs #'atanh #c(-2w0 +0w0) tr ti))) ;; Test the other side of the branch cut for x < -1. (multiple-value-bind (tr ti) - (get-signs (atanh-def #c(-2d0 +1d-20))) - (assert-true (check-signs #'atanh #c(-2d0 0d0) tr ti)) - (assert-true (check-signs #'atanh #c(-2w0 0w0) tr ti))) + (get-signs (atanh-def #c(-2d0 -1d-20))) + (assert-true (check-signs #'atanh #c(-2d0 -0d0) tr ti)) + (assert-true (check-signs #'atanh #c(-2w0 -0w0) tr ti))) ;; Test for x > 1, which is continuous with Quadrant I, using the ;; value at #c(+2d0 1d-10) as the reference ----------------------------------------------------------------------- Summary of changes: src/code/irrat-dd.lisp | 110 +++++++++++++++++++++++------------------------- src/code/irrat.lisp | 109 +++++++++++++++++++++++------------------------ tests/trig.lisp | 77 +++++++++++++++++---------------- 3 files changed, 146 insertions(+), 150 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-03-a-11-g81f3fa2
by rtoy＠alpha-cl-net.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 81f3fa22008571b8a1c214e20086ab175ce26573 (commit) from c647866d61b29968c39d1722ad61d02061acfe7a (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 81f3fa22008571b8a1c214e20086ab175ce26573 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Apr 13 20:16:32 2013 -0700 Update from logs. diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index 06f5173..74e024e 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -58,6 +58,7 @@ New in this release: caused by the release string not having a patch version. * FILE-POSITION no longer returns incorrect values. See ticket #79. + * Fix error in (format t "~ve" 21 5d-324). (See ticket #80). * Trac Tickets: ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20e.txt | 1 + 1 file changed, 1 insertion(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. begin-x87-removal-19-g87aed56
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 87aed560fb118c488a3ea2824ed3fbddf9930cd2 (commit) via 28455f5114df02062ea6deddb8fb47a9de8c063f (commit) from 7fe70d3a8856058f4bb4b10602d7eadf18444791 (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 87aed560fb118c488a3ea2824ed3fbddf9930cd2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Apr 27 18:18:15 2014 -0700 Remove more sse2 stuff. * Exit if the chip doesn't support sse2. * Treat any mode setting as being the same as sse2 and return the sse2 core name. diff --git a/src/lisp/x86-arch.c b/src/lisp/x86-arch.c index c694cea..841e2cc 100644 --- a/src/lisp/x86-arch.c +++ b/src/lisp/x86-arch.c @@ -108,17 +108,16 @@ arch_init(fpu_mode_t mode) have_sse2 = arch_support_sse2() && os_support_sse2(); + if (!have_sse2) { + fprintf(stderr, "CMUCL requires a SSE2 support; exiting\n"); + abort(); + } + switch (mode) { case AUTO: - if (have_sse2) { - return "lisp-sse2.core"; - } else { - return "lisp-x87.core"; - } - break; case X87: - return "lisp-x87.core"; - break; + fprintf(stderr, "fpu mode AUTO or X87 is not longer supported.\n"); + /* Fall through and return the sse2 core */ case SSE2: return "lisp-sse2.core"; break; commit 28455f5114df02062ea6deddb8fb47a9de8c063f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Apr 27 18:16:45 2014 -0700 Rmove more x87 fpu mode stuff. * Darwin-os.c: * Linux-os.c: * FEATURE_SSE2 is always true so remove the #ifdef's * Don't merge the x87 fpu mode bits with the sse2 ones; we only want sse2. * restore_fpu doesn't need to restore the x87 fpu mode bits. diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c index 693cbf6..5e8ddf9 100644 --- a/src/lisp/Darwin-os.c +++ b/src/lisp/Darwin-os.c @@ -22,6 +22,8 @@ #include <errno.h> #include <dlfcn.h> #include <string.h> +#include <assert.h> + #include "os.h" #include "arch.h" #include "globals.h" @@ -332,7 +334,6 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index) return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm6; case 7: return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7; -#ifdef FEATURE_SSE2 case 8: return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm0; case 9: @@ -348,43 +349,21 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index) case 14: return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm6; case 15: - return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7; -#endif + return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7; + default: + return NULL; } - return NULL; } unsigned int os_sigcontext_fpu_modes(ucontext_t *scp) { unsigned int modes; - unsigned int mxcsr; - unsigned short cw, sw; - - /* - * Get the status word and the control word. - */ - memcpy(&cw, &scp->uc_mcontext->__fs.__fpu_fcw, sizeof(cw)); - memcpy(&sw, &scp->uc_mcontext->__fs.__fpu_fsw, sizeof(sw)); - /* - * Put the cw in the upper bits and the status word in the lower 6 - * bits, ignoring everything except the exception masks and the - * exception flags. - */ - modes = ((cw & 0x3f) << 7) | (sw & 0x3f); + assert(fpu_mode == SSE2); - DPRINTF(0, (stderr, "FPU modes = %08x (sw = %4x, cw = %4x)\n", - modes, (unsigned int) sw, (unsigned int) cw)); - - if (fpu_mode == SSE2) { - mxcsr = scp->uc_mcontext->__fs.__fpu_mxcsr; - DPRINTF(0, (stderr, "SSE2 modes = %08x\n", mxcsr)); - - modes |= mxcsr; - } - - DPRINTF(0, (stderr, "modes pre mask = %08x\n", modes)); + modes = scp->uc_mcontext->__fs.__fpu_mxcsr; + DPRINTF(0, (stderr, "SSE2 modes = %08x\n", modes)); /* Convert exception mask to exception enable */ modes ^= (0x3f << 7); @@ -395,16 +374,11 @@ os_sigcontext_fpu_modes(ucontext_t *scp) void restore_fpu(ucontext_t *scp) { - unsigned short cw; unsigned int mxcsr; - memcpy(&cw, &scp->uc_mcontext->__fs.__fpu_fcw, sizeof(cw)); - DPRINTF(0, (stderr, "restore_fpu: FPU cw = 0x%x\n", cw)); - __asm__ __volatile__ ("fclex"); - __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw)); - mxcsr = scp->uc_mcontext->__fs.__fpu_mxcsr; DPRINTF(0, (stderr, "restore_fpu: mxcsr (raw) = %04x\n", mxcsr)); + __asm__ __volatile__ ("ldmxcsr %0" :: "m" (*&mxcsr)); } #endif diff --git a/src/lisp/Linux-os.c b/src/lisp/Linux-os.c index 7f7a4d7..2da60fb 100644 --- a/src/lisp/Linux-os.c +++ b/src/lisp/Linux-os.c @@ -217,16 +217,13 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int offset) if (fpregs) { if (offset < 8) { reg = (unsigned char *) &fpregs->_st[offset]; - } -#ifdef FEATURE_SSE2 - else { + } else if (offset < 16) { struct _fpstate *fpstate; fpstate = (struct _fpstate*) scp->uc_mcontext.fpregs; if (fpstate->magic != 0xffff) { reg = (unsigned char *) &fpstate->_xmm[offset - 8]; } } -#endif } return reg; } @@ -234,39 +231,27 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int offset) unsigned int os_sigcontext_fpu_modes(ucontext_t *scp) { - unsigned int modes; - unsigned short cw, sw; - - if (scp->uc_mcontext.fpregs == NULL) { - cw = 0; - sw = 0x3f; - } else { - cw = scp->uc_mcontext.fpregs->cw & 0xffff; - sw = scp->uc_mcontext.fpregs->sw & 0xffff; - } + unsigned int modes = 0; - modes = ((cw & 0x3f) << 7) | (sw & 0x3f); - -#ifdef FEATURE_SSE2 /* - * Add in the SSE2 part, if we're running the sse2 core. + * Get the SSE2 modes. FIXME: What should we do if the magic + * value indicates that the mxcsr value is not in the context? */ - if (fpu_mode == SSE2) { - struct _fpstate *fpstate; - unsigned long mxcsr; - - fpstate = (struct _fpstate*) scp->uc_mcontext.fpregs; - if (fpstate->magic == 0xffff) { - mxcsr = 0; - } else { - mxcsr = fpstate->mxcsr; - DPRINTF(0, (stderr, "SSE2 modes = %08lx\n", mxcsr)); - } + struct _fpstate *fpstate; + unsigned long mxcsr; - modes |= mxcsr; + fpstate = (struct _fpstate*) scp->uc_mcontext.fpregs; + if (fpstate->magic == 0xffff) { + mxcsr = 0; + } else { + mxcsr = fpstate->mxcsr; + DPRINTF(0, (stderr, "SSE2 modes = %08lx\n", mxcsr)); } -#endif + modes |= mxcsr; + + + /* Convert exception mask to exception enable */ modes ^= (0x3f << 7); return modes; } @@ -543,25 +528,19 @@ void restore_fpu(ucontext_t *context) { if (context->uc_mcontext.fpregs) { - short cw = context->uc_mcontext.fpregs->cw; - DPRINTF(0, (stderr, "restore_fpu: cw = %08x\n", cw)); - __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw)); -#ifdef FEATURE_SSE2 - if (fpu_mode == SSE2) { - struct _fpstate *fpstate; - unsigned int mxcsr; + struct _fpstate *fpstate; + unsigned int mxcsr; - fpstate = (struct _fpstate*) context->uc_mcontext.fpregs; - if (fpstate->magic != 0xffff) { - mxcsr = fpstate->mxcsr; - DPRINTF(0, (stderr, "restore_fpu: mxcsr (raw) = %04x\n", mxcsr)); - __asm__ __volatile__ ("ldmxcsr %0" :: "m" (*&mxcsr)); - } + fpstate = (struct _fpstate*) context->uc_mcontext.fpregs; + if (fpstate->magic != 0xffff) { + mxcsr = fpstate->mxcsr; + DPRINTF(0, (stderr, "restore_fpu: mxcsr (raw) = %04x\n", mxcsr)); + __asm__ __volatile__ ("ldmxcsr %0" :: "m" (*&mxcsr)); } -#endif } } + #ifdef i386 boolean os_support_sse2() ----------------------------------------------------------------------- Summary of changes: src/lisp/Darwin-os.c | 44 +++++++------------------------- src/lisp/Linux-os.c | 69 ++++++++++++++++++-------------------------------- src/lisp/x86-arch.c | 15 +++++------ 3 files changed, 40 insertions(+), 88 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0