[git] CMU Common Lisp branch master updated. snapshot-2014-06-73-gfdc6db4
Raymond Toy
rtoy at common-lisp.net
Sat Aug 2 22:47:03 UTC 2014
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 at 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 at 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 at 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
More information about the cmucl-cvs
mailing list