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

[git] CMU Common Lisp branch master updated. 20e-5-g61218b9
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 61218b92d2f2ed8b83816a5037b1afb46c3c6619 (commit) from 07e2d61f67dbd0e099c256052ba70358125cc008 (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 61218b92d2f2ed8b83816a5037b1afb46c3c6619 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Oct 21 18:12:11 2013 -0700 Update according to commit logs. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 3c6db52..3b3f9ef 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -25,6 +25,8 @@ New in this release: * Changes * When *PRINT-CASE* is :DOWNCASE, integers are printed with lowercase letters when needed. + * Micro-optimize KERNEL:DOUBLE-FLOAT-BITS for x86/sse2. + * Add micro-optimization for unary FTRUNCATE for x86/sse2. * ANSI compliance fixes: ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 2 ++ 1 file changed, 2 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-04-23-g31b1a5a
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 31b1a5a17dfebc3fd532f4443e7cbad70be2b4ba (commit) via 2d4d5a7f1ce6dd95f2c268a880b6e4f8e16de44b (commit) via 29d75bdbebc5d83ee777403999c36a6e1342b2d8 (commit) from f7506ddc36c87beb770661e6f22e74807023a06a (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 31b1a5a17dfebc3fd532f4443e7cbad70be2b4ba Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:13:46 2013 -0700 Add -z noexecstack to disable exec flag for the C stack. diff --git a/src/lisp/Config.x86_linux b/src/lisp/Config.x86_linux index de24e73..569f4f5 100644 --- a/src/lisp/Config.x86_linux +++ b/src/lisp/Config.x86_linux @@ -6,7 +6,8 @@ CPPFLAGS += -m32 -rdynamic -D__NO_CTYPE -D_GNU_SOURCE UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S OS_SRC += Linux-os.c elf.c -OS_LINK_FLAGS = -m32 -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo OS_LIBS = -ldl +OS_LINK_FLAGS = -m32 -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo +OS_LINK_FLAGS += -Wl,-z,noexecstack EXEC_FINAL_OBJ = exec-final.o commit 2d4d5a7f1ce6dd95f2c268a880b6e4f8e16de44b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:11:25 2013 -0700 Don't need to set CC or CPP. But add a note that we implicitly assume cc is Sun's C compiler, not an alias to gcc. diff --git a/src/lisp/Config.sparc_sunc b/src/lisp/Config.sparc_sunc index e1614e6..f5fb0e7 100644 --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -1,5 +1,9 @@ # -*- Mode: makefile -*- +# Build cmucl using Sun C compiler. We assume cc is Sun's C compiler. +# If you don't have it, why are you using this Config anyway? You're +# on your own if you use this Config without Sun C compiler available. + include Config.sparc_common # For v8plus support (allows 64-bit integer support on V9 @@ -20,8 +24,6 @@ CC_V8PLUS = -m32 -xarch=sparc AS_V8PLUS = -m32 -xarch=sparc endif -CC = cc -CPP = cc CFLAGS += -xlibmieee -O -DEPEND_FLAGS = -E -xM +DEPEND_FLAGS = -xM ASFLAGS = $(AS_V8PLUS) commit 29d75bdbebc5d83ee777403999c36a6e1342b2d8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:08:17 2013 -0700 Make stacks not executable. diff --git a/src/lisp/Config.sparc_common b/src/lisp/Config.sparc_common index 89e2de0..551491a 100644 --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -57,6 +57,6 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c -OS_LINK_FLAGS= +OS_LINK_FLAGS = -M /usr/lib/ld/map.noexstk OS_LIBS= -lsocket -lnsl -ldl EXEC_FINAL_OBJ = exec-final.o ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.sparc_common | 2 +- src/lisp/Config.sparc_sunc | 8 +++++--- src/lisp/Config.x86_linux | 3 ++- 3 files changed, 8 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-20-gd2f946a
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 d2f946ac549cdc8da46c3bfbee61c52d8fd81f5e (commit) from b9a6091a28a431b4f11300b350e77f57d8389b19 (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 d2f946ac549cdc8da46c3bfbee61c52d8fd81f5e Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Aug 21 21:46:46 2014 -0700 Fix some typos and remove redundant test for expm1. diff --git a/tests/trig.lisp b/tests/trig.lisp index 1452c4c..2f4a945 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -875,16 +875,15 @@ (:tag :fdlibm) (assert-error 'floating-point-overflow (kernel:%expm1 709.8d0)) - (assert-equal 'ext:double-float-positive-infinity + (assert-equal ext:double-float-positive-infinity (kernel:%expm1 ext:double-float-positive-infinity)) (assert-error 'floating-point-invalid-operation (kernel:%expm1 *snan*)) (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*))) (kernel::with-float-traps-masked (:overflow) - (assert-true ext:double-float-positive-infinity + (assert-equal ext:double-float-positive-infinity (kernel:%expm1 709.8d0)) - (assert-true ext:double-float-positive-infinity - (kernel:%expm1 ext:double-float-positive-infinity))) + ) (kernel::with-float-traps-masked (:invalid) (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) ----------------------------------------------------------------------- Summary of changes: tests/trig.lisp | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-09-8-gc01e6f9
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 c01e6f9d9be67e4aedb33857a00f8d20697a19ef (commit) from eee2366d1dd68701aa210dd62e2319e5e50b631a (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 c01e6f9d9be67e4aedb33857a00f8d20697a19ef Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 21 15:07:44 2013 -0700 Make :plus-integer actually print + or - as documented. The comment says the field should be proceeded with a + or -, but depended on negative integers producing the needed -. When disassembling with a radix, this doesn't produce the expected output (#x7 vs #x-7 vs -#x7). So really print + or - followed by the absolute value. diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 1316aa2..762b77b 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -952,13 +952,14 @@ ((eq (car source) :plus-integer) ;; prints the given field proceed with a + or a - (let ((form - (arg-value-form (arg-or-lose (cadr source) funstate) - funstate - :numeric))) + (arg-value-form (arg-or-lose (cadr source) funstate) + funstate + :numeric))) `(progn - (when (>= ,form 0) - (local-write-char #\+)) - (local-princ ,form)))) + (if (>= ,form 0) + (local-write-char #\+) + (local-write-char #\-)) + (local-princ (abs ,form))))) ((eq (car source) 'quote) `(local-princ ,source)) ((eq (car source) 'function) ----------------------------------------------------------------------- Summary of changes: src/compiler/disassem.lisp | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-27-g7107249
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 7107249f265148e246a9eec84b15cfbe96121594 (commit) from 13f320d9568705f58010d456b957917b2d2c62c6 (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 7107249f265148e246a9eec84b15cfbe96121594 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Jul 31 15:50:44 2014 -0700 Finally remove the Lisp implementation of the trig functions that are now in C. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index c48d09d..7c8b031 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -208,440 +208,6 @@ (declare (ignore ign)) (values s c))) -#|| -;; Implement sin/cos/tan in Lisp. These are based on the routines -;; from fdlibm. - -;; Block compile so the trig routines don't cons their args when -;; calling the kernel trig routines. -(declaim (ext:start-block kernel-sin kernel-cos kernel-tan - %sin %cos %tan - %sincos)) - -;; kernel sin function on [-pi/4, pi/4], pi/4 ~ 0.7854 -;; Input x is assumed to be bounded by ~pi/4 in magnitude. -;; Input y is the tail of x. -;; Input iy indicates whether y is 0. (if iy=0, y assume to be 0). -;; -;; Algorithm -;; 1. Since sin(-x) = -sin(x), we need only to consider positive x. -;; 2. if x < 2^-27 (hx<0x3e400000 0), return x with inexact if x!=0. -;; 3. sin(x) is approximated by a polynomial of degree 13 on -;; [0,pi/4] -;; 3 13 -;; sin(x) ~ x + S1*x + ... + S6*x -;; where -;; -;; |sin(x) 2 4 6 8 10 12 | -58 -;; |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2 -;; | x | -;; -;; 4. sin(x+y) = sin(x) + sin'(x')*y -;; ~ sin(x) + (1-x*x/2)*y -;; For better accuracy, let -;; 3 2 2 2 2 -;; r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6)))) -;; then 3 2 -;; sin(x) = x + (S1*x + (x *(r-y/2)+y)) - -(declaim (ftype (function (double-float double-float fixnum) - double-float) - kernel-sin)) - -(defun kernel-sin (x y iy) - (declare (type (double-float -1d0 1d0) x y) - (fixnum iy) - (optimize (speed 3) (safety 0))) - (let ((ix (ldb (byte 31 0) (kernel:double-float-high-bits x)))) - (when (< ix #x3e400000) - ;; |x| < 2^-27 - ;; Signal inexact if x /= 0 - (if (zerop (truncate x)) - (return-from kernel-sin x) - (return-from kernel-sin x))) - (let* ((s1 -1.66666666666666324348d-01) ; #xBFC55555 #x55555549 - (s2 8.33333333332248946124d-03) ; #x3F811111 #x1110F8A6 - (s3 -1.98412698298579493134d-04) ; #xBF2A01A0 #x19C161D5 - (s4 2.75573137070700676789d-06) ; #x3EC71DE3 #x57B1FE7D - (s5 -2.50507602534068634195d-08) ; #xBE5AE5E6 #x8A2B9CEB - (s6 1.58969099521155010221d-10) ; #x3DE5D93A #x5ACFD57C - (z (* x x)) - (v (* z x)) - (r (+ s2 - (* z - (+ s3 - (* z - (+ s4 - (* z - (+ s5 - (* z s6)))))))))) - (if (zerop iy) - (+ x (* v (+ s1 (* z r)))) - (- x (- (- (* z (- (* .5 y) - (* v r))) - y) - (* v s1))))))) - -;; kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164 -;; Input x is assumed to be bounded by ~pi/4 in magnitude. -;; Input y is the tail of x. -;; -;; Algorithm -;; 1. Since cos(-x) = cos(x), we need only to consider positive x. -;; 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0. -;; 3. cos(x) is approximated by a polynomial of degree 14 on -;; [0,pi/4] -;; 4 14 -;; cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x -;; where the remez error is -;; -;; | 2 4 6 8 10 12 14 | -58 -;; |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2 -;; | | -;; -;; 4 6 8 10 12 14 -;; 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then -;; cos(x) = 1 - x*x/2 + r -;; since cos(x+y) ~ cos(x) - sin(x)*y -;; ~ cos(x) - x*y, -;; a correction term is necessary in cos(x) and hence -;; cos(x+y) = 1 - (x*x/2 - (r - x*y)) -;; For better accuracy when x > 0.3, let qx = |x|/4 with -;; the last 32 bits mask off, and if x > 0.78125, let qx = 0.28125. -;; Then -;; cos(x+y) = (1-qx) - ((x*x/2-qx) - (r-x*y)). -;; Note that 1-qx and (x*x/2-qx) is EXACT here, and the -;; magnitude of the latter is at least a quarter of x*x/2, -;; thus, reducing the rounding error in the subtraction. -(declaim (ftype (function (double-float double-float) - double-float) - kernel-cos)) - -(defun kernel-cos (x y) - (declare (type (double-float -1d0 1d0) x y) - (optimize (speed 3) (safety 0))) - ;; cos(-x) = cos(x), so we just compute cos(|x|). - (let ((ix (ldb (byte 31 0) (kernel:double-float-high-bits x)))) - ;; cos(x) = 1 when |x| < 2^-27 - (when (< ix #x3e400000) - ;; Signal inexact if x /= 0 - (if (zerop (truncate x)) - (return-from kernel-cos 1d0) - (return-from kernel-cos 1d0))) - (let* ((c1 4.16666666666666019037d-02) - (c2 -1.38888888888741095749d-03) - (c3 2.48015872894767294178d-05) - (c4 -2.75573143513906633035d-07) - (c5 2.08757232129817482790d-09) - (c6 -1.13596475577881948265d-11) - (z (* x x)) - (r (* z - (+ c1 - (* z - (+ c2 - (* z - (+ c3 - (* z - (+ c4 - (* z - (+ c5 - (* z c6))))))))))))) - (cond ((< ix #x3fd33333) - ;; \x| < 0.3 - (- 1 (- (* .5 z) - (- (* z r) - (* x y))))) - (t - ;; qx = 0.28125 if |x| > 0.78125, else x/4 dropping the - ;; least significant 32 bits. - (let* ((qx (if (> ix #x3fe90000) - 0.28125d0 - ;; x/4, exactly, and also dropping the - ;; least significant 32 bits of the - ;; fraction. - (make-double-float (- ix #x00200000) - 0))) - (hz (- (* 0.5 z) qx)) - (a (- 1 qx))) - (- a (- hz (- (* z r) - (* x y)))))))))) - -(declaim (type (simple-array double-float (*)) tan-coef)) -(defconstant tan-coef - (make-array 13 :element-type 'double-float - :initial-contents - '(3.33333333333334091986d-01 - 1.33333333333201242699d-01 - 5.39682539762260521377d-02 - 2.18694882948595424599d-02 - 8.86323982359930005737d-03 - 3.59207910759131235356d-03 - 1.45620945432529025516d-03 - 5.88041240820264096874d-04 - 2.46463134818469906812d-04 - 7.81794442939557092300d-05 - 7.14072491382608190305d-05 - -1.85586374855275456654d-05 - 2.59073051863633712884d-05))) - -;; kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854 -;; Input x is assumed to be bounded by ~pi/4 in magnitude. -;; Input y is the tail of x. -;; Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned. -;; -;; Algorithm -;; 1. Since tan(-x) = -tan(x), we need only to consider positive x. -;; 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0. -;; 3. tan(x) is approximated by a odd polynomial of degree 27 on -;; [0,0.67434] -;; 3 27 -;; tan(x) ~ x + T1*x + ... + T13*x -;; where -;; -;; |tan(x) 2 4 26 | -59.2 -;; |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2 -;; | x | -;; -;; Note: tan(x+y) = tan(x) + tan'(x)*y -;; ~ tan(x) + (1+x*x)*y -;; Therefore, for better accuracy in computing tan(x+y), let -;; 3 2 2 2 2 -;; r = x *(T2+x *(T3+x *(...+x *(T12+x *T13)))) -;; then -;; 3 2 -;; tan(x+y) = x + (T1*x + (x *(r+y)+y)) -;; -;; 4. For x in [0.67434,pi/4], let y = pi/4 - x, then -;; tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y)) -;; = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y))) -(declaim (ftype (function (double-float double-float fixnum) - double-float) - kernel-tan)) - -(defun kernel-tan (x y iy) - (declare (type (double-float -1d0 1d0) x y) - (type (member -1 1) iy) - (optimize (speed 3) (safety 0))) - (let* ((hx (kernel:double-float-high-bits x)) - (ix (logand hx #x7fffffff)) - (w 0d0) - (z 0d0) - (v 0d0) - (s 0d0) - (r 0d0)) - (declare (double-float w z v s r)) - (when (< ix #x3e300000) - ;; |x| < 2^-28 - (when (zerop (truncate x)) - (cond ((zerop (logior (logior ix (kernel:double-float-low-bits x)) - (+ iy 1))) - ;; x = 0 (because hi and low bits are 0) and iy = -1 - ;; (cot) - (return-from kernel-tan (/ (abs x)))) - ((= iy 1) - (return-from kernel-tan x)) - (t - ;; x /= 0 and iy = -1 (cot) - ;; Compute -1/(x+y) carefully - (let ((a 0d0) - (tt 0d0)) - (setf w (+ x y)) - (setf z (make-double-float (double-float-high-bits w) 0)) - (setf v (- y (- z x))) - (setf a (/ -1 w)) - (setf tt (make-double-float (double-float-high-bits a) 0)) - (setf s (+ 1 (* tt z))) - (return-from kernel-tan (+ tt - (* a (+ s (* tt v)))))))))) - (when (>= ix #x3FE59428) - ;; |x| > .6744 - (when (minusp hx) - (setf x (- x)) - (setf y (- y))) - ;; The two constants below are such that pi/4 + pi/4_lo is pi/4 - ;; to twice the accuracy of a double float. - ;; - ;; z = pi/4-x - (setf z (- (make-double-float #x3FE921FB #x54442D18) x)) - ;; w = pi/4_lo - y. - (setf w (- (make-double-float #x3C81A626 #x33145C07) y)) - (setf x (+ z w)) - (setf y 0d0)) - (setf z (* x x)) - (setf w (* z z)) - ;; Break x^5*(T[1]+x^2*T[2]+...) into - ;; x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + - ;; x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) - (setf r (+ (aref tan-coef 1) - (* w - (+ (aref tan-coef 3) - (* w - (+ (aref tan-coef 5) - (* w - (+ (aref tan-coef 7) - (* w - (+ (aref tan-coef 9) - (* w (aref tan-coef 11)))))))))))) - (setf v (* z - (+ (aref tan-coef 2) - (* w - (+ (aref tan-coef 4) - (* w - (+ (aref tan-coef 6) - (* w - (+ (aref tan-coef 8) - (* w - (+ (aref tan-coef 10) - (* w (aref tan-coef 12))))))))))))) - (setf s (* z x)) - (setf r (+ y (* z (+ (* s (+ r v)) - y)))) - (incf r (* s (aref tan-coef 0))) - (setf w (+ x r)) - (when (>= ix #x3FE59428) - (let ((v (float iy 1d0))) - (return-from kernel-tan - (* (- 1 (logand 2 (ash hx -30))) - (- v - (* 2 - (- x (- (/ (* w w) - (+ w v)) - r)))))))) - (when (= iy 1) - (return-from kernel-tan w)) - ;; Compute 1/w=1/(x+r) carefully - (let ((a 0d0) - (tt 0d0)) - (setf z (kernel:make-double-float (kernel:double-float-high-bits w) 0)) - (setf v (- r (- z x))) ; z + v = r + x - (setf a (/ -1 w)) - (setf tt (kernel:make-double-float (kernel:double-float-high-bits a) 0)) - (setf s (+ 1 (* tt z))) - (+ tt - (* a - (+ s (* tt v))))))) - -;; Return sine function of x. -;; -;; kernel function: -;; __kernel_sin ... sine function on [-pi/4,pi/4] -;; __kernel_cos ... cose function on [-pi/4,pi/4] -;; __ieee754_rem_pio2 ... argument reduction routine -;; -;; Method. -;; Let S,C and T denote the sin, cos and tan respectively on -;; [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 -;; in [-pi/4 , +pi/4], and let n = k mod 4. -;; We have -;; -;; n sin(x) cos(x) tan(x) -;; ---------------------------------------------------------- -;; 0 S C T -;; 1 C -S -1/T -;; 2 -S -C T -;; 3 -C S -1/T -;; ---------------------------------------------------------- -;; -;; Special cases: -;; Let trig be any of sin, cos, or tan. -;; trig(+-INF) is NaN, with signals; -;; trig(NaN) is that NaN; -;; -;; Accuracy: -;; TRIG(x) returns trig(x) nearly rounded -(defun %sin (x) - (declare (double-float x) - (optimize (speed 3))) - (let ((ix (ldb (byte 31 0) (kernel:double-float-high-bits x)))) - (cond - ((<= ix #x3fe921fb) - ;; |x| < pi/4, approx - (kernel-sin x 0d0 0)) - ((>= ix #x7ff00000) - ;; sin(Inf or NaN) is NaN - (- x x)) - (t - ;; Argument reduction needed - (multiple-value-bind (n y0 y1) - (%ieee754-rem-pi/2 x) - (case (logand n 3) - (0 - (kernel-sin y0 y1 1)) - (1 - (kernel-cos y0 y1)) - (2 - (- (kernel-sin y0 y1 1))) - (3 - (- (kernel-cos y0 y1))))))))) - -(defun %cos (x) - (declare (double-float x) - (optimize (speed 3))) - (let ((ix (ldb (byte 31 0) (kernel:double-float-high-bits x)))) - (cond - ((< ix #x3fe921fb) - ;;|x| < pi/4, approx - (kernel-cos x 0d0)) - ((>= ix #x7ff00000) - ;; cos(Inf or NaN) is NaN - (- x x)) - (t - ;; Argument reduction needed - (multiple-value-bind (n y0 y1) - (%ieee754-rem-pi/2 x) - (ecase (logand n 3) - (0 - (kernel-cos y0 y1)) - (1 - (- (kernel-sin y0 y1 1))) - (2 - (- (kernel-cos y0 y1))) - (3 - (kernel-sin y0 y1 1)))))))) - -(defun %tan (x) - (declare (double-float x) - (optimize (speed 3))) - (let ((ix (logand #x7fffffff (kernel:double-float-high-bits x)))) - (cond ((<= ix #x3fe921fb) - ;; |x| < pi/4 - (kernel-tan x 0d0 1)) - ((>= ix #x7ff00000) - ;; tan(Inf or Nan) is NaN - (- x x)) - (t - (multiple-value-bind (n y0 y1) - (%ieee754-rem-pi/2 x) - (let ((flag (- 1 (ash (logand n 1) 1)))) - ;; flag = 1 if n even, -1 if n odd - (kernel-tan y0 y1 flag))))))) -;; Compute sin and cos of x, simultaneously. -(defun %sincos (x) - (declare (double-float x) - (optimize (speed 3))) - (cond ((<= (abs x) (/ pi 4)) - (values (kernel-sin x 0d0 0) - (kernel-cos x 0d0))) - (t - ;; Argument reduction needed - (multiple-value-bind (n y0 y1) - (%ieee754-rem-pi/2 x) - (case (logand n 3) - (0 - (values (kernel-sin y0 y1 1) - (kernel-cos y0 y1))) - (1 - (values (kernel-cos y0 y1) - (- (kernel-sin y0 y1 1)))) - (2 - (values (- (kernel-sin y0 y1 1)) - (- (kernel-cos y0 y1)))) - (3 - (values (- (kernel-cos y0 y1)) - (kernel-sin y0 y1 1)))))))) -;;(declaim (ext:end-block)) -||# - ;;;; Power functions. ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 434 --------------------------------------------------- 1 file changed, 434 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-48-g0001121
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 0001121104eec5858f6b9f6cf5add3feceab7b85 (commit) from fc77c64668de9541b5a3aca96366de26c7bb8b51 (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 0001121104eec5858f6b9f6cf5add3feceab7b85 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Jan 3 14:11:09 2014 -0800 Don't run trac.15 on x87. We expect this to fail there and won't fix it. diff --git a/tests/trac.lisp b/tests/trac.lisp index 64cbe81..4cffa78 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -56,6 +56,10 @@ (assert-equal " 0.100E+01" (format nil "~11,3,2,0,'*,,'EE" .9999))) +;; See http://trac.common-lisp.net/cmucl/ticket/15. We don't intend +;; to fix this with x87 due to the x87 extended double float (80-bit) +;; format. +#-x87 (define-test trac.15 (:tag :trac) (assert-true ----------------------------------------------------------------------- Summary of changes: tests/trac.lisp | 4 ++++ 1 file changed, 4 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-37-gb3b6dce
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 b3b6dce07ceb5538e89ce8c49a8bd1fe2d6a15d1 (commit) via 6b8ebd981528242319eeb8d8ef931df8ceaaefe5 (commit) from 4e3589d9d175382fe85b6efe2e3e94ccf598a88e (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 b3b6dce07ceb5538e89ce8c49a8bd1fe2d6a15d1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Dec 22 22:59:37 2013 -0800 Fix test trac.69: Move the setting of the logical pathname translation outside of the test. diff --git a/tests/trac.lisp b/tests/trac.lisp index a2a1e35..64cbe81 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -207,10 +207,11 @@ (replace s s :start2 100 :end2 105))) (copy-seq "1234567890")))) +(setf (logical-pathname-translations "trac69") + '(("**;*.*.*" "/tmp/**/*.*"))) + (define-test trac.69 (:tag :trac) - (setf (logical-pathname-translations "trac69") - '(("**;*.*.*" "/tmp/**/*.*"))) (assert-error 'lisp::namestring-parse-error (let ((*default-pathname-defaults* #p"trac69:")) (pathname "/tmp/bar.lisp")))) commit 6b8ebd981528242319eeb8d8ef931df8ceaaefe5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Dec 22 22:53:24 2013 -0800 Fix typo. diff --git a/tests/trac.lisp b/tests/trac.lisp index 2f9a4ae..a2a1e35 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -157,7 +157,7 @@ (dotimes (i 300) (let ((ch (read-char s nil nil))) (unless (= i (char-code ch)) - (push (list i ch (char-code ch)) faillures))))) + (push (list i ch (char-code ch)) failures))))) failures) (delete-file path))))) ----------------------------------------------------------------------- Summary of changes: tests/trac.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-43-g458231d
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 458231d178c7c98798c653f574b6aab839637bc1 (commit) from 9ca40a2b90607cd33577644c5cd5d38ae5fe1354 (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 458231d178c7c98798c653f574b6aab839637bc1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Aug 28 20:03:24 2014 -0700 If a process is not schedulable because it has no run-reasons and/or an arrest-reason, destroy-process doesn't take effect. Destroy-process sets process-state to :active to try to ensure it gets the interrupt, but it also needs to clear process-%arrest-reasons and push something on process-%run-reasons. Patch from Paul Foley. diff --git a/src/code/multi-proc.lisp b/src/code/multi-proc.lisp index 4e2b1bc..c73f0b4 100644 --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1044,7 +1044,9 @@ (process-interrupts process)) ;; Ensure that the process is active so that it can accept this ;; interrupt. - (setf (process-state process) :active))) + (setf (process-state process) :active + (process-%arrest-reasons process) nil) + (push :destroyed (process-%run-reasons process)))) ;; Should we wait until it's dead? (process-yield)) ----------------------------------------------------------------------- Summary of changes: src/code/multi-proc.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-66-g21aad0e
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 21aad0ecc9f96297deedf9362c19fd877910592a (commit) via a0138a0ccc5d7bd08a7e8445cdd5e05ae83d4618 (commit) from 6ea8fc645c5c60634e864a2741ee897b93a4ef5f (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 21aad0ecc9f96297deedf9362c19fd877910592a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:15:53 2014 -0700 Use fdlibm hyperbolic functions instead of libm. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index ef1628b..86c7d9e 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -71,9 +71,9 @@ (def-math-rtn "atan2" 2) (def-math-rtn ("__ieee754_asin" %asin) 1) (def-math-rtn ("__ieee754_acos" %acos) 1) -(def-math-rtn "sinh" 1) -(def-math-rtn "cosh" 1) -(def-math-rtn "tanh" 1) +(def-math-rtn ("__ieee754_sinh" %sinh) 1) +(def-math-rtn ("__ieee754_cosh" %cosh) 1) +(def-math-rtn ("fdlibm_tanh" %tanh) 1) (def-math-rtn "asinh" 1) (def-math-rtn "acosh" 1) (def-math-rtn "atanh" 1) commit a0138a0ccc5d7bd08a7e8445cdd5e05ae83d4618 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:15:36 2014 -0700 Compile the fdlibm hyperbolic functions. diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index 9a2c467..7ced0db 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -18,7 +18,10 @@ OS_LIBS = EXEC_FINAL_OBJ = exec-final.o -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 +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 k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -55,3 +58,10 @@ e_asin.o : e_asin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< s_atan.o : s_atan.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +e_cosh.o : e_cosh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +e_sinh.o : e_sinh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_tanh.o : s_tanh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 6 +++--- src/lisp/Config.x86_darwin | 12 +++++++++++- 2 files changed, 14 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-8-g2e18254
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 2e182540e895f16b26224ba11b2f38de93ab2672 (commit) from d03e178481b3be542e4a2519890ed2772d081fb6 (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 2e182540e895f16b26224ba11b2f38de93ab2672 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 11:55:27 2014 -0700 Make (log (scale-float 1d0 k) 2) = k * src/code/irrat.lisp * Improve accuracy of log2 for the case when x=2^k. There might be some loss in accuracy for other values of x, however. * tests/float.lisp * Add test for log2(2^k) = k. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 5f24bf9..2591907 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -598,7 +598,17 @@ (float 2 float-type))))))))) (etypecase x (float - (/ (log (float x float-type)) (log-of-2 float-type))) + (multiple-value-bind (f e s) + (decode-float x) + ;; If x = 2^e*f then log2(x) = e + log2(f) = e + + ;; log(f)/log(2). Accuracy could be improved some since this + ;; has 2 rounding operations instead of just 1 for + ;; log(x)/log(2). + (let ((log2 (+ e (/ (log (float f float-type)) + (log-of-2 float-type))))) + (if (minusp s) + (complex log2 (log-2-pi float-type)) + log2)))) (ratio (let ((top (numerator x)) (bot (denominator x))) diff --git a/tests/float.lisp b/tests/float.lisp index 6fe1f50..ff07270 100644 --- a/tests/float.lisp +++ b/tests/float.lisp @@ -10,3 +10,8 @@ (declare (type (double-float (0d0)) x)) (decode-float x))) 1d0))) + +(define-test log2 + (loop for k from -1074 to 1023 do + (let ((x (scale-float 1d0 k))) + (assert-equal k (log x 2))))) ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 12 +++++++++++- tests/float.lisp | 5 +++++ 2 files changed, 16 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0