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 f399fc8dab36676d617b1fa7e1e2c70bc5ddbffa (commit) via d29ef8f73a446d978406fec5bccbdf8882964870 (commit) from 28ca34951c313162068768fb80742254dd7af1b6 (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 f399fc8dab36676d617b1fa7e1e2c70bc5ddbffa Author: Raymond Toy <toy.raymond@gmail.com> Date: Sat Aug 2 14:33:26 2014 -0700 Import hyperbolic functions from fdlibm, as is. diff --git a/src/lisp/e_cosh.c b/src/lisp/e_cosh.c new file mode 100644 index 0000000..204017d --- /dev/null +++ b/src/lisp/e_cosh.c @@ -0,0 +1,89 @@ + +/* @(#)e_cosh.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_cosh(x) + * Method : + * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2 + * 1. Replace x by |x| (cosh(x) = cosh(-x)). + * 2. + * [ exp(x) - 1 ]^2 + * 0 <= x <= ln2/2 : cosh(x) := 1 + ------------------- + * 2*exp(x) + * + * exp(x) + 1/exp(x) + * ln2/2 <= x <= 22 : cosh(x) := ------------------- + * 2 + * 22 <= x <= lnovft : cosh(x) := exp(x)/2 + * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2) + * ln2ovft < x : cosh(x) := huge*huge (overflow) + * + * Special cases: + * cosh(x) is |x| if x is +INF, -INF, or NaN. + * only cosh(0)=1 is exact for finite x. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double one = 1.0, half=0.5, huge = 1.0e300; +#else +static double one = 1.0, half=0.5, huge = 1.0e300; +#endif + +#ifdef __STDC__ + double __ieee754_cosh(double x) +#else + double __ieee754_cosh(x) + double x; +#endif +{ + double t,w; + int ix; + unsigned lx; + + /* High word of |x|. */ + ix = __HI(x); + ix &= 0x7fffffff; + + /* x is INF or NaN */ + if(ix>=0x7ff00000) return x*x; + + /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ + if(ix<0x3fd62e43) { + t = expm1(fabs(x)); + w = one+t; + if (ix<0x3c800000) return w; /* cosh(tiny) = 1 */ + return one+(t*t)/(w+w); + } + + /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ + if (ix < 0x40360000) { + t = __ieee754_exp(fabs(x)); + return half*t+half/t; + } + + /* |x| in [22, log(maxdouble)] return half*exp(|x|) */ + if (ix < 0x40862E42) return half*__ieee754_exp(fabs(x)); + + /* |x| in [log(maxdouble), overflowthresold] */ + lx = *( (((*(unsigned*)&one)>>29)) + (unsigned*)&x); + if (ix<0x408633CE || + (ix==0x408633ce)&&(lx<=(unsigned)0x8fb9f87d)) { + w = __ieee754_exp(half*fabs(x)); + t = half*w; + return t*w; + } + + /* |x| > overflowthresold, cosh(x) overflow */ + return huge*huge; +} diff --git a/src/lisp/e_sinh.c b/src/lisp/e_sinh.c new file mode 100644 index 0000000..8af8a11 --- /dev/null +++ b/src/lisp/e_sinh.c @@ -0,0 +1,82 @@ + +/* @(#)e_sinh.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_sinh(x) + * Method : + * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 + * 1. Replace x by |x| (sinh(-x) = -sinh(x)). + * 2. + * E + E/(E+1) + * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x) + * 2 + * + * 22 <= x <= lnovft : sinh(x) := exp(x)/2 + * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2) + * ln2ovft < x : sinh(x) := x*shuge (overflow) + * + * Special cases: + * sinh(x) is |x| if x is +INF, -INF, or NaN. + * only sinh(0)=0 is exact for finite x. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double one = 1.0, shuge = 1.0e307; +#else +static double one = 1.0, shuge = 1.0e307; +#endif + +#ifdef __STDC__ + double __ieee754_sinh(double x) +#else + double __ieee754_sinh(x) + double x; +#endif +{ + double t,w,h; + int ix,jx; + unsigned lx; + + /* High word of |x|. */ + jx = __HI(x); + ix = jx&0x7fffffff; + + /* x is INF or NaN */ + if(ix>=0x7ff00000) return x+x; + + h = 0.5; + if (jx<0) h = -h; + /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix < 0x40360000) { /* |x|<22 */ + if (ix<0x3e300000) /* |x|<2**-28 */ + if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ + t = expm1(fabs(x)); + if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one)); + return h*(t+t/(t+one)); + } + + /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */ + if (ix < 0x40862E42) return h*__ieee754_exp(fabs(x)); + + /* |x| in [log(maxdouble), overflowthresold] */ + lx = *( (((*(unsigned*)&one)>>29)) + (unsigned*)&x); + if (ix<0x408633CE || (ix==0x408633ce)&&(lx<=(unsigned)0x8fb9f87d)) { + w = __ieee754_exp(0.5*fabs(x)); + t = h*w; + return t*w; + } + + /* |x| > overflowthresold, sinh(x) overflow */ + return x*shuge; +} diff --git a/src/lisp/s_tanh.c b/src/lisp/s_tanh.c new file mode 100644 index 0000000..7d77c2e --- /dev/null +++ b/src/lisp/s_tanh.c @@ -0,0 +1,82 @@ + +/* @(#)s_tanh.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. + * ==================================================== + */ + +/* Tanh(x) + * Return the Hyperbolic Tangent of x + * + * Method : + * x -x + * e - e + * 0. tanh(x) is defined to be ----------- + * x -x + * e + e + * 1. reduce x to non-negative by tanh(-x) = -tanh(x). + * 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x) + * -t + * 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x) + * t + 2 + * 2 + * 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x) + * t + 2 + * 22.0 < x <= INF : tanh(x) := 1. + * + * Special cases: + * tanh(NaN) is NaN; + * only tanh(0)=0 is exact for finite argument. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double one=1.0, two=2.0, tiny = 1.0e-300; +#else +static double one=1.0, two=2.0, tiny = 1.0e-300; +#endif + +#ifdef __STDC__ + double tanh(double x) +#else + double tanh(x) + double x; +#endif +{ + double t,z; + int jx,ix; + + /* High word of |x|. */ + jx = __HI(x); + ix = jx&0x7fffffff; + + /* x is INF or NaN */ + if(ix>=0x7ff00000) { + if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ + else return one/x-one; /* tanh(NaN) = NaN */ + } + + /* |x| < 22 */ + if (ix < 0x40360000) { /* |x|<22 */ + if (ix<0x3c800000) /* |x|<2**-55 */ + return x*(one+x); /* tanh(small) = small */ + if (ix>=0x3ff00000) { /* |x|>=1 */ + t = expm1(two*fabs(x)); + z = one - two/(t+two); + } else { + t = expm1(-two*fabs(x)); + z= -t/(t+two); + } + /* |x| > 22, return +-1 */ + } else { + z = one - tiny; /* raised inexact flag */ + } + return (jx>=0)? z: -z; +} commit d29ef8f73a446d978406fec5bccbdf8882964870 Author: Raymond Toy <toy.raymond@gmail.com> Date: Sat Aug 2 13:56:04 2014 -0700 Add some braces to silence the warning from clang about dangling else statements. diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index eaec38a..87ed927 100644 --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -159,8 +159,14 @@ static double zero = 0.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;} + 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); ----------------------------------------------------------------------- Summary of changes: src/lisp/e_cosh.c | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/lisp/e_sinh.c | 82 +++++++++++++++++++++++++++++++++++++++++++++++ src/lisp/s_log1p.c | 10 ++++-- src/lisp/s_tanh.c | 82 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 261 insertions(+), 2 deletions(-) create mode 100644 src/lisp/e_cosh.c create mode 100644 src/lisp/e_sinh.c create mode 100644 src/lisp/s_tanh.c hooks/post-receive -- CMU Common Lisp