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

[git] CMU Common Lisp branch master updated. snapshot-2013-05-16-g8f5653c
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 8f5653cb8d14200905a7ef653bcaccd490e25404 (commit) from b1d65255d021886369e544caa1864aac6eec64cc (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 8f5653cb8d14200905a7ef653bcaccd490e25404 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun May 26 10:51:34 2013 -0700 Update. diff --git a/src/i18n/locale/cmucl-sparc-vm.pot b/src/i18n/locale/cmucl-sparc-vm.pot index e8a69ef..271439e 100644 --- a/src/i18n/locale/cmucl-sparc-vm.pot +++ b/src/i18n/locale/cmucl-sparc-vm.pot @@ -782,12 +782,6 @@ msgstr "" msgid "Method ~S not defined for ~S" msgstr "" -#: src/compiler/sparc/c-callback.lisp -msgid "" -"Cons up a piece of code which calls call-callback with INDEX and a\n" -"pointer to the arguments." -msgstr "" - #: src/compiler/sparc/call.lisp msgid "more-arg-context" msgstr "" diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 4b2964a..ff7b7cf 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -3867,25 +3867,11 @@ msgstr "" #: src/code/string.lisp msgid "" "Given a string, returns a new string that is a copy of it with all\n" -" lower case alphabetic characters converted to uppercase. Casing is\n" -" :simple or :full for simple or full case conversion, respectively." -msgstr "" - -#: src/code/string.lisp -msgid "" -"Given a string, returns a new string that is a copy of it with all\n" " upper case alphabetic characters converted to lowercase." msgstr "" #: src/code/string.lisp msgid "" -"Given a string, returns a new string that is a copy of it with all\n" -" upper case alphabetic characters converted to lowercase. Casing is\n" -" :simple or :full for simple or full case conversion, respectively." -msgstr "" - -#: src/code/string.lisp -msgid "" "Given a string, returns a copy of the string with the first\n" " character of each ``word'' converted to upper-case, and remaining\n" " chars in the word converted to lower case. A ``word'' is defined\n" @@ -3895,18 +3881,6 @@ msgstr "" #: src/code/string.lisp msgid "" -"Given a string, returns a copy of the string with the first\n" -" character of each ``word'' converted to upper-case, and remaining\n" -" chars in the word converted to lower case. Casing is :simple or\n" -" :full for simple or full case conversion, respectively. If\n" -" Unicode-Word-Break is non-Nil, then the Unicode word-breaking\n" -" algorithm is used to determine the word boundaries. Otherwise, A\n" -" ``word'' is defined to be a string of case-modifiable characters\n" -" delimited by non-case-modifiable chars. " -msgstr "" - -#: src/code/string.lisp -msgid "" "Given a string, returns that string with all lower case alphabetic\n" " characters converted to uppercase." msgstr "" @@ -14995,6 +14969,71 @@ msgstr "" msgid "~&Dumping ~D messages for domain ~S~%" msgstr "" +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all lower case alphabetic characters converted to uppercase using\n" +" full case conversion." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all lower case alphabetic characters converted to uppercase. Casing\n" +" is :simple or :full for simple or full case conversion,\n" +" respectively." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all uppercase alphabetic characters converted to lowercase using\n" +" full case conversion.." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with all\n" +" uppercase alphabetic characters converted to lowercase. Casing is\n" +" :simple or :full for simple or full case conversion, respectively." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, S, and a starting index, return the index of the\n" +" next character that is not part of the word containing the character\n" +" at the index, or the length of S if the word containing the\n" +" character extends to the end of S. If the index is negative or\n" +" valid index into S, the returned value will be strictly greater than\n" +" the index." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Capitalize String using the Unicode word-break algorithm to find\n" +" the words in String. The beginning is capitalized depending on the\n" +" value of Casing" +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Capitalize String using the Common Lisp word-break algorithm to find\n" +" the words in String. The beginning is capitalized depending on the\n" +" value of Casing" +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a copy of the string with the first\n" +" character of each ``word'' converted to upper-case, and remaining\n" +" chars in the word converted to lower case. Casing is :simple, :full\n" +" or :title for simple, full or title case conversion, respectively. If\n" +" Unicode-Word-Break is non-Nil, then the Unicode word-breaking\n" +" algorithm is used to determine the word boundaries. Otherwise, A\n" +" ``word'' is defined to be a string of case-modifiable characters\n" +" delimited by non-case-modifiable chars. " +msgstr "" + #: src/compiler/macros.lisp msgid "" "Policy Node Condition*\n" ----------------------------------------------------------------------- Summary of changes: src/i18n/locale/cmucl-sparc-vm.pot | 6 --- src/i18n/locale/cmucl.pot | 91 +++++++++++++++++++++++++----------- 2 files changed, 65 insertions(+), 32 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-03-2-gf15327b
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 f15327ba2aba87dea3c67204ca0f1100c1a605d9 (commit) from 508b6594cf003d6a9d400d59d4ec32255728d0e9 (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 f15327ba2aba87dea3c67204ca0f1100c1a605d9 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Mar 8 13:29:52 2014 -0800 Add double-double-float-positive-infinity and double-double-float-negative-infinity. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index a5f5ca6..ca0a60b 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1425,7 +1425,9 @@ "LEAST-POSITIVE-DOUBLE-DOUBLE-FLOAT" "LEAST-NEGATIVE-DOUBLE-DOUBLE-FLOAT" "MOST-POSITIVE-DOUBLE-DOUBLE-FLOAT" - "MOST-NEGATIVE-DOUBLE-DOUBLE-FLOAT") + "MOST-NEGATIVE-DOUBLE-DOUBLE-FLOAT" + "DOUBLE-DOUBLE-FLOAT-NEGATIVE-INFINITY" + "DOUBLE-DOUBLE-FLOAT-POSITIVE-INFINITY") ;; Spice lisp extensions (:export "LETF*" "LETF" "DOVECTOR" "DELETEF" "INDENTING-FURTHER" "FILE-COMMENT" diff --git a/src/code/float.lisp b/src/code/float.lisp index 01b7002..de80bc4 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -65,7 +65,8 @@ least-positive-double-double-float least-negative-double-double-float most-positive-double-double-float - most-negative-double-double-float)) + most-negative-double-double-float + double-double-float-negative-infinity)) (in-package "KERNEL") @@ -159,6 +160,15 @@ ;; What is the right value? (kernel:make-double-double-float most-negative-double-float 0d0)) +(defconstant double-double-float-positive-infinity + ;; What is the right value? + (kernel:make-double-double-float double-float-positive-infinity + 0d0)) +(defconstant double-double-float-negative-infinity + ;; What is the right value? + (kernel:make-double-double-float double-float-negative-infinity + 0d0)) + ); double-double (defconstant least-positive-normalized-single-float ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 4 +++- src/code/float.lisp | 12 +++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-35-ge38211a
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 e38211a12ceccae3b59938fd4815ab9055d6d5b8 (commit) from 1345f3b146c9840447fa7a943daf85f111011a7f (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 e38211a12ceccae3b59938fd4815ab9055d6d5b8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Aug 26 20:33:54 2014 -0700 Implement a simpler (and faster?) algorithm to convert a double to an int. diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp index 013f184..74f279d 100644 --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -1252,17 +1252,13 @@ (inst fdtox r x) (inst fxtod r r))) +;; See Listing 2.2: Conversion from FP to int in in "CR-LIBM: A +;; library of correctly rounded elementary functions in +;; double-precision". #+sun4 (deftransform %unary-round ((x) (float) (signed-byte 32)) - '(let* ((trunc (truly-the (signed-byte 32) (%unary-truncate x))) - (extra (- x trunc)) - (absx (abs extra)) - (one-half (float 1/2 x))) - (if (if (oddp trunc) - (>= absx one-half) - (> absx one-half)) - (truly-the (signed-byte 32) (%unary-truncate (+ x extra))) - trunc))) + '(kernel:double-float-low-bits (+ x (+ (scale-float 1d0 52) + (scale-float 1d0 51))))) (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res ----------------------------------------------------------------------- Summary of changes: src/compiler/sparc/float.lisp | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) 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-06-73-gfdc6db4
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 fdc6db4b7af14ce1ceb6e38e92135335a4921fa3 (commit) via 797b00817a9ecfb6e13badf1aa2b88ff87acc2ac (commit) via d2e935a5b3a1a3922be0c52059fa99a332178483 (commit) from efbeb89b14488c258f8f95e4f443460e428a2046 (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 fdc6db4b7af14ce1ceb6e38e92135335a4921fa3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:46:50 2014 -0700 Use fdlibm_atan instead of atan. * fdlibm.h: * Declare fdlibm_atan * e_atan2.c: * Use fdlibm_atan instead of atan. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c index f4c1c12..7e177e8 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 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 */ @@ -115,7 +115,7 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ k = (iy-ix)>>20; if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */ else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ - else z=atan(fabs(y/x)); /* safe to do y/x */ + else z=fdlibm_atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: diff --git a/src/lisp/fdlibm.h b/src/lisp/fdlibm.h index 72f57f8..9d25664 100644 --- a/src/lisp/fdlibm.h +++ b/src/lisp/fdlibm.h @@ -53,6 +53,7 @@ extern double fdlibm_cos(double x); extern double fdlibm_tan(double x); extern double fdlibm_expm1(double x); extern double fdlibm_log1p(double x); +extern double fdlibm_atan(double x); extern double __ieee754_exp(double x); extern double __ieee754_log(double x); commit 797b00817a9ecfb6e13badf1aa2b88ff87acc2ac Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:43:49 2014 -0700 Fix up atan2 by using unions. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c index 4e731ba..f4c1c12 100644 --- a/src/lisp/e_atan2.c +++ b/src/lisp/e_atan2.c @@ -63,11 +63,15 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ double z; int k,m,hx,hy,ix,iy; unsigned lx,ly; + union { int i[2]; double d; } ux; + union { int i[2]; double d; } uy; - hx = __HI(x); ix = hx&0x7fffffff; - lx = __LO(x); - hy = __HI(y); iy = hy&0x7fffffff; - ly = __LO(y); + ux.d = x; + hx = ux.i[HIWORD]; ix = hx&0x7fffffff; + lx = ux.i[LOWORD]; + uy.d = y; + hy = uy.i[HIWORD]; iy = hy&0x7fffffff; + ly = uy.i[LOWORD]; if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; @@ -114,7 +118,10 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ else z=atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ - case 1: __HI(z) ^= 0x80000000; + case 1: + ux.d = z; + ux.i[HIWORD] ^= 0x80000000; + z = ux.d; return z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ commit d2e935a5b3a1a3922be0c52059fa99a332178483 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:40:31 2014 -0700 Import atan2 function from fdlibm, as is. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c new file mode 100644 index 0000000..4e731ba --- /dev/null +++ b/src/lisp/e_atan2.c @@ -0,0 +1,123 @@ + +/* @(#)e_atan2.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_atan2(y,x) + * Method : + * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x). + * 2. Reduce x to positive by (if x and y are unexceptional): + * ARG (x+iy) = arctan(y/x) ... if x > 0, + * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0, + * + * Special cases: + * + * ATAN2((anything), NaN ) is NaN; + * ATAN2(NAN , (anything) ) is NaN; + * ATAN2(+-0, +(anything but NaN)) is +-0 ; + * ATAN2(+-0, -(anything but NaN)) is +-pi ; + * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2; + * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ; + * ATAN2(+-(anything but INF and NaN), -INF) is +-pi; + * ATAN2(+-INF,+INF ) is +-pi/4 ; + * ATAN2(+-INF,-INF ) is +-3pi/4; + * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2; + * + * 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 +tiny = 1.0e-300, +zero = 0.0, +pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */ +pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */ +pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */ +pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ + +#ifdef __STDC__ + double __ieee754_atan2(double y, double x) +#else + double __ieee754_atan2(y,x) + double y,x; +#endif +{ + double z; + int k,m,hx,hy,ix,iy; + unsigned lx,ly; + + hx = __HI(x); ix = hx&0x7fffffff; + lx = __LO(x); + hy = __HI(y); iy = hy&0x7fffffff; + ly = __LO(y); + 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 atan(y); /* x=1.0 */ + m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ + + /* when y = 0 */ + if((iy|ly)==0) { + switch(m) { + case 0: + case 1: return y; /* atan(+-0,+anything)=+-0 */ + case 2: return pi+tiny;/* atan(+0,-anything) = pi */ + case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ + } + } + /* when x = 0 */ + if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; + + /* when x is INF */ + if(ix==0x7ff00000) { + if(iy==0x7ff00000) { + switch(m) { + case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ + case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ + case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ + case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ + } + } else { + switch(m) { + case 0: return zero ; /* atan(+...,+INF) */ + case 1: return -zero ; /* atan(-...,+INF) */ + case 2: return pi+tiny ; /* atan(+...,-INF) */ + case 3: return -pi-tiny ; /* atan(-...,-INF) */ + } + } + } + /* when y is INF */ + if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; + + /* compute y/x */ + k = (iy-ix)>>20; + if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */ + else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ + else z=atan(fabs(y/x)); /* safe to do y/x */ + switch (m) { + case 0: return z ; /* atan(+,+) */ + case 1: __HI(z) ^= 0x80000000; + return z ; /* atan(-,+) */ + case 2: return pi-(z-pi_lo);/* atan(+,-) */ + default: /* case 3 */ + return (z-pi_lo)-pi;/* atan(-,-) */ + } +} ----------------------------------------------------------------------- Summary of changes: src/lisp/e_atan2.c | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/lisp/fdlibm.h | 1 + 2 files changed, 131 insertions(+) create mode 100644 src/lisp/e_atan2.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-3-g9b83625d
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 9b83625d4fc0809170354f5397afb7dab2103d42 (commit) from 2ec1fda2a83f17fe9ee580ef14b887b5c66f844a (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 9b83625d4fc0809170354f5397afb7dab2103d42 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Sep 4 21:15:58 2014 -0700 Wrap all exports in eval-when since export is now an ordinary function without any compiler magic. Untested. diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 79e396f..4916ebf 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -40,6 +40,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -55,6 +56,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) +; ; eval-when @@ -128,11 +130,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. ;;; @@ -157,10 +161,12 @@ ;;;; Other random constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap single-step-breakpoint trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -trap :start 8) halt @@ -181,7 +187,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; These symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 90259c2..2ad4692 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -39,6 +39,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -54,7 +55,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) - +) ; eval-when (eval-when (compile load eval) @@ -119,11 +120,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. @@ -143,11 +146,13 @@ ;;;; Other random constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap single-step-breakpoint-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -trap :start 8) halt @@ -168,7 +173,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; These symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 7cf4b8a..740258d 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -50,6 +50,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -65,7 +66,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) - +) ; eval-when (eval-when (compile load eval) @@ -129,11 +130,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. ;;; @@ -147,7 +150,8 @@ ;;; large object space instead. Must be less then a page. ;;; #+gengc -(export 'large-object-cutoff) +(eval-when (:compile-toplevel :load-toplevel :execute) + (export 'large-object-cutoff)) #+gengc (defparameter large-object-cutoff 1024) @@ -155,10 +159,12 @@ ;;;; Other non-type constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(atomic-flag interrupted-flag halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap after-breakpoint-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -flag) atomic @@ -183,7 +189,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; Static symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant ----------------------------------------------------------------------- Summary of changes: src/compiler/alpha/parms.lisp | 8 ++++++++ src/compiler/hppa/parms.lisp | 9 ++++++++- src/compiler/mips/parms.lisp | 12 ++++++++++-- 3 files changed, 26 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-08-6-g0331b89
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 0331b89234436da149eb5b142e206ae5af2d9c7b (commit) from 864c24bdd0abbf86dd35529c79657c9ed3db62ac (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 0331b89234436da149eb5b142e206ae5af2d9c7b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 21 20:16:01 2013 -0700 Allow disasembler to work for any value of *print-base*. With these changes, you can bind *print-base* to 16 and *print-case* to :downcase to get correctly printed disassembly in lower case with all numerical values in hex. If you want the radix marker as well, bind *print-radix* to T; the disassembly is still correct. src/compiler/disassem.lisp: o When printing out the source code, bind *print-base* to 10 so that the code is printed "naturally". src/compiler/x86/insts.lisp: o Use Carl's much cleaned-up print-mem-access o Update print-imm-data to use princ for all values, removing the special casing for NIL o When printing out xmm registers, honor *print-case*. src/general-info/release-20e.txt: o Update diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 13f6b35..a236592 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -2964,10 +2964,11 @@ (when stream (unless at-block-begin (terpri stream)) - (pprint-logical-block (stream nil :per-line-prefix ";;; ") - (format stream "[~D] " - (di:code-location-form-number loc)) - (prin1-short form stream)) + (let ((*print-base* 10)) + (pprint-logical-block (stream nil :per-line-prefix ";;; ") + (format stream "[~D] " + (di:code-location-form-number loc)) + (prin1-short form stream))) (terpri stream) (terpri stream))) t))))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 2417c04..048b9ec 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -422,52 +422,39 @@ (princ (disassem:dstate-get-prop dstate 'width) stream) (princ '| PTR | stream)) (write-char #\[ stream) - (let ((firstp t)) - (macrolet ((pel ((var val) &body body) - ;; Print an element of the address, maybe with - ;; a leading separator. - `(let ((,var ,val)) - (when ,var - (unless firstp - (write-char #\+ stream)) - ,@body - (setq firstp nil))))) - (pel (base-reg (first value)) - (print-addr-reg base-reg stream dstate)) - (pel (index-reg (third value)) - (print-addr-reg index-reg stream dstate) - (let ((index-scale (fourth value))) - (when (and index-scale (not (= index-scale 1))) - (write-char #\* stream) - (princ index-scale stream)))) - (let ((offset (second value))) - (when (and offset (or firstp (not (zerop offset)))) - (unless (or firstp (minusp offset)) - (write-char #\+ stream)) - (if firstp - (let ((unsigned-offset (if (minusp offset) - (+ #x100000000 offset) - offset))) - (disassem:princ16 unsigned-offset stream) - (or (nth-value 1 - (disassem::note-code-constant-absolute unsigned-offset - dstate)) - (disassem:maybe-note-assembler-routine unsigned-offset - stream - dstate) - (let ((offs (- offset disassem::nil-addr))) - (when (typep offs 'disassem::offset) - (or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs - dstate) - (disassem::maybe-note-static-function offs dstate)))))) - (princ offset stream)))))) + (destructuring-bind (&optional base disp index scale) value + (when base + (print-addr-reg base stream dstate) + (when index + (write-char #\+ stream))) + (when index + (print-addr-reg index stream dstate)) + (when (and scale (> scale 1)) + (write-char #\* stream) + (princ scale stream)) + (when (and disp (not (zerop disp))) + (when (and (or base index)) + (write-char (if (minusp disp) #\- #\+) stream)) + (let ((unsigned-offset (if (minusp disp) + (+ #x100000000 disp) + disp))) + (or (nth-value 1 + (disassem::note-code-constant-absolute unsigned-offset + dstate)) + (disassem:maybe-note-assembler-routine unsigned-offset + stream + dstate) + (let ((offs (- disp disassem::nil-addr))) + (when (typep offs 'disassem::offset) + (or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs + dstate) + (disassem::maybe-note-static-function offs dstate)))))) + (princ (abs disp) stream))) (write-char #\] stream)) (defun print-imm-data (value stream dstate) (let ((offset (- value disassem::nil-addr))) - (if (zerop offset) - (format stream "#x~X" value) - (format stream "~A" value)) + (princ value stream) (when (typep offset 'disassem::offset) (or (disassem::maybe-note-nil-indexed-object offset dstate) (let ((unsigned-offset (if (and (numberp value) (minusp value)) @@ -603,7 +590,7 @@ (declare (type xmmreg value) (type stream stream) (ignore dstate)) - (format stream "XMM~d" value)) + (format stream "~A~D" 'xmm value)) (defun print-xmmreg/mem (value stream dstate) (declare (type (or list xmmreg) value) diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index 6c4fd1a..9d91bcc 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -21,6 +21,8 @@ New in this release: * Known issues: * Feature enhancements + * The disassembler (on x86) prints correctly for any value of + *print-base*. * Changes * ASDF2 updated to version 3.0.2. ----------------------------------------------------------------------- Summary of changes: src/compiler/disassem.lisp | 9 ++--- src/compiler/x86/insts.lisp | 73 ++++++++++++++++---------------------- src/general-info/release-20e.txt | 2 ++ 3 files changed, 37 insertions(+), 47 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-11-3-g8674b2d
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 8674b2d2b73bf7d7402d323f8179d1312b0843f6 (commit) from 20ee8ef20cd01a0be841695d6beaf98968e5be31 (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 8674b2d2b73bf7d7402d323f8179d1312b0843f6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Nov 10 10:39:01 2013 -0800 Print out the value of the non-zero word. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index 9caae2d..f06b23b 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -1194,8 +1194,8 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) for (p = (int *) alloc_region->start_addr; p < (int *) alloc_region->end_addr; p++) if (*p != 0) - fprintf(stderr, "** new region not zero @ %lx\n", - (unsigned long) p); + fprintf(stderr, "** new region not zero @ %lx: %lx\n", + (unsigned long) p, *p); } /* Setup the pages. */ ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.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-47-g7618374
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 76183742d841486c85cfa1a26f811373c40208f2 (commit) via 1620d4c19d12e0c96f72aadb4bfda13ea8297529 (commit) from f11c37a6547e87f5438a6f66969c7f531e061054 (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 76183742d841486c85cfa1a26f811373c40208f2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 22:52:41 2014 -0700 Compile the new fdlibm routines. diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index d9d1bfd..4edf0eb 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -74,7 +74,7 @@ OS_LIBS = -lSystem -lc -lm e_rem_pio2.o : e_rem_pio2.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< -OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.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 k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -93,3 +93,12 @@ s_tan.o : s_tan.c sincos.o : sincos.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +s_log1p.o : s_log1p.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_exmp1.o : s_expm1.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +e_pow.o : e_pow.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + commit 1620d4c19d12e0c96f72aadb4bfda13ea8297529 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 01:52:01 2014 -0400 Compile the new fdlibm routines. diff --git a/src/lisp/Config.sparc_sunc b/src/lisp/Config.sparc_sunc index ffe4598..1578b56 100644 --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -29,7 +29,7 @@ DEPEND_FLAGS = -xM ASFLAGS = $(AS_V8PLUS) OS_LINK_FLAGS = -M /usr/lib/ld/map.noexstk -OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.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 k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -47,3 +47,12 @@ s_tan.o : s_tan.c sincos.o : sincos.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +s_log1p.o : s_log1p.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_exmp1.o : s_expm1.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +e_pow.o : e_pow.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.ppc_darwin | 11 ++++++++++- src/lisp/Config.sparc_sunc | 11 ++++++++++- 2 files changed, 20 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-33-gdf548f6
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 df548f6e69bc4fa0aec3825d10074135c9e4ac03 (commit) from 54dd52c6348b74051dd63be6abdd1952be7137af (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 df548f6e69bc4fa0aec3825d10074135c9e4ac03 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Aug 26 19:07:54 2014 -0700 Oops. Fix mistake in handling underflow for %exp. * src/lisp/e_exp.c: * Signal underflow instead of returning the arg. * tests/trig.lisp: * Add tests for %exp when exp underflows. diff --git a/src/lisp/e_exp.c b/src/lisp/e_exp.c index 034c590..93b638e 100644 --- a/src/lisp/e_exp.c +++ b/src/lisp/e_exp.c @@ -142,7 +142,10 @@ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ return fdlibm_setexception(x, FDLIBM_OVERFLOW); } - if(x < u_threshold) return x; /* underflow */ + if(x < u_threshold) { + /* underflow */ + return fdlibm_setexception(0.0, FDLIBM_UNDERFLOW); + } } /* argument reduction */ diff --git a/tests/trig.lisp b/tests/trig.lisp index 724fabe..cfd7ea2 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -945,9 +945,18 @@ (kernel:%exp *snan*)) (assert-equal ext:double-float-positive-infinity (kernel:%exp ext:double-float-positive-infinity)) + (assert-equal 0d0 + (kernel:%exp -1000d0)) (kernel::with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity - (kernel:%exp 710d0)))) + (kernel:%exp 710d0))) + (let ((modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:underflow)) + (assert-error 'floating-point-underflow + (kernel:%exp -1000d0))) + (apply #'ext:set-floating-point-modes modes)))) (define-test %log.exception (:tag :fdlibm) ----------------------------------------------------------------------- Summary of changes: src/lisp/e_exp.c | 5 ++++- tests/trig.lisp | 11 ++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0