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

[git] CMU Common Lisp branch master updated. snapshot-2014-08-38-g284043e
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 284043eee5e68291c9f66be8f81cedcf44f7adef (commit) from 98d3b693b06676dbc4f9785dca6c18516253370c (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 284043eee5e68291c9f66be8f81cedcf44f7adef Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 27 20:21:31 2014 -0700 Add support for deriving the type of ROUND. Needs work. diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index c12251c..ec37fd4 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1764,6 +1764,104 @@ (ftruncate-derive-type-quot-aux n divisor nil)) #'%unary-ftruncate))) +(defun round-quotient-bound (quot) + (flet ((round-it (quot) + (let ((lo (interval-low quot)) + (hi (interval-high quot))) + (setf lo (if lo + (round (bound-value lo)) + nil)) + ;; For the upper bound, we need to be careful + (setf hi (if hi + (round (bound-value hi)) + nil)) + (make-interval :low lo :high hi)))) + (case (interval-range-info quot) + (+ + (round-it quot)) + (- + (round-it quot)) + (otherwise + ;; Split the interval into positive and negative pieces, compute + ;; the result for each piece and put them back together. + (destructuring-bind (neg pos) + (interval-split 0 quot t t) + (interval-merge-pair (round-it neg) + (round-it pos))))))) + +(defun round-derive-type-quot (number-type divisor-type) + (let* ((rem-type (rem-result-type number-type divisor-type)) + (number-interval (numeric-type->interval number-type)) + (divisor-interval (numeric-type->interval divisor-type))) + (let ((quot (round-quotient-bound + (interval-div number-interval + divisor-interval)))) + (specifier-type `(integer ,(or (interval-low quot) '*) + ,(or (interval-high quot) '*)))))) + +(defun round-derive-type-rem (number-type divisor-type) + (let* ((rem-type (rem-result-type number-type divisor-type)) + (number-interval (numeric-type->interval number-type)) + (divisor-interval (numeric-type->interval divisor-type))) + (multiple-value-bind (class format) + (ecase rem-type + (integer + (values 'integer nil)) + (rational + (values 'rational nil)) + ((or single-float double-float #+long-float long-float + #+double-double double-double-float) + (values 'float rem-type)) + (float + (values 'float nil)) + (real + (values nil nil))) + #+nil + (when (member rem-type '(float single-float double-float + #+long-float long-float + #+double-double double-double-float)) + (setf rem (interval-func #'(lambda (x) + (coerce x rem-type)) + rem))) + (make-numeric-type :class class + :format format + :low nil + :high nil)))) + +(defun %unary-round-derive-type-aux (num) + (if (numeric-type-real-p num) + (round-derive-type-quot num (specifier-type '(integer 1 1))) + *empty-type*)) + +(defoptimizer (%unary-round derive-type) ((number)) + (one-arg-derive-type number + #'%unary-round-derive-type-aux + #'%unary-round)) + +(defun round-derive-type-quot-aux (num div same-arg) + (declare (ignore same-arg)) + (if (and (numeric-type-real-p num) + (numeric-type-real-p div)) + (round-derive-type-quot num div) + *empty-type*)) + +(defun round-derive-type-rem-aux (num div same-arg) + (declare (ignore same-arg)) + (if (and (numeric-type-real-p num) + (numeric-type-real-p div)) + (round-derive-type-rem num div) + *empty-type*)) + +(defoptimizer (round derive-type) ((number divisor)) + (let ((quot (two-arg-derive-type number divisor + #'round-derive-type-quot-aux #'round)) + (rem (two-arg-derive-type number divisor + #'round-derive-type-rem-aux + #'(lambda (x) + (nth-value 1 (round x)))))) + (when (and quot rem) + (make-values-type :required (list quot rem))))) + ;;; Define optimizers for floor and ceiling (macrolet ((frob-opt (name q-name r-name) ----------------------------------------------------------------------- Summary of changes: src/compiler/srctran.lisp | 98 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-08-1-gb90e144
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 b90e144d86ca206d498891a2eb4b552cecef59ab (commit) from 19aa444cd539ad21397f01aab5a71feb049173bf (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 b90e144d86ca206d498891a2eb4b552cecef59ab Author: Carl Shapiro <cshapiro(a)common-lisp.net> Date: Tue Aug 6 23:06:09 2013 -0700 Use movxz in load-type to avoid byte-register restrictions. diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 9283a78..aeb18cd 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -198,7 +198,7 @@ (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) (:temporary (:sc unsigned-reg) raw) - (:temporary (:sc byte-reg) type) + (:temporary (:sc unsigned-reg) type) (:results (result :scs (descriptor-reg))) (:generator 38 (load-type type function (- function-pointer-type)) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index d4659c2..bbd5ef5 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -110,10 +110,10 @@ (n-offset offset)) (ecase (backend-byte-order *target-backend*) (:little-endian - `(inst mov ,n-target + `(inst movzx ,n-target (make-ea :byte :base ,n-source :disp ,n-offset))) (:big-endian - `(inst mov ,n-target + `(inst movzx ,n-target (make-ea :byte :base ,n-source :disp (+ ,n-offset 3))))))) (defmacro load-foreign-data-symbol (reg name ) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index 71f7bb2..683d9e2 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -39,50 +39,48 @@ (define-vop (get-type) (:translate get-type) (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:temporary (:sc unsigned-reg :offset eax-offset :to (:result 0)) eax) - (:results (result :scs (unsigned-reg))) + (:args (object :scs (descriptor-reg) :to (:eval 1))) + (:results (result :scs (unsigned-reg) :from (:eval 0))) (:result-types positive-fixnum) (:generator 6 - (inst mov eax object) - (inst and al-tn lowtag-mask) - (inst cmp al-tn other-pointer-type) + ;; Pick off objects with headers. + (inst mov result object) + (inst and result lowtag-mask) + (inst cmp result other-pointer-type) (inst jmp :e other-ptr) - (inst cmp al-tn function-pointer-type) + (inst cmp result function-pointer-type) (inst jmp :e function-ptr) - ;; pick off structures and list pointers - (inst test al-tn 1) - (inst jmp :ne done) + ;; Pick off structure and list pointers. + (inst test result 1) + (inst jmp :nz done) - ;; pick off fixnums - (inst and al-tn 3) - (inst jmp :e done) + ;; Pick off fixnums. + (inst and result 3) + (inst jmp :z done) - ;; must be an other immediate - (inst mov eax object) + ;; Must be an other immediate. + (inst mov result object) + (inst and result type-mask) (inst jmp done) - + FUNCTION-PTR - (load-type al-tn object (- vm:function-pointer-type)) + (load-type result object (- vm:function-pointer-type)) (inst jmp done) - + OTHER-PTR - (load-type al-tn object (- vm:other-pointer-type)) - - DONE - (inst movzx result al-tn))) + (load-type result object (- vm:other-pointer-type)) + + DONE)) (define-vop (function-subtype) (:translate function-subtype) (:policy :fast-safe) (:args (function :scs (descriptor-reg))) - (:temporary (:sc byte-reg :from (:eval 0) :to (:eval 1)) temp) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type temp function (- vm:function-pointer-type)) - (inst movzx result temp))) + (load-type result function (- vm:function-pointer-type)))) (define-vop (set-function-subtype) (:translate (setf function-subtype)) diff --git a/src/compiler/x86/values.lisp b/src/compiler/x86/values.lisp index 765c045..7a06496 100644 --- a/src/compiler/x86/values.lisp +++ b/src/compiler/x86/values.lisp @@ -58,23 +58,21 @@ (:results (start :scs (any-reg)) (count :scs (any-reg))) (:temporary (:sc descriptor-reg :from (:argument 0) :to (:result 1)) list) - (:temporary (:sc descriptor-reg :to (:result 1)) nil-temp) - (:temporary (:sc unsigned-reg :offset eax-offset :to (:result 1)) eax) + (:temporary (:sc unsigned-reg :to (:result 1)) temp) (:vop-var vop) (:save-p :compute-only) (:generator 0 (move list arg) (move start esp-tn) ; WARN pointing 1 below - (inst mov nil-temp nil-value) LOOP - (inst cmp list nil-temp) + (inst cmp list nil-value) (inst jmp :e done) (pushw list cons-car-slot list-pointer-type) (loadw list list cons-cdr-slot list-pointer-type) - (inst mov eax list) - (inst and al-tn lowtag-mask) - (inst cmp al-tn list-pointer-type) + (inst mov temp list) + (inst and temp lowtag-mask) + (inst cmp temp list-pointer-type) (inst jmp :e loop) (error-call vop bogus-argument-to-values-list-error list) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/cell.lisp | 2 +- src/compiler/x86/macros.lisp | 4 ++-- src/compiler/x86/system.lisp | 48 ++++++++++++++++++++---------------------- src/compiler/x86/values.lisp | 12 +++++------ 4 files changed, 31 insertions(+), 35 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-11-g80df05a
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 80df05a11cc138d18d989a5f8f690627026e3069 (commit) from ab446830b129ca3607c4342c24849ca8554db7ce (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 80df05a11cc138d18d989a5f8f690627026e3069 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 15 22:41:26 2014 -0700 Make cosh signal overflow when it should overflow. * lisp/e_cosh.c: * The compiler replaced the code huge*huge with infinity instead of doing the operation. Change it so it does fabs(x)*huge, which forces the compiler to do the multiplication. * Change huge from 1e300 to 1e307 so that fabs(x)*huge will actually overflow when |x| > overflowthreshold. * tests/trig.lisp: * Add tests for sinh and cosh signaling overflow appropriately. * general-info/release-20f.txt: * Update. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 92df6fa..7179f1f 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -62,6 +62,8 @@ New in this release: DEFINE-CONDITION. (From Helmut Eller.) * The lisp executable is now compiled to use SSE2 on x86 machines; CMUCL will not run on chips without SSE2 anymore. + * (cosh 1000d0) signals an overflow error as it + should. Previously, it just incorrectly returned infinity. * ANSI compliance fixes: * The values on the branch cuts for the inverse trig and diff --git a/src/lisp/e_cosh.c b/src/lisp/e_cosh.c index 28b6c3c..1d2ac30 100644 --- a/src/lisp/e_cosh.c +++ b/src/lisp/e_cosh.c @@ -35,9 +35,9 @@ #include "fdlibm.h" #ifdef __STDC__ -static const double one = 1.0, half=0.5, huge = 1.0e300; +static const double one = 1.0, half=0.5, huge = 1.0e307; #else -static double one = 1.0, half=0.5, huge = 1.0e300; +static double one = 1.0, half=0.5, huge = 1.0e307; #endif #ifdef __STDC__ @@ -91,5 +91,5 @@ static double one = 1.0, half=0.5, huge = 1.0e300; } /* |x| > overflowthresold, cosh(x) overflow */ - return huge*huge; + return fabs(x)*huge; } diff --git a/tests/trig.lisp b/tests/trig.lisp index 695c50d..4f15848 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -791,3 +791,13 @@ (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)))) + +(define-test cosh.overflow + (:tag :cosh) + (assert-error 'floating-point-overflow + (cosh 1000d0))) + +(define-test sinh.overflow + (:tag :sinh) + (assert-error 'floating-point-overflow + (sinh 1000d0))) \ No newline at end of file ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 2 ++ src/lisp/e_cosh.c | 6 +++--- tests/trig.lisp | 10 ++++++++++ 3 files changed, 15 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. 20e-8-ge99b2b2
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 e99b2b29bf65f7a2a678e9d7199085bf4aabd81a (commit) from d337d008ea8f8a47a34b27516bd4f60f8299881a (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 e99b2b29bf65f7a2a678e9d7199085bf4aabd81a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Oct 26 17:01:54 2013 -0700 Document why %unary-ftruncate multiplies the result by x when result = 0. diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index a107e79..187d17b 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -210,10 +210,9 @@ ;; if x is known to be of the right type. Also, if the result is ;; known to fit in the same range as a (signed-byte 32), convert this ;; to %unary-truncate, which might be a single instruction, and float -;; the result. However, for sparc, we have a vop to do this so call -;; that, and for Sparc V9, we can actually handle a 64-bit integer -;; range. - +;; the result. However, for sparc and x86, we have a vop to do this +;; so call that, and for Sparc V9, we can actually handle a 64-bit +;; integer range. (macrolet ((frob (ftype func) `(deftransform %unary-ftruncate ((x) (,ftype)) (let* ((x-type (continuation-type x)) @@ -226,6 +225,9 @@ (< hi limit-hi)) #-(or sparc (and x86 sse2)) '(let ((result (coerce (%unary-truncate x) ',ftype))) + ;; Multiply by x when result is 0 so that we + ;; get the correct signed zero to match what + ;; ftruncate in float.lisp would return. (if (zerop result) (* result x) result)) ----------------------------------------------------------------------- Summary of changes: src/compiler/float-tran.lisp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-06-1-ga2579ce
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 a2579ceae31fe7072e417e51d2045f63add281c2 (commit) from faf5cd6df3c8fd377891082e2f3bbcbada81e1d6 (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 a2579ceae31fe7072e417e51d2045f63add281c2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jun 25 21:30:16 2013 -0700 Initialize some variables to get rid of some clang warnings. diff --git a/src/lisp/parse.c b/src/lisp/parse.c index 505ad07..f1256f6 100644 --- a/src/lisp/parse.c +++ b/src/lisp/parse.c @@ -225,7 +225,7 @@ char * parse_addr(char **ptr) { char *token = parse_token(ptr); - long result; + long result = 0; if (token == NULL) { printf("Expected an address.\n"); @@ -316,7 +316,7 @@ parse_lispobj(char **ptr) { char *token = parse_token(ptr); long pointer; - lispobj result; + lispobj result = 0; if (token == NULL) { printf("Expected an object.\n"); ----------------------------------------------------------------------- Summary of changes: src/lisp/parse.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-37-g6795c64
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 6795c643cd67e3ea2d950aa249cf39f929dc7798 (commit) from 33a91f6afe5d68ea41a649db6e40d93d5896fb45 (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 6795c643cd67e3ea2d950aa249cf39f929dc7798 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 19:15:03 2014 -0700 Import log1p from fdlibm, as is. diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c new file mode 100644 index 0000000..3d1059a --- /dev/null +++ b/src/lisp/s_log1p.c @@ -0,0 +1,165 @@ + +/* @(#)s_log1p.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. + * ==================================================== + */ + +/* double log1p(double x) + * + * Method : + * 1. Argument Reduction: find k and f such that + * 1+x = 2^k * (1+f), + * where sqrt(2)/2 < 1+f < sqrt(2) . + * + * Note. If k=0, then f=x is exact. However, if k!=0, then f + * may not be representable exactly. In that case, a correction + * term is need. Let u=1+x rounded. Let c = (1+x)-u, then + * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u), + * and add back the correction term c/u. + * (Note: when x > 2**53, one can simply return log(x)) + * + * 2. Approximation of log1p(f). + * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) + * = 2s + 2/3 s**3 + 2/5 s**5 + ....., + * = 2s + s*R + * We use a special Reme algorithm on [0,0.1716] to generate + * a polynomial of degree 14 to approximate R The maximum error + * of this polynomial approximation is bounded by 2**-58.45. In + * other words, + * 2 4 6 8 10 12 14 + * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s + * (the values of Lp1 to Lp7 are listed in the program) + * and + * | 2 14 | -58.45 + * | Lp1*s +...+Lp7*s - R(z) | <= 2 + * | | + * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. + * In order to guarantee error in log below 1ulp, we compute log + * by + * log1p(f) = f - (hfsq - s*(hfsq+R)). + * + * 3. Finally, log1p(x) = k*ln2 + log1p(f). + * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) + * Here ln2 is split into two floating point number: + * ln2_hi + ln2_lo, + * where n*ln2_hi is always exact for |n| < 2000. + * + * Special cases: + * log1p(x) is NaN with signal if x < -1 (including -INF) ; + * log1p(+INF) is +INF; log1p(-1) is -INF with signal; + * log1p(NaN) is that NaN with no signal. + * + * Accuracy: + * according to an error analysis, the error is always less than + * 1 ulp (unit in the last place). + * + * 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. + * + * Note: Assuming log() return accurate answer, the following + * algorithm can be used to compute log1p(x) to within a few ULP: + * + * u = 1+x; + * if(u==1.0) return x ; else + * return log(u)*(x/(u-1.0)); + * + * See HP-15C Advanced Functions Handbook, p.193. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double +#else +static double +#endif +ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ +ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ +two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ +Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ +Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ +Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ +Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ +Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ +Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ +Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ + +static double zero = 0.0; + +#ifdef __STDC__ + double log1p(double x) +#else + double log1p(x) + double x; +#endif +{ + double hfsq,f,c,s,z,R,u; + int k,hx,hu,ax; + + hx = __HI(x); /* high word of x */ + ax = hx&0x7fffffff; + + k = 1; + if (hx < 0x3FDA827A) { /* x < 0.41422 */ + if(ax>=0x3ff00000) { /* x <= -1.0 */ + if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */ + else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ + } + if(ax<0x3e200000) { /* |x| < 2**-29 */ + if(two54+x>zero /* raise inexact */ + &&ax<0x3c900000) /* |x| < 2**-54 */ + return x; + else + return x - x*x*0.5; + } + if(hx>0||hx<=((int)0xbfd2bec3)) { + k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */ + } + if (hx >= 0x7ff00000) return x+x; + if(k!=0) { + if(hx<0x43400000) { + u = 1.0+x; + hu = __HI(u); /* high word of u */ + k = (hu>>20)-1023; + c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */ + c /= u; + } else { + u = x; + hu = __HI(u); /* high word of u */ + k = (hu>>20)-1023; + c = 0; + } + hu &= 0x000fffff; + if(hu<0x6a09e) { + __HI(u) = hu|0x3ff00000; /* normalize u */ + } else { + k += 1; + __HI(u) = hu|0x3fe00000; /* normalize u/2 */ + hu = (0x00100000-hu)>>2; + } + f = u-1.0; + } + hfsq=0.5*f*f; + if(hu==0) { /* |f| < 2**-20 */ + if(f==zero) if(k==0) return zero; + else {c += k*ln2_lo; return k*ln2_hi+c;} + R = hfsq*(1.0-0.66666666666666666*f); + if(k==0) return f-R; else + return k*ln2_hi-((R-(k*ln2_lo+c))-f); + } + s = f/(2.0+f); + z = s*s; + R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); + if(k==0) return f-(hfsq-s*(hfsq+R)); else + return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); +} ----------------------------------------------------------------------- Summary of changes: src/lisp/s_log1p.c | 165 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 src/lisp/s_log1p.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-28-g63929ee
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 63929ee776996a45c97444ffe807316ae6187e3c (commit) from bd30c83c9503bf6b5cb3f569e9b842e72772ae9b (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 63929ee776996a45c97444ffe807316ae6187e3c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 23 08:22:58 2014 -0700 Make atanh signal errors using fdlibm_setexception. * src/lisp/e_atanh.c * Use fdlibm_setexception * tests/trig.lisp: * Add tests for atanh diff --git a/src/lisp/e_atanh.c b/src/lisp/e_atanh.c index 3588436..aed70d4 100644 --- a/src/lisp/e_atanh.c +++ b/src/lisp/e_atanh.c @@ -57,10 +57,11 @@ static double zero = 0.0; lx = ux.i[LOWORD]; /* low word */ ix = hx&0x7fffffff; if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */ - return (x-x)/(x-x); - if(ix==0x3ff00000) - return x/zero; - if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ + return fdlibm_setexception(x, FDLIBM_INVALID); + if(ix==0x3ff00000) + return fdlibm_setexception(x, FDLIBM_DIVIDE_BY_ZERO); + + if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ ux.d = x; ux.i[HIWORD] = ix; /* x <- |x| */ x = ux.d; diff --git a/tests/trig.lisp b/tests/trig.lisp index d95db71..1b6102d 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -888,6 +888,26 @@ (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))) +(define-test atanh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh 2d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh -2d0)) + (assert-error 'division-by-zero + (kernel:%atanh 1d0)) + (assert-error 'division-by-zero + (kernel:%atanh -1d0)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%atanh 2d0))) + (assert-true (ext:float-nan-p (kernel:%atanh -2d0)))) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-positive-infinity + (kernel:%atanh 1d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%atanh -1d0)))) + + (define-test expm1.exceptions (:tag :fdlibm) (assert-error 'floating-point-overflow ----------------------------------------------------------------------- Summary of changes: src/lisp/e_atanh.c | 9 +++++---- tests/trig.lisp | 20 ++++++++++++++++++++ 2 files changed, 25 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-6-g02c1bde
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, 20f-branch has been updated via 02c1bde6f02c195a17d76dc57fd18562ef52bbea (commit) from ee7c488f2d0b57d8431ff3bff1b15bb58762e197 (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 02c1bde6f02c195a17d76dc57fd18562ef52bbea Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 13 12:16:47 2014 -0700 Update the version. diff --git a/src/docs/cmu-user/cmu-user.tex b/src/docs/cmu-user/cmu-user.tex index ce45970..ee7eae0 100644 --- a/src/docs/cmu-user/cmu-user.tex +++ b/src/docs/cmu-user/cmu-user.tex @@ -48,7 +48,7 @@ \newcommand{\keywords}{lisp, Common Lisp, manual, compiler, programming language implementation, programming environment} -\date{October 2013 \\ 20e} +\date{October 2014 \\ 20f} \begin{document} ----------------------------------------------------------------------- Summary of changes: src/docs/cmu-user/cmu-user.tex | 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-06-88-g022325c
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 022325ccf101a0e9085f0189c4ec54dc96cef52d (commit) via af7c3d9606ac3995c87611d3d4518430d3b67ebd (commit) via 59ad6f5166353a2019b922bfa02716b906008c85 (commit) from 4db363eca4f5a2c282f7b46bd1509095bcb6efec (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 022325ccf101a0e9085f0189c4ec54dc96cef52d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Aug 3 19:07:30 2014 -0700 Initilize hi and lo to get rid of a compiler warning from gcc 4.4.1 on linux that they might be used uninitialized. diff --git a/src/lisp/e_exp.c b/src/lisp/e_exp.c index 3d84224..8233bc3 100644 --- a/src/lisp/e_exp.c +++ b/src/lisp/e_exp.c @@ -105,7 +105,7 @@ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ double x; #endif { - double y,hi,lo,c,t; + double y,hi = 0,lo = 0,c,t; int k = 0; int xsb; unsigned hx; commit af7c3d9606ac3995c87611d3d4518430d3b67ebd Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Aug 3 18:53:24 2014 -0700 Add parens around operands of | to silence a compiler warning with gcc 4.4.1 on Linux. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c index 7e177e8..a841ace 100644 --- a/src/lisp/e_atan2.c +++ b/src/lisp/e_atan2.c @@ -75,7 +75,7 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; - if((hx-0x3ff00000|lx)==0) return fdlibm_atan(y); /* x=1.0 */ + if(((hx-0x3ff00000)|lx)==0) return fdlibm_atan(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ commit 59ad6f5166353a2019b922bfa02716b906008c85 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Aug 3 18:50:44 2014 -0700 Initialize c to get rid of a compiler warning on Linux with gcc 4.4.1. diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c index 6e35fd8..7431885 100644 --- a/src/lisp/s_expm1.c +++ b/src/lisp/s_expm1.c @@ -133,7 +133,7 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ double x; #endif { - double y,hi,lo,c,t,e,hxs,hfx,r1; + double y,hi,lo,c = 0,t,e,hxs,hfx,r1; int k,xsb; unsigned hx; union { int i[2]; double d; } ux; diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index 87ed927..d8f2cad 100644 --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -103,7 +103,7 @@ static double zero = 0.0; double x; #endif { - double hfsq,f,c,s,z,R,u; + double hfsq,f,c = 0,s,z,R,u; int k,hx,hu,ax; union { int i[2]; double d; } ux; ----------------------------------------------------------------------- Summary of changes: src/lisp/e_atan2.c | 2 +- src/lisp/e_exp.c | 2 +- src/lisp/s_expm1.c | 2 +- src/lisp/s_log1p.c | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-5-gee7c488
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 ee7c488f2d0b57d8431ff3bff1b15bb58762e197 (commit) from c042852462fc92df2da2259c191a909400199fb4 (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 ee7c488f2d0b57d8431ff3bff1b15bb58762e197 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Sep 11 22:37:35 2014 -0700 Oops. Source tarballs need to include the tests directory. diff --git a/bin/make-src-dist.sh b/bin/make-src-dist.sh index 1e1c016..7d2fc93 100755 --- a/bin/make-src-dist.sh +++ b/bin/make-src-dist.sh @@ -51,8 +51,8 @@ fi GTAR_OPTIONS="--exclude=.git --exclude='*.pot.~*~'" if [ -z "$INSTALL_DIR" ]; then echo " Compressing with $ZIP" - ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src | ${ZIP} > cmucl-src-$VERSION.tar.$ZIPEXT + ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src tests | ${ZIP} > cmucl-src-$VERSION.tar.$ZIPEXT else # Install in the specified directory - ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) + ${GTAR:-tar} ${GTAR_OPTIONS} -cf - bin src tests | (cd $INSTALL_DIR; ${GTAR:-tar} xf -) fi ----------------------------------------------------------------------- Summary of changes: bin/make-src-dist.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0