summaryrefslogtreecommitdiff
path: root/libm/ldouble
diff options
context:
space:
mode:
Diffstat (limited to 'libm/ldouble')
-rw-r--r--libm/ldouble/Makefile123
-rw-r--r--libm/ldouble/README.txt3502
-rw-r--r--libm/ldouble/acoshl.c167
-rw-r--r--libm/ldouble/arcdotl.c108
-rw-r--r--libm/ldouble/asinhl.c156
-rw-r--r--libm/ldouble/asinl.c249
-rw-r--r--libm/ldouble/atanhl.c163
-rw-r--r--libm/ldouble/atanl.c376
-rw-r--r--libm/ldouble/bdtrl.c260
-rw-r--r--libm/ldouble/btdtrl.c68
-rw-r--r--libm/ldouble/cbrtl.c143
-rw-r--r--libm/ldouble/chdtrl.c200
-rw-r--r--libm/ldouble/clogl.c720
-rw-r--r--libm/ldouble/cmplxl.c461
-rw-r--r--libm/ldouble/coshl.c89
-rw-r--r--libm/ldouble/econst.c96
-rw-r--r--libm/ldouble/ehead.h45
-rw-r--r--libm/ldouble/elliel.c146
-rw-r--r--libm/ldouble/ellikl.c148
-rw-r--r--libm/ldouble/ellpel.c173
-rw-r--r--libm/ldouble/ellpjl.c164
-rw-r--r--libm/ldouble/ellpkl.c203
-rw-r--r--libm/ldouble/exp10l.c192
-rw-r--r--libm/ldouble/exp2l.c166
-rw-r--r--libm/ldouble/expl.c183
-rw-r--r--libm/ldouble/fdtrl.c237
-rw-r--r--libm/ldouble/floorl.c432
-rw-r--r--libm/ldouble/flrtstl.c104
-rw-r--r--libm/ldouble/fltestl.c265
-rw-r--r--libm/ldouble/gammal.c764
-rw-r--r--libm/ldouble/gdtrl.c130
-rw-r--r--libm/ldouble/gelsl.c240
-rw-r--r--libm/ldouble/ieee.c4182
-rw-r--r--libm/ldouble/igamil.c193
-rw-r--r--libm/ldouble/igaml.c220
-rw-r--r--libm/ldouble/incbetl.c406
-rw-r--r--libm/ldouble/incbil.c305
-rw-r--r--libm/ldouble/isnanl.c186
-rw-r--r--libm/ldouble/j0l.c541
-rw-r--r--libm/ldouble/j1l.c551
-rw-r--r--libm/ldouble/jnl.c130
-rw-r--r--libm/ldouble/lcalc.c1484
-rw-r--r--libm/ldouble/lcalc.h79
-rw-r--r--libm/ldouble/ldrand.c175
-rw-r--r--libm/ldouble/log10l.c319
-rw-r--r--libm/ldouble/log2l.c302
-rw-r--r--libm/ldouble/logl.c292
-rw-r--r--libm/ldouble/lparanoi.c2348
-rw-r--r--libm/ldouble/monotl.c307
-rw-r--r--libm/ldouble/mtherr.c102
-rw-r--r--libm/ldouble/mtstl.c521
-rw-r--r--libm/ldouble/nantst.c61
-rw-r--r--libm/ldouble/nbdtrl.c197
-rw-r--r--libm/ldouble/ndtril.c416
-rw-r--r--libm/ldouble/ndtrl.c473
-rw-r--r--libm/ldouble/pdtrl.c184
-rw-r--r--libm/ldouble/polevll.c182
-rw-r--r--libm/ldouble/powil.c164
-rw-r--r--libm/ldouble/powl.c739
-rw-r--r--libm/ldouble/sinhl.c150
-rw-r--r--libm/ldouble/sinl.c342
-rw-r--r--libm/ldouble/sqrtl.c172
-rw-r--r--libm/ldouble/stdtrl.c225
-rw-r--r--libm/ldouble/tanhl.c129
-rw-r--r--libm/ldouble/tanl.c279
-rw-r--r--libm/ldouble/testvect.c497
-rw-r--r--libm/ldouble/unityl.c128
-rw-r--r--libm/ldouble/wronkl.c67
-rw-r--r--libm/ldouble/ynl.c113
69 files changed, 27634 insertions, 0 deletions
diff --git a/libm/ldouble/Makefile b/libm/ldouble/Makefile
new file mode 100644
index 000000000..43395a140
--- /dev/null
+++ b/libm/ldouble/Makefile
@@ -0,0 +1,123 @@
+# Makefile for uClibc's math library
+#
+# Copyright (C) 2001 by Lineo, inc.
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU Library General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more
+# details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with this program; if not, write to the Free Software Foundation, Inc.,
+# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Derived in part from the Linux-8086 C library, the GNU C Library, and several
+# other sundry sources. Files within this library are copyright by their
+# respective copyright holders.
+
+TOPDIR=../../
+include $(TOPDIR)Rules.mak
+
+LIBM=../libm.a
+TARGET_CC= $(TOPDIR)/extra/gcc-uClibc/$(TARGET_ARCH)-uclibc-gcc
+
+CSRC=acoshl.c asinhl.c asinl.c atanhl.c atanl.c bdtrl.c btdtrl.c cbrtl.c \
+ chdtrl.c coshl.c ellpel.c ellpkl.c elliel.c ellikl.c ellpjl.c \
+ exp10l.c exp2l.c expl.c fdtrl.c gammal.c gdtrl.c igamil.c igaml.c \
+ incbetl.c incbil.c isnanl.c j0l.c j1l.c jnl.c ldrand.c log10l.c log2l.c \
+ logl.c nbdtrl.c ndtril.c ndtrl.c pdtrl.c powl.c powil.c sinhl.c sinl.c \
+ sqrtl.c stdtrl.c tanhl.c tanl.c unityl.c ynl.c \
+ floorl.c polevll.c mtherr.c #cmplxl.c clogl.c
+COBJS=$(patsubst %.c,%.o, $(CSRC))
+
+
+OBJS=$(COBJS)
+
+all: $(OBJS) $(LIBM)
+
+$(LIBM): ar-target
+
+ar-target: $(OBJS)
+ $(AR) $(ARFLAGS) $(LIBM) $(OBJS)
+
+$(COBJS): %.o : %.c
+ $(TARGET_CC) $(CFLAGS) -c $< -o $@
+ $(STRIPTOOL) -x -R .note -R .comment $*.o
+
+$(OBJ): Makefile
+
+clean:
+ rm -f *.[oa] *~ core
+
+
+
+#-----------------------------------------
+
+
+#all: mtstl lparanoi lcalc fltestl nantst testvect monotl libml.a
+
+mtstl: libml.a mtstl.o $(OBJS)
+ $(CC) $(CFLAGS) -o mtstl mtstl.o libml.a $(LIBS)
+
+mtstl.o: mtstl.c
+
+lparanoi: libml.a lparanoi.o setprec.o ieee.o econst.o $(OBJS)
+ $(CC) $(CFLAGS) -o lparanoi lparanoi.o setprec.o ieee.o econst.o libml.a $(LIBS)
+
+lparanoi.o: lparanoi.c
+ $(CC) $(CFLAGS) -Wno-implicit -c lparanoi.c
+
+econst.o: econst.c ehead.h
+
+lcalc: libml.a lcalc.o ieee.o econst.o $(OBJS)
+ $(CC) $(CFLAGS) -o lcalc lcalc.o ieee.o econst.o libml.a $(LIBS)
+
+lcalc.o: lcalc.c lcalc.h ehead.h
+
+ieee.o: ieee.c ehead.h
+
+# Use $(OBJS) in ar command for libml.a if possible; else *.o
+libml.a: $(OBJS) mconf.h
+ ar -rv libml.a $(OBJS)
+ ranlib libml.a
+
+
+fltestl: fltestl.c libml.a
+ $(CC) $(CFLAGS) -o fltestl fltestl.c libml.a
+
+fltestl.o: fltestl.c
+
+flrtstl: flrtstl.c libml.a
+ $(CC) $(CFLAGS) -o flrtstl flrtstl.c libml.a
+
+flrtstl.o: flrtstl.c
+
+nantst: nantst.c libml.a
+ $(CC) $(CFLAGS) -o nantst nantst.c libml.a
+
+nantst.o: nantst.c
+
+testvect: testvect.o libml.a
+ $(CC) $(CFLAGS) -o testvect testvect.o libml.a
+
+testvect.o: testvect.c
+ $(CC) -g -c -o testvect.o testvect.c
+
+monotl: monotl.o libml.a
+ $(CC) $(CFLAGS) -o monotl monotl.o libml.a
+
+monotl.o: monotl.c
+ $(CC) -g -c -o monotl.o monotl.c
+
+# Run test programs
+check: mtstl fltestl testvect monotl libml.a
+ -mtstl
+ -fltestl
+ -testvect
+ -monotl
+
diff --git a/libm/ldouble/README.txt b/libm/ldouble/README.txt
new file mode 100644
index 000000000..30fcaad36
--- /dev/null
+++ b/libm/ldouble/README.txt
@@ -0,0 +1,3502 @@
+/* acoshl.c
+ *
+ * Inverse hyperbolic cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, acoshl();
+ *
+ * y = acoshl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic cosine of argument.
+ *
+ * If 1 <= x < 1.5, a rational approximation
+ *
+ * sqrt(2z) * P(z)/Q(z)
+ *
+ * where z = x-1, is used. Otherwise,
+ *
+ * acosh(x) = log( x + sqrt( (x-1)(x+1) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 1,3 30000 2.0e-19 3.9e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acoshl domain |x| < 1 0.0
+ *
+ */
+
+/* asinhl.c
+ *
+ * Inverse hyperbolic sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, asinhl();
+ *
+ * y = asinhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic sine of argument.
+ *
+ * If |x| < 0.5, the function is approximated by a rational
+ * form x + x**3 P(x)/Q(x). Otherwise,
+ *
+ * asinh(x) = log( x + sqrt(1 + x*x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -3,3 30000 1.7e-19 3.5e-20
+ *
+ */
+
+/* asinl.c
+ *
+ * Inverse circular sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asinl();
+ *
+ * y = asinl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose sine is x.
+ *
+ * A rational function of the form x + x**3 P(x**2)/Q(x**2)
+ * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is
+ * transformed by the identity
+ *
+ * asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1, 1 30000 2.7e-19 4.8e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 0.0
+ *
+ */
+ /* acosl()
+ *
+ * Inverse circular cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acosl();
+ *
+ * y = acosl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose cosine
+ * is x.
+ *
+ * Analytically, acos(x) = pi/2 - asin(x). However if |x| is
+ * near 1, there is cancellation error in subtracting asin(x)
+ * from pi/2. Hence if x < -0.5,
+ *
+ * acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) );
+ *
+ * or if x > +0.5,
+ *
+ * acos(x) = 2.0 * asin( sqrt((1-x)/2) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1, 1 30000 1.4e-19 3.5e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 0.0
+ */
+
+/* atanhl.c
+ *
+ * Inverse hyperbolic tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, atanhl();
+ *
+ * y = atanhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic tangent of argument in the range
+ * MINLOGL to MAXLOGL.
+ *
+ * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
+ * employed. Otherwise,
+ * atanh(x) = 0.5 * log( (1+x)/(1-x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1,1 30000 1.1e-19 3.3e-20
+ *
+ */
+
+/* atanl.c
+ *
+ * Inverse circular tangent, long double precision
+ * (arctangent)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, atanl();
+ *
+ * y = atanl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose tangent
+ * is x.
+ *
+ * Range reduction is from four intervals into the interval
+ * from zero to tan( pi/8 ). The approximant uses a rational
+ * function of degree 3/4 of the form x + x**3 P(x)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10, 10 150000 1.3e-19 3.0e-20
+ *
+ */
+ /* atan2l()
+ *
+ * Quadrant correct inverse circular tangent,
+ * long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, z, atan2l();
+ *
+ * z = atan2l( y, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle whose tangent is y/x.
+ * Define compile time symbol ANSIC = 1 for ANSI standard,
+ * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range
+ * 0 to 2PI, args (x,y).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10, 10 60000 1.7e-19 3.2e-20
+ * See atan.c.
+ *
+ */
+
+/* bdtrl.c
+ *
+ * Binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtrl();
+ *
+ * y = bdtrl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms 0 through k of the Binomial
+ * probability density:
+ *
+ * k
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (k,n,p) with a and b between 0
+ * and 10000 and p between 0 and 1.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,10000 3000 1.6e-14 2.2e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrl domain k < 0 0.0
+ * n < k
+ * x < 0, x > 1
+ *
+ */
+ /* bdtrcl()
+ *
+ * Complemented binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtrcl();
+ *
+ * y = bdtrcl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 through n of the Binomial
+ * probability density:
+ *
+ * n
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=k+1
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrcl domain x<0, x>1, n<k 0.0
+ */
+ /* bdtril()
+ *
+ * Inverse binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtril();
+ *
+ * p = bdtril( k, n, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the event probability p such that the sum of the
+ * terms 0 through k of the Binomial probability density
+ * is equal to the given cumulative probability y.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relation
+ *
+ * 1 - p = incbi( n-k, k+1, y ).
+ *
+ * ACCURACY:
+ *
+ * See incbi.c.
+ * Tested at random k, n between 1 and 10000. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 3500 2.0e-15 8.2e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtril domain k < 0, n <= k 0.0
+ * x < 0, x > 1
+ */
+
+
+/* btdtrl.c
+ *
+ * Beta distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, btdtrl();
+ *
+ * y = btdtrl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the beta density
+ * function:
+ *
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * P(x) = ---------- | t (1-t) dt
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ *
+ * The mean value of this distribution is a/(a+b). The variance
+ * is ab/[(a+b)^2 (a+b+1)].
+ *
+ * This function is identical to the incomplete beta integral
+ * function, incbetl(a, b, x).
+ *
+ * The complemented function is
+ *
+ * 1 - P(1-x) = incbetl( b, a, x );
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbetl.c.
+ *
+ */
+
+/* cbrtl.c
+ *
+ * Cube root, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cbrtl();
+ *
+ * y = cbrtl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the cube root of the argument, which may be negative.
+ *
+ * Range reduction involves determining the power of 2 of
+ * the argument. A polynomial of degree 2 applied to the
+ * mantissa, and multiplication by the cube root of 1, 2, or 4
+ * approximates the root to within about 0.1%. Then Newton's
+ * iteration is used three times to converge to an accurate
+ * result.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE .125,8 80000 7.0e-20 2.2e-20
+ * IEEE exp(+-707) 100000 7.0e-20 2.4e-20
+ *
+ */
+
+/* chdtrl.c
+ *
+ * Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double df, x, y, chdtrl();
+ *
+ * y = chdtrl( df, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the left hand tail (from 0 to x)
+ * of the Chi square probability density function with
+ * v degrees of freedom.
+ *
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chdtr( v, x ) = igam( v/2.0, x/2.0 ).
+ *
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtr domain x < 0 or v < 1 0.0
+ */
+ /* chdtrcl()
+ *
+ * Complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double v, x, y, chdtrcl();
+ *
+ * y = chdtrcl( v, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the right hand tail (from x to
+ * infinity) of the Chi square probability density function
+ * with v degrees of freedom:
+ *
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ).
+ *
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtrc domain x < 0 or v < 1 0.0
+ */
+ /* chdtril()
+ *
+ * Inverse of complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double df, x, y, chdtril();
+ *
+ * x = chdtril( df, y );
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the Chi-square argument x such that the integral
+ * from x to infinity of the Chi-square density is equal
+ * to the given cumulative probability y.
+ *
+ * This is accomplished using the inverse gamma integral
+ * function and the relation
+ *
+ * x/2 = igami( df/2, y );
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtri domain y < 0 or y > 1 0.0
+ * v < 1
+ *
+ */
+
+/* clogl.c
+ *
+ * Complex natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void clogl();
+ * cmplxl z, w;
+ *
+ * clogl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns complex logarithm to the base e (2.718...) of
+ * the complex argument x.
+ *
+ * If z = x + iy, r = sqrt( x**2 + y**2 ),
+ * then
+ * w = log(r) + i arctan(y/x).
+ *
+ * The arctangent ranges from -PI to +PI.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 7000 8.5e-17 1.9e-17
+ * IEEE -10,+10 30000 5.0e-15 1.1e-16
+ *
+ * Larger relative error can be observed for z near 1 +i0.
+ * In IEEE arithmetic the peak absolute error is 5.2e-16, rms
+ * absolute error 1.0e-16.
+ */
+
+ /* cexpl()
+ *
+ * Complex exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cexpl();
+ * cmplxl z, w;
+ *
+ * cexpl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the exponential of the complex argument z
+ * into the complex result w.
+ *
+ * If
+ * z = x + iy,
+ * r = exp(x),
+ *
+ * then
+ *
+ * w = r cos y + i r sin y.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8700 3.7e-17 1.1e-17
+ * IEEE -10,+10 30000 3.0e-16 8.7e-17
+ *
+ */
+ /* csinl()
+ *
+ * Complex circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csinl();
+ * cmplxl z, w;
+ *
+ * csinl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * w = sin x cosh y + i cos x sinh y.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8400 5.3e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ * Also tested by csin(casin(z)) = z.
+ *
+ */
+ /* ccosl()
+ *
+ * Complex circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccosl();
+ * cmplxl z, w;
+ *
+ * ccosl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * w = cos x cosh y - i sin x sinh y.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8400 4.5e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ */
+ /* ctanl()
+ *
+ * Complex circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ctanl();
+ * cmplxl z, w;
+ *
+ * ctanl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * sin 2x + i sinh 2y
+ * w = --------------------.
+ * cos 2x + cosh 2y
+ *
+ * On the real axis the denominator is zero at odd multiples
+ * of PI/2. The denominator is evaluated by its Taylor
+ * series near these points.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 7.1e-17 1.6e-17
+ * IEEE -10,+10 30000 7.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z.
+ */
+ /* ccotl()
+ *
+ * Complex circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccotl();
+ * cmplxl z, w;
+ *
+ * ccotl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * sin 2x - i sinh 2y
+ * w = --------------------.
+ * cosh 2y - cos 2x
+ *
+ * On the real axis, the denominator has zeros at even
+ * multiples of PI/2. Near these points it is evaluated
+ * by a Taylor series.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 3000 6.5e-17 1.6e-17
+ * IEEE -10,+10 30000 9.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 + i0.
+ */
+
+ /* casinl()
+ *
+ * Complex circular arc sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void casinl();
+ * cmplxl z, w;
+ *
+ * casinl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Inverse complex sine:
+ *
+ * 2
+ * w = -i clog( iz + csqrt( 1 - z ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 10100 2.1e-15 3.4e-16
+ * IEEE -10,+10 30000 2.2e-14 2.7e-15
+ * Larger relative error can be observed for z near zero.
+ * Also tested by csin(casin(z)) = z.
+ */
+ /* cacosl()
+ *
+ * Complex circular arc cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cacosl();
+ * cmplxl z, w;
+ *
+ * cacosl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * w = arccos z = PI/2 - arcsin z.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 1.6e-15 2.8e-16
+ * IEEE -10,+10 30000 1.8e-14 2.2e-15
+ */
+
+ /* catanl()
+ *
+ * Complex circular arc tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void catanl();
+ * cmplxl z, w;
+ *
+ * catanl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ * 1 ( 2x )
+ * Re w = - arctan(-----------) + k PI
+ * 2 ( 2 2)
+ * (1 - x - y )
+ *
+ * ( 2 2)
+ * 1 (x + (y+1) )
+ * Im w = - log(------------)
+ * 4 ( 2 2)
+ * (x + (y-1) )
+ *
+ * Where k is an arbitrary integer.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+/* cmplxl.c
+ *
+ * Complex number arithmetic
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct {
+ * long double r; real part
+ * long double i; imaginary part
+ * }cmplxl;
+ *
+ * cmplxl *a, *b, *c;
+ *
+ * caddl( a, b, c ); c = b + a
+ * csubl( a, b, c ); c = b - a
+ * cmull( a, b, c ); c = b * a
+ * cdivl( a, b, c ); c = b / a
+ * cnegl( c ); c = -c
+ * cmovl( b, c ); c = b
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Addition:
+ * c.r = b.r + a.r
+ * c.i = b.i + a.i
+ *
+ * Subtraction:
+ * c.r = b.r - a.r
+ * c.i = b.i - a.i
+ *
+ * Multiplication:
+ * c.r = b.r * a.r - b.i * a.i
+ * c.i = b.r * a.i + b.i * a.r
+ *
+ * Division:
+ * d = a.r * a.r + a.i * a.i
+ * c.r = (b.r * a.r + b.i * a.i)/d
+ * c.i = (b.i * a.r - b.r * a.i)/d
+ * ACCURACY:
+ *
+ * In DEC arithmetic, the test (1/z) * z = 1 had peak relative
+ * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had
+ * peak relative error 8.3e-17, rms 2.1e-17.
+ *
+ * Tests in the rectangle {-10,+10}:
+ * Relative error:
+ * arithmetic function # trials peak rms
+ * DEC cadd 10000 1.4e-17 3.4e-18
+ * IEEE cadd 100000 1.1e-16 2.7e-17
+ * DEC csub 10000 1.4e-17 4.5e-18
+ * IEEE csub 100000 1.1e-16 3.4e-17
+ * DEC cmul 3000 2.3e-17 8.7e-18
+ * IEEE cmul 100000 2.1e-16 6.9e-17
+ * DEC cdiv 18000 4.9e-17 1.3e-17
+ * IEEE cdiv 100000 3.7e-16 1.1e-16
+ */
+
+/* cabsl()
+ *
+ * Complex absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double cabsl();
+ * cmplxl z;
+ * long double a;
+ *
+ * a = cabs( &z );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * If z = x + iy
+ *
+ * then
+ *
+ * a = sqrt( x**2 + y**2 ).
+ *
+ * Overflow and underflow are avoided by testing the magnitudes
+ * of x and y before squaring. If either is outside half of
+ * the floating point full scale range, both are rescaled.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -30,+30 30000 3.2e-17 9.2e-18
+ * IEEE -10,+10 100000 2.7e-16 6.9e-17
+ */
+ /* csqrtl()
+ *
+ * Complex square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csqrtl();
+ * cmplxl z, w;
+ *
+ * csqrtl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * If z = x + iy, r = |z|, then
+ *
+ * 1/2
+ * Im w = [ (r - x)/2 ] ,
+ *
+ * Re w = y / 2 Im w.
+ *
+ *
+ * Note that -w is also a square root of z. The root chosen
+ * is always in the upper half plane.
+ *
+ * Because of the potential for cancellation error in r - x,
+ * the result is sharpened by doing a Heron iteration
+ * (see sqrt.c) in complex arithmetic.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 25000 3.2e-17 9.6e-18
+ * IEEE -10,+10 100000 3.2e-16 7.7e-17
+ *
+ * 2
+ * Also tested by csqrt( z ) = z, and tested by arguments
+ * close to the real axis.
+ */
+
+/* coshl.c
+ *
+ * Hyperbolic cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, coshl();
+ *
+ * y = coshl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic cosine of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * cosh(x) = ( exp(x) + exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-10000 30000 1.1e-19 2.8e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cosh overflow |x| > MAXLOGL MAXNUML
+ *
+ *
+ */
+
+/* elliel.c
+ *
+ * Incomplete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double phi, m, y, elliel();
+ *
+ * y = elliel( phi, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ * phi
+ * -
+ * | |
+ * | 2
+ * E(phi_\m) = | sqrt( 1 - m sin t ) dt
+ * |
+ * | |
+ * -
+ * 0
+ *
+ * of amplitude phi and modulus m, using the arithmetic -
+ * geometric mean algorithm.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random arguments with phi in [-10, 10] and m in
+ * [0, 1].
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 50000 2.7e-18 2.3e-19
+ *
+ *
+ */
+
+/* ellikl.c
+ *
+ * Incomplete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double phi, m, y, ellikl();
+ *
+ * y = ellikl( phi, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ *
+ * phi
+ * -
+ * | |
+ * | dt
+ * F(phi_\m) = | ------------------
+ * | 2
+ * | | sqrt( 1 - m sin t )
+ * -
+ * 0
+ *
+ * of amplitude phi and modulus m, using the arithmetic -
+ * geometric mean algorithm.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points with m in [0, 1] and phi as indicated.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 30000 3.6e-18 4.1e-19
+ *
+ *
+ */
+
+/* ellpel.c
+ *
+ * Complete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double m1, y, ellpel();
+ *
+ * y = ellpel( m1 );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ * pi/2
+ * -
+ * | | 2
+ * E(m) = | sqrt( 1 - m sin t ) dt
+ * | |
+ * -
+ * 0
+ *
+ * Where m = 1 - m1, using the approximation
+ *
+ * P(x) - x log x Q(x).
+ *
+ * Though there are no singularities, the argument m1 is used
+ * rather than m for compatibility with ellpk().
+ *
+ * E(1) = 1; E(0) = pi/2.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 1 10000 1.1e-19 3.5e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpel domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpjl.c
+ *
+ * Jacobian Elliptic Functions
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double u, m, sn, cn, dn, phi;
+ * int ellpjl();
+ *
+ * ellpjl( u, m, _&sn, _&cn, _&dn, _&phi );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m),
+ * and dn(u|m) of parameter m between 0 and 1, and real
+ * argument u.
+ *
+ * These functions are periodic, with quarter-period on the
+ * real axis equal to the complete elliptic integral
+ * ellpk(1.0-m).
+ *
+ * Relation to incomplete elliptic integral:
+ * If u = ellik(phi,m), then sn(u|m) = sin(phi),
+ * and cn(u|m) = cos(phi). Phi is called the amplitude of u.
+ *
+ * Computation is by means of the arithmetic-geometric mean
+ * algorithm, except when m is within 1e-12 of 0 or 1. In the
+ * latter case with m close to 1, the approximation applies
+ * only for phi < pi/2.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points with u between 0 and 10, m between
+ * 0 and 1.
+ *
+ * Absolute error (* = relative error):
+ * arithmetic function # trials peak rms
+ * IEEE sn 10000 1.7e-18 2.3e-19
+ * IEEE cn 20000 1.6e-18 2.2e-19
+ * IEEE dn 10000 4.7e-15 2.7e-17
+ * IEEE phi 10000 4.0e-19* 6.6e-20*
+ *
+ * Accuracy deteriorates when u is large.
+ *
+ */
+
+/* ellpkl.c
+ *
+ * Complete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double m1, y, ellpkl();
+ *
+ * y = ellpkl( m1 );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ *
+ * pi/2
+ * -
+ * | |
+ * | dt
+ * K(m) = | ------------------
+ * | 2
+ * | | sqrt( 1 - m sin t )
+ * -
+ * 0
+ *
+ * where m = 1 - m1, using the approximation
+ *
+ * P(x) - log x Q(x).
+ *
+ * The argument m1 is used rather than m so that the logarithmic
+ * singularity at m = 1 will be shifted to the origin; this
+ * preserves maximum accuracy.
+ *
+ * K(0) = pi/2.
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 10000 1.1e-19 3.3e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpkl domain x<0, x>1 0.0
+ *
+ */
+
+/* exp10l.c
+ *
+ * Base 10 exponential function, long double precision
+ * (Common antilogarithm)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, exp10l()
+ *
+ * y = exp10l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns 10 raised to the x power.
+ *
+ * Range reduction is accomplished by expressing the argument
+ * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2).
+ * The Pade' form
+ *
+ * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ *
+ * is used to approximate 10**f.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-4900 30000 1.0e-19 2.7e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp10l underflow x < -MAXL10 0.0
+ * exp10l overflow x > MAXL10 MAXNUM
+ *
+ * IEEE arithmetic: MAXL10 = 4932.0754489586679023819
+ *
+ */
+
+/* exp2l.c
+ *
+ * Base 2 exponential function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, exp2l();
+ *
+ * y = exp2l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns 2 raised to the x power.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ * x k f
+ * 2 = 2 2.
+ *
+ * A Pade' form
+ *
+ * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) )
+ *
+ * approximates 2**x in the basic range [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-16300 300000 9.1e-20 2.6e-20
+ *
+ *
+ * See exp.c for comments on error amplification.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp2l underflow x < -16382 0.0
+ * exp2l overflow x >= 16384 MAXNUM
+ *
+ */
+
+/* expl.c
+ *
+ * Exponential function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, expl();
+ *
+ * y = expl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns e (2.71828...) raised to the x power.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ *
+ * x k f
+ * e = 2 e.
+ *
+ * A Pade' form of degree 2/3 is used to approximate exp(f) - 1
+ * in the basic range [-0.5 ln 2, 0.5 ln 2].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-10000 50000 1.12e-19 2.81e-20
+ *
+ *
+ * Error amplification in the exponential function can be
+ * a serious matter. The error propagation involves
+ * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ),
+ * which shows that a 1 lsb error in representing X produces
+ * a relative error of X times 1 lsb in the function.
+ * While the routine gives an accurate result for arguments
+ * that are exactly represented by a long double precision
+ * computer number, the result contains amplified roundoff
+ * error for large arguments not exactly represented.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp underflow x < MINLOG 0.0
+ * exp overflow x > MAXLOG MAXNUM
+ *
+ */
+
+/* fabsl.c
+ *
+ * Absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y;
+ *
+ * y = fabsl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the absolute value of the argument.
+ *
+ */
+
+/* fdtrl.c
+ *
+ * F distribution, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, y, fdtrl();
+ *
+ * y = fdtrl( df1, df2, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the F density
+ * function (also known as Snedcor's density or the
+ * variance ratio density). This is the density
+ * of x = (u1/df1)/(u2/df2), where u1 and u2 are random
+ * variables having Chi square distributions with df1
+ * and df2 degrees of freedom, respectively.
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbetl( df1/2, df2/2, (df1*x/(df2 + df1*x) ).
+ *
+ *
+ * The arguments a and b are greater than zero, and x
+ * x is nonnegative.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) in the indicated intervals.
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 1,100 10000 9.3e-18 2.9e-19
+ * IEEE 0,1 1,10000 10000 1.9e-14 2.9e-15
+ * IEEE 1,5 1,10000 10000 5.8e-15 1.4e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrl domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtrcl()
+ *
+ * Complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, y, fdtrcl();
+ *
+ * y = fdtrcl( df1, df2, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from x to infinity under the F density
+ * function (also known as Snedcor's density or the
+ * variance ratio density).
+ *
+ *
+ * inf.
+ * -
+ * 1 | | a-1 b-1
+ * 1-P(x) = ------ | t (1-t) dt
+ * B(a,b) | |
+ * -
+ * x
+ *
+ * (See fdtr.c.)
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ * Tested at random points (a,b,x).
+ *
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 0,100 10000 4.2e-18 3.3e-19
+ * IEEE 0,1 1,10000 10000 7.2e-15 2.6e-16
+ * IEEE 1,5 1,10000 10000 1.7e-14 3.0e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrcl domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtril()
+ *
+ * Inverse of complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, p, fdtril();
+ *
+ * x = fdtril( df1, df2, p );
+ *
+ * DESCRIPTION:
+ *
+ * Finds the F density argument x such that the integral
+ * from x to infinity of the F density is equal to the
+ * given probability p.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relations
+ *
+ * z = incbi( df2/2, df1/2, p )
+ * x = df2 (1-z) / (df1 z).
+ *
+ * Note: the following relations hold for the inverse of
+ * the uncomplemented F distribution:
+ *
+ * z = incbi( df1/2, df2/2, p )
+ * x = df2 z / (df1 (1-z)).
+ *
+ * ACCURACY:
+ *
+ * See incbi.c.
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between .001 and 1:
+ * IEEE 1,100 40000 4.6e-18 2.7e-19
+ * IEEE 1,10000 30000 1.7e-14 1.4e-16
+ * For p between 10^-6 and .001:
+ * IEEE 1,100 20000 1.9e-15 3.9e-17
+ * IEEE 1,10000 30000 2.7e-15 4.0e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtril domain p <= 0 or p > 1 0.0
+ * v < 1
+ */
+
+/* ceill()
+ * floorl()
+ * frexpl()
+ * ldexpl()
+ * fabsl()
+ *
+ * Floating point numeric utilities
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y;
+ * long double ceill(), floorl(), frexpl(), ldexpl(), fabsl();
+ * int expnt, n;
+ *
+ * y = floorl(x);
+ * y = ceill(x);
+ * y = frexpl( x, &expnt );
+ * y = ldexpl( x, n );
+ * y = fabsl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * All four routines return a long double precision floating point
+ * result.
+ *
+ * floorl() returns the largest integer less than or equal to x.
+ * It truncates toward minus infinity.
+ *
+ * ceill() returns the smallest integer greater than or equal
+ * to x. It truncates toward plus infinity.
+ *
+ * frexpl() extracts the exponent from x. It returns an integer
+ * power of two to expnt and the significand between 0.5 and 1
+ * to y. Thus x = y * 2**expn.
+ *
+ * ldexpl() multiplies x by 2**n.
+ *
+ * fabsl() returns the absolute value of its argument.
+ *
+ * These functions are part of the standard C run time library
+ * for some but not all C compilers. The ones supplied are
+ * written in C for IEEE arithmetic. They should
+ * be used only if your compiler library does not already have
+ * them.
+ *
+ * The IEEE versions assume that denormal numbers are implemented
+ * in the arithmetic. Some modifications will be required if
+ * the arithmetic has abrupt rather than gradual underflow.
+ */
+
+/* gammal.c
+ *
+ * Gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, gammal();
+ * extern int sgngam;
+ *
+ * y = gammal( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns gamma function of the argument. The result is
+ * correctly signed, and the sign (+1 or -1) is also
+ * returned in a global (extern) variable named sgngam.
+ * This variable is also filled in by the logarithmic gamma
+ * function lgam().
+ *
+ * Arguments |x| <= 13 are reduced by recurrence and the function
+ * approximated by a rational function of degree 7/8 in the
+ * interval (2,3). Large arguments are handled by Stirling's
+ * formula. Large negative arguments are made positive using
+ * a reflection formula.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -40,+40 10000 3.6e-19 7.9e-20
+ * IEEE -1755,+1755 10000 4.8e-18 6.5e-19
+ *
+ * Accuracy for large arguments is dominated by error in powl().
+ *
+ */
+/* lgaml()
+ *
+ * Natural logarithm of gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, lgaml();
+ * extern int sgngam;
+ *
+ * y = lgaml( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of the absolute
+ * value of the gamma function of the argument.
+ * The sign (+1 or -1) of the gamma function is returned in a
+ * global (extern) variable named sgngam.
+ *
+ * For arguments greater than 33, the logarithm of the gamma
+ * function is approximated by the logarithmic version of
+ * Stirling's formula using a polynomial approximation of
+ * degree 4. Arguments between -33 and +33 are reduced by
+ * recurrence to the interval [2,3] of a rational approximation.
+ * The cosecant reflection formula is employed for arguments
+ * less than -33.
+ *
+ * Arguments greater than MAXLGML (10^4928) return MAXNUML.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE -40, 40 100000 2.2e-19 4.6e-20
+ * IEEE 10^-2000,10^+2000 20000 1.6e-19 3.3e-20
+ * The error criterion was relative when the function magnitude
+ * was greater than one but absolute when it was less than one.
+ *
+ */
+
+/* gdtrl.c
+ *
+ * Gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, gdtrl();
+ *
+ * y = gdtrl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the integral from zero to x of the gamma probability
+ * density function:
+ *
+ *
+ * x
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * 0
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = igam( b, ax ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrl domain x < 0 0.0
+ *
+ */
+ /* gdtrcl.c
+ *
+ * Complemented gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, gdtrcl();
+ *
+ * y = gdtrcl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the integral from x to infinity of the gamma
+ * probability density function:
+ *
+ *
+ * inf.
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * x
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = igamc( b, ax ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrcl domain x < 0 0.0
+ *
+ */
+
+/*
+C
+C ..................................................................
+C
+C SUBROUTINE GELS
+C
+C PURPOSE
+C TO SOLVE A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH
+C SYMMETRIC COEFFICIENT MATRIX UPPER TRIANGULAR PART OF WHICH
+C IS ASSUMED TO BE STORED COLUMNWISE.
+C
+C USAGE
+C CALL GELS(R,A,M,N,EPS,IER,AUX)
+C
+C DESCRIPTION OF PARAMETERS
+C R - M BY N RIGHT HAND SIDE MATRIX. (DESTROYED)
+C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS.
+C A - UPPER TRIANGULAR PART OF THE SYMMETRIC
+C M BY M COEFFICIENT MATRIX. (DESTROYED)
+C M - THE NUMBER OF EQUATIONS IN THE SYSTEM.
+C N - THE NUMBER OF RIGHT HAND SIDE VECTORS.
+C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE
+C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE.
+C IER - RESULTING ERROR PARAMETER CODED AS FOLLOWS
+C IER=0 - NO ERROR,
+C IER=-1 - NO RESULT BECAUSE OF M LESS THAN 1 OR
+C PIVOT ELEMENT AT ANY ELIMINATION STEP
+C EQUAL TO 0,
+C IER=K - WARNING DUE TO POSSIBLE LOSS OF SIGNIFI-
+C CANCE INDICATED AT ELIMINATION STEP K+1,
+C WHERE PIVOT ELEMENT WAS LESS THAN OR
+C EQUAL TO THE INTERNAL TOLERANCE EPS TIMES
+C ABSOLUTELY GREATEST MAIN DIAGONAL
+C ELEMENT OF MATRIX A.
+C AUX - AN AUXILIARY STORAGE ARRAY WITH DIMENSION M-1.
+C
+C REMARKS
+C UPPER TRIANGULAR PART OF MATRIX A IS ASSUMED TO BE STORED
+C COLUMNWISE IN M*(M+1)/2 SUCCESSIVE STORAGE LOCATIONS, RIGHT
+C HAND SIDE MATRIX R COLUMNWISE IN N*M SUCCESSIVE STORAGE
+C LOCATIONS. ON RETURN SOLUTION MATRIX R IS STORED COLUMNWISE
+C TOO.
+C THE PROCEDURE GIVES RESULTS IF THE NUMBER OF EQUATIONS M IS
+C GREATER THAN 0 AND PIVOT ELEMENTS AT ALL ELIMINATION STEPS
+C ARE DIFFERENT FROM 0. HOWEVER WARNING IER=K - IF GIVEN -
+C INDICATES POSSIBLE LOSS OF SIGNIFICANCE. IN CASE OF A WELL
+C SCALED MATRIX A AND APPROPRIATE TOLERANCE EPS, IER=K MAY BE
+C INTERPRETED THAT MATRIX A HAS THE RANK K. NO WARNING IS
+C GIVEN IN CASE M=1.
+C ERROR PARAMETER IER=-1 DOES NOT NECESSARILY MEAN THAT
+C MATRIX A IS SINGULAR, AS ONLY MAIN DIAGONAL ELEMENTS
+C ARE USED AS PIVOT ELEMENTS. POSSIBLY SUBROUTINE GELG (WHICH
+C WORKS WITH TOTAL PIVOTING) WOULD BE ABLE TO FIND A SOLUTION.
+C
+C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C NONE
+C
+C METHOD
+C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH
+C PIVOTING IN MAIN DIAGONAL, IN ORDER TO PRESERVE
+C SYMMETRY IN REMAINING COEFFICIENT MATRICES.
+C
+C ..................................................................
+C
+*/
+
+/* igamil()
+ *
+ * Inverse of complemented imcomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igamil();
+ *
+ * x = igamil( a, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * igamc( a, x ) = y.
+ *
+ * Starting with the approximate value
+ *
+ * 3
+ * x = a t
+ *
+ * where
+ *
+ * t = 1 - d - ndtri(y) sqrt(d)
+ *
+ * and
+ *
+ * d = 1/9a,
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of igamc(a,x) - y = 0.
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested for a ranging from 0.5 to 30 and x from 0 to 0.5.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,0.5 3400 8.8e-16 1.3e-16
+ * IEEE 0,0.5 10000 1.1e-14 1.0e-15
+ *
+ */
+
+/* igaml.c
+ *
+ * Incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igaml();
+ *
+ * y = igaml( a, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The function is defined by
+ *
+ * x
+ * -
+ * 1 | | -t a-1
+ * igam(a,x) = ----- | e t dt.
+ * - | |
+ * | (a) -
+ * 0
+ *
+ *
+ * In this implementation both arguments must be positive.
+ * The integral is evaluated by either a power series or
+ * continued fraction expansion, depending on the relative
+ * values of a and x.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 4000 4.4e-15 6.3e-16
+ * IEEE 0,30 10000 3.6e-14 5.1e-15
+ *
+ */
+ /* igamcl()
+ *
+ * Complemented incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igamcl();
+ *
+ * y = igamcl( a, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The function is defined by
+ *
+ *
+ * igamc(a,x) = 1 - igam(a,x)
+ *
+ * inf.
+ * -
+ * 1 | | -t a-1
+ * = ----- | e t dt.
+ * - | |
+ * | (a) -
+ * x
+ *
+ *
+ * In this implementation both arguments must be positive.
+ * The integral is evaluated by either a power series or
+ * continued fraction expansion, depending on the relative
+ * values of a and x.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2000 2.7e-15 4.0e-16
+ * IEEE 0,30 60000 1.4e-12 6.3e-15
+ *
+ */
+
+/* incbetl.c
+ *
+ * Incomplete beta integral
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, incbetl();
+ *
+ * y = incbetl( a, b, x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns incomplete beta integral of the arguments, evaluated
+ * from zero to x. The function is defined as
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * ----------- | t (1-t) dt.
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ * The domain of definition is 0 <= x <= 1. In this
+ * implementation a and b are restricted to positive values.
+ * The integral from x to 1 may be obtained by the symmetry
+ * relation
+ *
+ * 1 - incbet( a, b, x ) = incbet( b, a, 1-x ).
+ *
+ * The integral is evaluated by a continued fraction expansion
+ * or, when b*x is small, by a power series.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) with x between 0 and 1.
+ * arithmetic domain # trials peak rms
+ * IEEE 0,5 20000 4.5e-18 2.4e-19
+ * IEEE 0,100 100000 3.9e-17 1.0e-17
+ * Half-integer a, b:
+ * IEEE .5,10000 100000 3.9e-14 4.4e-15
+ * Outputs smaller than the IEEE gradual underflow threshold
+ * were excluded from these statistics.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * incbetl domain x<0, x>1 0.0
+ */
+
+/* incbil()
+ *
+ * Inverse of imcomplete beta integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, incbil();
+ *
+ * x = incbil( a, b, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * incbet( a, b, x ) = y.
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of incbet(a,b,x) - y = 0.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * x a,b
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 .5,10000 10000 1.1e-14 1.4e-16
+ */
+
+/* j0l.c
+ *
+ * Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, j0l();
+ *
+ * y = j0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of first kind, order zero of the argument.
+ *
+ * The domain is divided into the intervals [0, 9] and
+ * (9, infinity). In the first interval the rational approximation
+ * is (x^2 - r^2) (x^2 - s^2) (x^2 - t^2) P7(x^2) / Q8(x^2),
+ * where r, s, t are the first three zeros of the function.
+ * In the second interval the expansion is in terms of the
+ * modulus M0(x) = sqrt(J0(x)^2 + Y0(x)^2) and phase P0(x)
+ * = atan(Y0(x)/J0(x)). M0 is approximated by sqrt(1/x)P7(1/x)/Q7(1/x).
+ * The approximation to J0 is M0 * cos(x - pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)).
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 100000 2.8e-19 7.4e-20
+ *
+ *
+ */
+ /* y0l.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0l();
+ *
+ * y = y0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5>, [5,9> and
+ * [9, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute y0(x) = R(x) + 2/pi * log(x) * j0(x).
+ *
+ * In the second interval, the approximation is
+ * (x - p)(x - q)(x - r)(x - s)P7(x)/Q7(x)
+ * where p, q, r, s are zeros of y0(x).
+ *
+ * The third interval uses the same approximations to modulus
+ * and phase as j0(x), whence y0(x) = modulus * sin(phase).
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 100000 3.4e-19 7.6e-20
+ *
+ */
+
+/* j1l.c
+ *
+ * Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, j1l();
+ *
+ * y = j1l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order one of the argument.
+ *
+ * The domain is divided into the intervals [0, 9] and
+ * (9, infinity). In the first interval the rational approximation
+ * is (x^2 - r^2) (x^2 - s^2) (x^2 - t^2) x P8(x^2) / Q8(x^2),
+ * where r, s, t are the first three zeros of the function.
+ * In the second interval the expansion is in terms of the
+ * modulus M1(x) = sqrt(J1(x)^2 + Y1(x)^2) and phase P1(x)
+ * = atan(Y1(x)/J1(x)). M1 is approximated by sqrt(1/x)P7(1/x)/Q8(1/x).
+ * The approximation to j1 is M1 * cos(x - 3 pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)).
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 40000 1.8e-19 5.0e-20
+ *
+ *
+ */
+ /* y1l.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y1l();
+ *
+ * y = y1l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 4.5>, [4.5,9> and
+ * [9, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute y0(x) = R(x) + 2/pi * log(x) * j0(x).
+ *
+ * In the second interval, the approximation is
+ * (x - p)(x - q)(x - r)(x - s)P9(x)/Q10(x)
+ * where p, q, r, s are zeros of y1(x).
+ *
+ * The third interval uses the same approximations to modulus
+ * and phase as j1(x), whence y1(x) = modulus * sin(phase).
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 36000 2.7e-19 5.3e-20
+ *
+ */
+
+/* jnl.c
+ *
+ * Bessel function of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * long double x, y, jnl();
+ *
+ * y = jnl( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The ratio of jn(x) to j0(x) is computed by backward
+ * recurrence. First the ratio jn/jn-1 is found by a
+ * continued fraction expansion. Then the recurrence
+ * relating successive orders is applied until j0 or j1 is
+ * reached.
+ *
+ * If n = 0 or 1 the routine for j0 or j1 is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE -30, 30 5000 3.3e-19 4.7e-20
+ *
+ *
+ * Not suitable for large n or x.
+ *
+ */
+
+/* ldrand.c
+ *
+ * Pseudorandom number generator
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double y;
+ * int ldrand();
+ *
+ * ldrand( &y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Yields a random number 1.0 <= y < 2.0.
+ *
+ * The three-generator congruential algorithm by Brian
+ * Wichmann and David Hill (BYTE magazine, March, 1987,
+ * pp 127-8) is used.
+ *
+ * Versions invoked by the different arithmetic compile
+ * time options IBMPC, and MIEEE, produce the same sequences.
+ *
+ */
+
+/* log10l.c
+ *
+ * Common logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log10l();
+ *
+ * y = log10l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 10 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20
+ * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns MINLOG
+ * log domain: x < 0; returns MINLOG
+ */
+
+/* log2l.c
+ *
+ * Base 2 logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log2l();
+ *
+ * y = log2l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 2 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the (natural)
+ * logarithm of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20
+ * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns MINLOG
+ * log domain: x < 0; returns MINLOG
+ */
+
+/* logl.c
+ *
+ * Natural logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, logl();
+ *
+ * y = logl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20
+ * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns MINLOG
+ * log domain: x < 0; returns MINLOG
+ */
+
+/* mtherr.c
+ *
+ * Library common error handling routine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * char *fctnam;
+ * int code;
+ * int mtherr();
+ *
+ * mtherr( fctnam, code );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This routine may be called to report one of the following
+ * error conditions (in the include file mconf.h).
+ *
+ * Mnemonic Value Significance
+ *
+ * DOMAIN 1 argument domain error
+ * SING 2 function singularity
+ * OVERFLOW 3 overflow range error
+ * UNDERFLOW 4 underflow range error
+ * TLOSS 5 total loss of precision
+ * PLOSS 6 partial loss of precision
+ * EDOM 33 Unix domain error code
+ * ERANGE 34 Unix range error code
+ *
+ * The default version of the file prints the function name,
+ * passed to it by the pointer fctnam, followed by the
+ * error condition. The display is directed to the standard
+ * output device. The routine then returns to the calling
+ * program. Users may wish to modify the program to abort by
+ * calling exit() under severe error conditions such as domain
+ * errors.
+ *
+ * Since all error conditions pass control to this function,
+ * the display may be easily changed, eliminated, or directed
+ * to an error logging device.
+ *
+ * SEE ALSO:
+ *
+ * mconf.h
+ *
+ */
+
+/* nbdtrl.c
+ *
+ * Negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtrl();
+ *
+ * y = nbdtrl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms 0 through k of the negative
+ * binomial distribution:
+ *
+ * k
+ * -- ( n+j-1 ) n j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * In a sequence of Bernoulli trials, this is the probability
+ * that k or fewer failures precede the nth success.
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = nbdtr( k, n, p ) = incbet( n, k+1, p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (k,n,p) with k and n between 1 and 10,000
+ * and p between 0 and 1.
+ *
+ * arithmetic domain # trials peak rms
+ * Absolute error:
+ * IEEE 0,10000 10000 9.8e-15 2.1e-16
+ *
+ */
+ /* nbdtrcl.c
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtrcl();
+ *
+ * y = nbdtrcl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 to infinity of the negative
+ * binomial distribution:
+ *
+ * inf
+ * -- ( n+j-1 ) n j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=k+1
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbetl.c.
+ *
+ */
+ /* nbdtril
+ *
+ * Functional inverse of negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtril();
+ *
+ * p = nbdtril( k, n, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the argument p such that nbdtr(k,n,p) is equal to y.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,y), with y between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100
+ * See also incbil.c.
+ */
+
+/* ndtril.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ndtril();
+ *
+ * x = ndtril( y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the argument, x, for which the area under the
+ * Gaussian probability density function (integrated from
+ * minus infinity to x) is equal to y.
+ *
+ *
+ * For small arguments 0 < y < exp(-2), the program computes
+ * z = sqrt( -2 log(y) ); then the approximation is
+ * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z) .
+ * For larger arguments, x/sqrt(2 pi) = w + w^3 R(w^2)/S(w^2)) ,
+ * where w = y - 0.5 .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * Arguments uniformly distributed:
+ * IEEE 0, 1 5000 7.8e-19 9.9e-20
+ * Arguments exponentially distributed:
+ * IEEE exp(-11355),-1 30000 1.7e-19 4.3e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtril domain x <= 0 -MAXNUML
+ * ndtril domain x >= 1 MAXNUML
+ *
+ */
+
+/* ndtril.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ndtril();
+ *
+ * x = ndtril( y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the argument, x, for which the area under the
+ * Gaussian probability density function (integrated from
+ * minus infinity to x) is equal to y.
+ *
+ *
+ * For small arguments 0 < y < exp(-2), the program computes
+ * z = sqrt( -2 log(y) ); then the approximation is
+ * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z) .
+ * For larger arguments, x/sqrt(2 pi) = w + w^3 R(w^2)/S(w^2)) ,
+ * where w = y - 0.5 .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * Arguments uniformly distributed:
+ * IEEE 0, 1 5000 7.8e-19 9.9e-20
+ * Arguments exponentially distributed:
+ * IEEE exp(-11355),-1 30000 1.7e-19 4.3e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtril domain x <= 0 -MAXNUML
+ * ndtril domain x >= 1 MAXNUML
+ *
+ */
+
+/* pdtrl.c
+ *
+ * Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrl();
+ *
+ * y = pdtrl( k, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the first k terms of the Poisson
+ * distribution:
+ *
+ * k j
+ * -- -m m
+ * > e --
+ * -- j!
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the relation
+ *
+ * y = pdtr( k, m ) = igamc( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ */
+ /* pdtrcl()
+ *
+ * Complemented poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrcl();
+ *
+ * y = pdtrcl( k, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 to infinity of the Poisson
+ * distribution:
+ *
+ * inf. j
+ * -- -m m
+ * > e --
+ * -- j!
+ * j=k+1
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the formula
+ *
+ * y = pdtrc( k, m ) = igam( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam.c.
+ *
+ */
+ /* pdtril()
+ *
+ * Inverse Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrl();
+ *
+ * m = pdtril( k, y );
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the Poisson variable x such that the integral
+ * from 0 to x of the Poisson density is equal to the
+ * given probability y.
+ *
+ * This is accomplished using the inverse gamma integral
+ * function and the relation
+ *
+ * m = igami( k+1, y ).
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pdtri domain y < 0 or y >= 1 0.0
+ * k < 0
+ *
+ */
+
+/* polevll.c
+ * p1evll.c
+ *
+ * Evaluate polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * long double x, y, coef[N+1], polevl[];
+ *
+ * y = polevll( x, coef, N );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates polynomial of degree N:
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N] = C .
+ * N 0
+ *
+ * The function p1evll() assumes that coef[N] = 1.0 and is
+ * omitted from the array. Its calling arguments are
+ * otherwise the same as polevll().
+ *
+ * This module also contains the following globally declared constants:
+ * MAXNUML = 1.189731495357231765021263853E4932L;
+ * MACHEPL = 5.42101086242752217003726400434970855712890625E-20L;
+ * MAXLOGL = 1.1356523406294143949492E4L;
+ * MINLOGL = -1.1355137111933024058873E4L;
+ * LOGE2L = 6.9314718055994530941723E-1L;
+ * LOG2EL = 1.4426950408889634073599E0L;
+ * PIL = 3.1415926535897932384626L;
+ * PIO2L = 1.5707963267948966192313L;
+ * PIO4L = 7.8539816339744830961566E-1L;
+ *
+ * SPEED:
+ *
+ * In the interest of speed, there are no checks for out
+ * of bounds arithmetic. This routine is used by most of
+ * the functions in the library. Depending on available
+ * equipment features, the user may wish to rewrite the
+ * program in microcode or assembly language.
+ *
+ */
+
+/* powil.c
+ *
+ * Real raised to integer power, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, powil();
+ * int n;
+ *
+ * y = powil( x, n );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns argument x raised to the nth power.
+ * The routine efficiently decomposes n as a sum of powers of
+ * two. The desired power is a product of two-to-the-kth
+ * powers of x. Thus to compute the 32767 power of x requires
+ * 28 multiplications instead of 32767 multiplications.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error:
+ * arithmetic x domain n domain # trials peak rms
+ * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18
+ * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18
+ * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17
+ *
+ * Returns MAXNUM on overflow, zero on underflow.
+ *
+ */
+
+/* powl.c
+ *
+ * Power function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, z, powl();
+ *
+ * z = powl( x, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes x raised to the yth power. Analytically,
+ *
+ * x**y = exp( y log(x) ).
+ *
+ * Following Cody and Waite, this program uses a lookup table
+ * of 2**-i/32 and pseudo extended precision arithmetic to
+ * obtain several extra bits of accuracy in both the logarithm
+ * and the exponential.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * The relative error of pow(x,y) can be estimated
+ * by y dl ln(2), where dl is the absolute error of
+ * the internally computed base 2 logarithm. At the ends
+ * of the approximation interval the logarithm equal 1/32
+ * and its relative error is about 1 lsb = 1.1e-19. Hence
+ * the predicted relative error in the result is 2.3e-21 y .
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ *
+ * IEEE +-1000 40000 2.8e-18 3.7e-19
+ * .001 < x < 1000, with log(x) uniformly distributed.
+ * -1000 < y < 1000, y uniformly distributed.
+ *
+ * IEEE 0,8700 60000 6.5e-18 1.0e-18
+ * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pow overflow x**y > MAXNUM MAXNUM
+ * pow underflow x**y < 1/MAXNUM 0.0
+ * pow domain x<0 and y noninteger 0.0
+ *
+ */
+
+/* sinhl.c
+ *
+ * Hyperbolic sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sinhl();
+ *
+ * y = sinhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic sine of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * The range is partitioned into two segments. If |x| <= 1, a
+ * rational function of the form x + x**3 P(x)/Q(x) is employed.
+ * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -2,2 10000 1.5e-19 3.9e-20
+ * IEEE +-10000 30000 1.1e-19 2.8e-20
+ *
+ */
+
+/* sinl.c
+ *
+ * Circular sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sinl();
+ *
+ * y = sinl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Range reduction is into intervals of pi/4. The reduction
+ * error is nearly eliminated by contriving an extended precision
+ * modular arithmetic.
+ *
+ * Two polynomial approximating functions are employed.
+ * Between 0 and pi/4 the sine is approximated by the Cody
+ * and Waite polynomial form
+ * x + x**3 P(x**2) .
+ * Between pi/4 and pi/2 the cosine is represented as
+ * 1 - .5 x**2 + x**4 Q(x**2) .
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-5.5e11 200,000 1.2e-19 2.9e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sin total loss x > 2**39 0.0
+ *
+ * Loss of precision occurs for x > 2**39 = 5.49755813888e11.
+ * The routine as implemented flags a TLOSS error for
+ * x > 2**39 and returns 0.0.
+ */
+ /* cosl.c
+ *
+ * Circular cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cosl();
+ *
+ * y = cosl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Range reduction is into intervals of pi/4. The reduction
+ * error is nearly eliminated by contriving an extended precision
+ * modular arithmetic.
+ *
+ * Two polynomial approximating functions are employed.
+ * Between 0 and pi/4 the cosine is approximated by
+ * 1 - .5 x**2 + x**4 Q(x**2) .
+ * Between pi/4 and pi/2 the sine is represented by the Cody
+ * and Waite polynomial form
+ * x + x**3 P(x**2) .
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-5.5e11 50000 1.2e-19 2.9e-20
+ */
+
+/* sqrtl.c
+ *
+ * Square root, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sqrtl();
+ *
+ * y = sqrtl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the square root of x.
+ *
+ * Range reduction involves isolating the power of two of the
+ * argument and using a polynomial approximation to obtain
+ * a rough value for the square root. Then Heron's iteration
+ * is used three times to converge to an accurate value.
+ *
+ * Note, some arithmetic coprocessors such as the 8087 and
+ * 68881 produce correctly rounded square roots, which this
+ * routine will not.
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,10 30000 8.1e-20 3.1e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sqrt domain x < 0 0.0
+ *
+ */
+
+/* stdtrl.c
+ *
+ * Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double p, t, stdtrl();
+ * int k;
+ *
+ * p = stdtrl( k, t );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes the integral from minus infinity to t of the Student
+ * t distribution with integer k > 0 degrees of freedom:
+ *
+ * t
+ * -
+ * | |
+ * - | 2 -(k+1)/2
+ * | ( (k+1)/2 ) | ( x )
+ * ---------------------- | ( 1 + --- ) dx
+ * - | ( k )
+ * sqrt( k pi ) | ( k/2 ) |
+ * | |
+ * -
+ * -inf.
+ *
+ * Relation to incomplete beta integral:
+ *
+ * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z )
+ * where
+ * z = k/(k + t**2).
+ *
+ * For t < -1.6, this is the method of computation. For higher t,
+ * a direct method is derived from integration by parts.
+ * Since the function is symmetric about t=0, the area under the
+ * right tail of the density is found by calling the function
+ * with -t instead of t.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to t.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -100,-1.6 10000 5.7e-18 9.8e-19
+ * IEEE -1.6,100 10000 3.8e-18 1.0e-19
+ */
+
+/* stdtril.c
+ *
+ * Functional inverse of Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double p, t, stdtril();
+ * int k;
+ *
+ * t = stdtril( k, p );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given probability p, finds the argument t such that stdtrl(k,t)
+ * is equal to p.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 3500 4.2e-17 4.1e-18
+ */
+
+/* tanhl.c
+ *
+ * Hyperbolic tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, tanhl();
+ *
+ * y = tanhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic tangent of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * A rational function is used for |x| < 0.625. The form
+ * x + x**3 P(x)/Q(x) of Cody _& Waite is employed.
+ * Otherwise,
+ * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -2,2 30000 1.3e-19 2.4e-20
+ *
+ */
+
+/* tanl.c
+ *
+ * Circular tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, tanl();
+ *
+ * y = tanl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 1.9e-19 4.8e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tan total loss x > 2^39 0.0
+ *
+ */
+ /* cotl.c
+ *
+ * Circular cotangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cotl();
+ *
+ * y = cotl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 1.9e-19 5.1e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cot total loss x > 2^39 0.0
+ * cot singularity x = 0 MAXNUM
+ *
+ */
+
+/* unityl.c
+ *
+ * Relative error approximations for function arguments near
+ * unity.
+ *
+ * log1p(x) = log(1+x)
+ * expm1(x) = exp(x) - 1
+ * cos1m(x) = cos(x) - 1
+ *
+ */
+
+/* ynl.c
+ *
+ * Bessel function of second kind of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ynl();
+ * int n;
+ *
+ * y = ynl( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The function is evaluated by forward recurrence on
+ * n, starting with values computed by the routines
+ * y0l() and y1l().
+ *
+ * If n = 0 or 1 the routine for y0l or y1l is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * Absolute error, except relative error when y > 1.
+ * x >= 0, -30 <= n <= +30.
+ * arithmetic domain # trials peak rms
+ * IEEE -30, 30 10000 1.3e-18 1.8e-19
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ynl singularity x = 0 MAXNUML
+ * ynl overflow MAXNUML
+ *
+ * Spot checked against tables for x, n between 0 and 100.
+ *
+ */
diff --git a/libm/ldouble/acoshl.c b/libm/ldouble/acoshl.c
new file mode 100644
index 000000000..96c46bf22
--- /dev/null
+++ b/libm/ldouble/acoshl.c
@@ -0,0 +1,167 @@
+/* acoshl.c
+ *
+ * Inverse hyperbolic cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, acoshl();
+ *
+ * y = acoshl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic cosine of argument.
+ *
+ * If 1 <= x < 1.5, a rational approximation
+ *
+ * sqrt(2z) * P(z)/Q(z)
+ *
+ * where z = x-1, is used. Otherwise,
+ *
+ * acosh(x) = log( x + sqrt( (x-1)(x+1) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 1,3 30000 2.0e-19 3.9e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acoshl domain |x| < 1 0.0
+ *
+ */
+
+/* acosh.c */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+
+/* acosh(1+x) = sqrt(2x) * R(x), interval 0 < x < 0.5 */
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 2.9071989653343333587238E-5L,
+ 3.2906030801088967279449E-3L,
+ 6.3034445964862182128388E-2L,
+ 4.1587081802731351459504E-1L,
+ 1.0989714347599256302467E0L,
+ 9.9999999999999999999715E-1L,
+};
+static long double Q[] = {
+ 1.0443462486787584738322E-4L,
+ 6.0085845375571145826908E-3L,
+ 8.7750439986662958343370E-2L,
+ 4.9564621536841869854584E-1L,
+ 1.1823047680932589605190E0L,
+ 1.0000000000000000000028E0L,
+};
+#endif
+
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x4536,0x4dba,0x9f55,0xf3df,0x3fef, XPD
+0x23a5,0xf9aa,0x289c,0xd7a7,0x3ff6, XPD
+0x7e8b,0x8645,0x341f,0x8118,0x3ffb, XPD
+0x0fd5,0x937f,0x0515,0xd4ed,0x3ffd, XPD
+0x2364,0xc41b,0x1891,0x8cab,0x3fff, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+static short Q[] = {
+0x1e7c,0x4f16,0xe98c,0xdb03,0x3ff1, XPD
+0xc319,0xc272,0xa90a,0xc4e3,0x3ff7, XPD
+0x2f83,0x9e5e,0x80af,0xb3b6,0x3ffb, XPD
+0xe1e0,0xc97c,0x573a,0xfdc5,0x3ffd, XPD
+0xcdf2,0x6ec5,0xc33c,0x9755,0x3fff, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3fef0000,0xf3df9f55,0x4dba4536,
+0x3ff60000,0xd7a7289c,0xf9aa23a5,
+0x3ffb0000,0x8118341f,0x86457e8b,
+0x3ffd0000,0xd4ed0515,0x937f0fd5,
+0x3fff0000,0x8cab1891,0xc41b2364,
+0x3fff0000,0x80000000,0x00000000,
+};
+static long Q[] = {
+0x3ff10000,0xdb03e98c,0x4f161e7c,
+0x3ff70000,0xc4e3a90a,0xc272c319,
+0x3ffb0000,0xb3b680af,0x9e5e2f83,
+0x3ffd0000,0xfdc5573a,0xc97ce1e0,
+0x3fff0000,0x9755c33c,0x6ec5cdf2,
+0x3fff0000,0x80000000,0x00000000,
+};
+#endif
+
+extern long double LOGE2L;
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+#ifdef ANSIPROT
+extern long double logl ( long double );
+extern long double sqrtl ( long double );
+extern long double polevll ( long double, void *, int );
+extern int isnanl ( long double );
+#else
+long double logl(), sqrtl(), polevll(), isnanl();
+#endif
+
+long double acoshl(x)
+long double x;
+{
+long double a, z;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+if( x < 1.0L )
+ {
+ mtherr( "acoshl", DOMAIN );
+#ifdef NANS
+ return(NANL);
+#else
+ return(0.0L);
+#endif
+ }
+
+if( x > 1.0e10 )
+ {
+#ifdef INFINITIES
+ if( x == INFINITYL )
+ return( INFINITYL );
+#endif
+ return( logl(x) + LOGE2L );
+ }
+
+z = x - 1.0L;
+
+if( z < 0.5L )
+ {
+ a = sqrtl(2.0L*z) * (polevll(z, P, 5) / polevll(z, Q, 5) );
+ return( a );
+ }
+
+a = sqrtl( z*(x+1.0L) );
+return( logl(x + a) );
+}
diff --git a/libm/ldouble/arcdotl.c b/libm/ldouble/arcdotl.c
new file mode 100644
index 000000000..952f027c6
--- /dev/null
+++ b/libm/ldouble/arcdotl.c
@@ -0,0 +1,108 @@
+/* arcdot.c
+ *
+ * Angle between two vectors
+ *
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double p[3], q[3], arcdotl();
+ *
+ * y = arcdotl( p, q );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * For two vectors p, q, the angle A between them is given by
+ *
+ * p.q / (|p| |q|) = cos A .
+ *
+ * where "." represents inner product, "|x|" the length of vector x.
+ * If the angle is small, an expression in sin A is preferred.
+ * Set r = q - p. Then
+ *
+ * p.q = p.p + p.r ,
+ *
+ * |p|^2 = p.p ,
+ *
+ * |q|^2 = p.p + 2 p.r + r.r ,
+ *
+ * p.p^2 + 2 p.p p.r + p.r^2
+ * cos^2 A = ----------------------------
+ * p.p (p.p + 2 p.r + r.r)
+ *
+ * p.p + 2 p.r + p.r^2 / p.p
+ * = --------------------------- ,
+ * p.p + 2 p.r + r.r
+ *
+ * sin^2 A = 1 - cos^2 A
+ *
+ * r.r - p.r^2 / p.p
+ * = --------------------
+ * p.p + 2 p.r + r.r
+ *
+ * = (r.r - p.r^2 / p.p) / q.q .
+ *
+ * ACCURACY:
+ *
+ * About 1 ULP. See arcdot.c.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double acosl ( long double );
+extern long double asinl ( long double );
+extern long double atanl ( long double );
+#else
+long double sqrtl(), acosl(), asinl(), atanl();
+#endif
+extern long double PIL;
+
+long double arcdotl(p,q)
+long double p[], q[];
+{
+long double pp, pr, qq, rr, rt, pt, qt, pq;
+int i;
+
+pq = 0.0L;
+qq = 0.0L;
+pp = 0.0L;
+pr = 0.0L;
+rr = 0.0L;
+for (i=0; i<3; i++)
+ {
+ pt = p[i];
+ qt = q[i];
+ pq += pt * qt;
+ qq += qt * qt;
+ pp += pt * pt;
+ rt = qt - pt;
+ pr += pt * rt;
+ rr += rt * rt;
+ }
+if (rr == 0.0L || pp == 0.0L || qq == 0.0L)
+ return 0.0L;
+rt = (rr - (pr * pr) / pp) / qq;
+if (rt <= 0.75L)
+ {
+ rt = sqrtl(rt);
+ qt = asinl(rt);
+ if (pq < 0.0L)
+ qt = PIL - qt;
+ }
+else
+ {
+ pt = pq / sqrtl(pp*qq);
+ qt = acosl(pt);
+ }
+return qt;
+}
diff --git a/libm/ldouble/asinhl.c b/libm/ldouble/asinhl.c
new file mode 100644
index 000000000..025dfc29d
--- /dev/null
+++ b/libm/ldouble/asinhl.c
@@ -0,0 +1,156 @@
+/* asinhl.c
+ *
+ * Inverse hyperbolic sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, asinhl();
+ *
+ * y = asinhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic sine of argument.
+ *
+ * If |x| < 0.5, the function is approximated by a rational
+ * form x + x**3 P(x)/Q(x). Otherwise,
+ *
+ * asinh(x) = log( x + sqrt(1 + x*x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -3,3 30000 1.7e-19 3.5e-20
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+-7.2157234864927687427374E-1L,
+-1.3005588097490352458918E1L,
+-5.9112383795679709212744E1L,
+-9.5372702442289028811361E1L,
+-4.9802880260861844539014E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+ 2.8754968540389640419671E1L,
+ 2.0990255691901160529390E2L,
+ 5.9265075560893800052658E2L,
+ 7.0670399135805956780660E2L,
+ 2.9881728156517107462943E2L,
+};
+#endif
+
+
+#ifdef IBMPC
+static short P[] = {
+0x8f42,0x2584,0xf727,0xb8b8,0xbffe, XPD
+0x9d56,0x7f7c,0xe38b,0xd016,0xc002, XPD
+0xc518,0xdc2d,0x14bc,0xec73,0xc004, XPD
+0x99fe,0xc18a,0xd2da,0xbebe,0xc005, XPD
+0xb46c,0x3c05,0x263e,0xc736,0xc004, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0xdfed,0x33db,0x2cf2,0xe60a,0x4003, XPD
+0xf109,0x61ee,0x0df8,0xd1e7,0x4006, XPD
+0xf21e,0xda84,0xa5fa,0x9429,0x4008, XPD
+0x13fc,0xc4e2,0x0e31,0xb0ad,0x4008, XPD
+0x485c,0xad04,0x9cae,0x9568,0x4007, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0xbffe0000,0xb8b8f727,0x25848f42,
+0xc0020000,0xd016e38b,0x7f7c9d56,
+0xc0040000,0xec7314bc,0xdc2dc518,
+0xc0050000,0xbebed2da,0xc18a99fe,
+0xc0040000,0xc736263e,0x3c05b46c,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40030000,0xe60a2cf2,0x33dbdfed,
+0x40060000,0xd1e70df8,0x61eef109,
+0x40080000,0x9429a5fa,0xda84f21e,
+0x40080000,0xb0ad0e31,0xc4e213fc,
+0x40070000,0x95689cae,0xad04485c,
+};
+#endif
+
+extern long double LOGE2L;
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef ANSIPROT
+extern long double logl ( long double );
+extern long double sqrtl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+extern int isfinitel ( long double );
+#else
+long double logl(), sqrtl(), polevll(), p1evll(), isnanl(), isfinitel();
+#endif
+
+long double asinhl(x)
+long double x;
+{
+long double a, z;
+int sign;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+#ifdef INFINITIES
+ if( !isfinitel(x) )
+ return(x);
+#endif
+if( x < 0.0L )
+ {
+ sign = -1;
+ x = -x;
+ }
+else
+ sign = 1;
+
+if( x > 1.0e10L )
+ {
+ return( sign * (logl(x) + LOGE2L) );
+ }
+
+z = x * x;
+if( x < 0.5L )
+ {
+ a = ( polevll(z, P, 4)/p1evll(z, Q, 5) ) * z;
+ a = a * x + x;
+ if( sign < 0 )
+ a = -a;
+ return(a);
+ }
+
+a = sqrtl( z + 1.0L );
+return( sign * logl(x + a) );
+}
diff --git a/libm/ldouble/asinl.c b/libm/ldouble/asinl.c
new file mode 100644
index 000000000..163f01055
--- /dev/null
+++ b/libm/ldouble/asinl.c
@@ -0,0 +1,249 @@
+/* asinl.c
+ *
+ * Inverse circular sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asinl();
+ *
+ * y = asinl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose sine is x.
+ *
+ * A rational function of the form x + x**3 P(x**2)/Q(x**2)
+ * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is
+ * transformed by the identity
+ *
+ * asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1, 1 30000 2.7e-19 4.8e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asinl domain |x| > 1 NANL
+ *
+ */
+ /* acosl()
+ *
+ * Inverse circular cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acosl();
+ *
+ * y = acosl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose cosine
+ * is x.
+ *
+ * Analytically, acos(x) = pi/2 - asin(x). However if |x| is
+ * near 1, there is cancellation error in subtracting asin(x)
+ * from pi/2. Hence if x < -0.5,
+ *
+ * acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) );
+ *
+ * or if x > +0.5,
+ *
+ * acos(x) = 2.0 * asin( sqrt((1-x)/2) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1, 1 30000 1.4e-19 3.5e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acosl domain |x| > 1 NANL
+ */
+
+/* asin.c */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1990, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 3.7769340062433674871612E-3L,
+-6.1212919176969202969441E-1L,
+ 5.9303993515791417710775E0L,
+-1.8631697621590161441592E1L,
+ 2.3314603132141795720634E1L,
+-1.0087146579384916260197E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+-1.5684335624873146511217E1L,
+ 7.8702951549021104258866E1L,
+-1.7078401170625864261444E2L,
+ 1.6712291455718995937376E2L,
+-6.0522879476309497128868E1L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0x59d1,0x3509,0x7009,0xf786,0x3ff6, XPD
+0xbe97,0x93e6,0x7fab,0x9cb4,0xbffe, XPD
+0x8bf5,0x6810,0xd4dc,0xbdc5,0x4001, XPD
+0x9bd4,0x8d86,0xb77b,0x950d,0xc003, XPD
+0x3b0f,0x9e25,0x4ea5,0xba84,0x4003, XPD
+0xea38,0xc6a9,0xf3cf,0xa164,0xc002, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x1229,0x8516,0x09e9,0xfaf3,0xc002, XPD
+0xb5c3,0xf36f,0xe943,0x9d67,0x4005, XPD
+0xe11a,0xbe0f,0xb4fd,0xaac8,0xc006, XPD
+0x4c69,0x1355,0x7754,0xa71f,0x4006, XPD
+0xded7,0xa9fe,0x6db7,0xf217,0xc004, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ff60000,0xf7867009,0x350959d1,
+0xbffe0000,0x9cb47fab,0x93e6be97,
+0x40010000,0xbdc5d4dc,0x68108bf5,
+0xc0030000,0x950db77b,0x8d869bd4,
+0x40030000,0xba844ea5,0x9e253b0f,
+0xc0020000,0xa164f3cf,0xc6a9ea38,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0020000,0xfaf309e9,0x85161229,
+0x40050000,0x9d67e943,0xf36fb5c3,
+0xc0060000,0xaac8b4fd,0xbe0fe11a,
+0x40060000,0xa71f7754,0x13554c69,
+0xc0040000,0xf2176db7,0xa9feded7,
+};
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+#ifdef ANSIPROT
+extern long double ldexpl ( long double, int );
+extern long double sqrtl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+long double asinl ( long double );
+#else
+long double ldexpl(), sqrtl(), polevll(), p1evll();
+long double asinl();
+#endif
+
+long double asinl(x)
+long double x;
+{
+long double a, p, z, zz;
+short sign, flag;
+extern long double PIO2L;
+
+if( x > 0 )
+ {
+ sign = 1;
+ a = x;
+ }
+else
+ {
+ sign = -1;
+ a = -x;
+ }
+
+if( a > 1.0L )
+ {
+ mtherr( "asinl", DOMAIN );
+#ifdef NANS
+ return( NANL );
+#else
+ return( 0.0L );
+#endif
+ }
+
+if( a < 1.0e-8L )
+ {
+ z = a;
+ goto done;
+ }
+
+if( a > 0.5L )
+ {
+ zz = 0.5L -a;
+ zz = ldexpl( zz + 0.5L, -1 );
+ z = sqrtl( zz );
+ flag = 1;
+ }
+else
+ {
+ z = a;
+ zz = z * z;
+ flag = 0;
+ }
+
+p = zz * polevll( zz, P, 5)/p1evll( zz, Q, 5);
+z = z * p + z;
+if( flag != 0 )
+ {
+ z = z + z;
+ z = PIO2L - z;
+ }
+done:
+if( sign < 0 )
+ z = -z;
+return(z);
+}
+
+
+extern long double PIO2L, PIL;
+
+long double acosl(x)
+long double x;
+{
+
+if( x < -1.0L )
+ goto domerr;
+
+if( x < -0.5L)
+ return( PIL - 2.0L * asinl( sqrtl(0.5L*(1.0L+x)) ) );
+
+if( x > 1.0L )
+ {
+domerr: mtherr( "acosl", DOMAIN );
+#ifdef NANS
+ return( NANL );
+#else
+ return( 0.0L );
+#endif
+ }
+
+if( x > 0.5L )
+ return( 2.0L * asinl( sqrtl(0.5L*(1.0L-x) ) ) );
+
+return( PIO2L - asinl(x) );
+}
diff --git a/libm/ldouble/atanhl.c b/libm/ldouble/atanhl.c
new file mode 100644
index 000000000..3dc7bd2eb
--- /dev/null
+++ b/libm/ldouble/atanhl.c
@@ -0,0 +1,163 @@
+/* atanhl.c
+ *
+ * Inverse hyperbolic tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, atanhl();
+ *
+ * y = atanhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic tangent of argument in the range
+ * MINLOGL to MAXLOGL.
+ *
+ * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
+ * employed. Otherwise,
+ * atanh(x) = 0.5 * log( (1+x)/(1-x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1,1 30000 1.1e-19 3.3e-20
+ *
+ */
+
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright (C) 1987, 1991, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 2.9647757819596835680719E-3L,
+-8.0026596513099094380633E-1L,
+ 7.7920941408493040219831E0L,
+-2.4330686602187898836837E1L,
+ 3.0204265014595622991082E1L,
+-1.2961142942114056581210E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+-1.3729634163247557081869E1L,
+ 6.2320841104088512332185E1L,
+-1.2469344457045341444078E2L,
+ 1.1394285233959210574352E2L,
+-3.8883428826342169425890E1L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0x3aa2,0x036b,0xaf06,0xc24c,0x3ff6, XPD
+0x528e,0x56e8,0x3af4,0xccde,0xbffe, XPD
+0x9d89,0xc9a1,0xd5cf,0xf958,0x4001, XPD
+0xa653,0x6cfa,0x3f04,0xc2a5,0xc003, XPD
+0xc651,0x2b3d,0x55b2,0xf1a2,0x4003, XPD
+0xd76d,0xf293,0xd76b,0xcf60,0xc002, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0xd1b9,0x5314,0x94df,0xdbac,0xc002, XPD
+0x3caa,0x0517,0x8a92,0xf948,0x4004, XPD
+0x535e,0xaf5f,0x0b2a,0xf963,0xc005, XPD
+0xa6f9,0xb702,0xbd8a,0xe3e2,0x4005, XPD
+0xe136,0xf5ee,0xa190,0x9b88,0xc004, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ff60000,0xc24caf06,0x036b3aa2,
+0xbffe0000,0xccde3af4,0x56e8528e,
+0x40010000,0xf958d5cf,0xc9a19d89,
+0xc0030000,0xc2a53f04,0x6cfaa653,
+0x40030000,0xf1a255b2,0x2b3dc651,
+0xc0020000,0xcf60d76b,0xf293d76d,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0020000,0xdbac94df,0x5314d1b9,
+0x40040000,0xf9488a92,0x05173caa,
+0xc0050000,0xf9630b2a,0xaf5f535e,
+0x40050000,0xe3e2bd8a,0xb702a6f9,
+0xc0040000,0x9b88a190,0xf5eee136,
+};
+#endif
+
+extern long double MAXNUML;
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double logl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+#else
+long double fabsl(), logl(), polevll(), p1evll();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double atanhl(x)
+long double x;
+{
+long double s, z;
+
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+z = fabsl(x);
+if( z >= 1.0L )
+ {
+ if( x == 1.0L )
+ {
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ return( MAXNUML );
+#endif
+ }
+ if( x == -1.0L )
+ {
+#ifdef INFINITIES
+ return( -INFINITYL );
+#else
+ return( -MAXNUML );
+#endif
+ }
+ mtherr( "atanhl", DOMAIN );
+#ifdef NANS
+ return( NANL );
+#else
+ return( MAXNUML );
+#endif
+ }
+
+if( z < 1.0e-8L )
+ return(x);
+
+if( z < 0.5L )
+ {
+ z = x * x;
+ s = x + x * z * (polevll(z, P, 5) / p1evll(z, Q, 5));
+ return(s);
+ }
+
+return( 0.5L * logl((1.0L+x)/(1.0L-x)) );
+}
diff --git a/libm/ldouble/atanl.c b/libm/ldouble/atanl.c
new file mode 100644
index 000000000..9e6d9af3c
--- /dev/null
+++ b/libm/ldouble/atanl.c
@@ -0,0 +1,376 @@
+/* atanl.c
+ *
+ * Inverse circular tangent, long double precision
+ * (arctangent)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, atanl();
+ *
+ * y = atanl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose tangent
+ * is x.
+ *
+ * Range reduction is from four intervals into the interval
+ * from zero to tan( pi/8 ). The approximant uses a rational
+ * function of degree 3/4 of the form x + x**3 P(x)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10, 10 150000 1.3e-19 3.0e-20
+ *
+ */
+ /* atan2l()
+ *
+ * Quadrant correct inverse circular tangent,
+ * long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, z, atan2l();
+ *
+ * z = atan2l( y, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle whose tangent is y/x.
+ * Define compile time symbol ANSIC = 1 for ANSI standard,
+ * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range
+ * 0 to 2PI, args (x,y).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10, 10 60000 1.7e-19 3.2e-20
+ * See atan.c.
+ *
+ */
+
+/* atan.c */
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1990, 1998 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+-8.6863818178092187535440E-1L,
+-1.4683508633175792446076E1L,
+-6.3976888655834347413154E1L,
+-9.9988763777265819915721E1L,
+-5.0894116899623603312185E1L,
+};
+static long double Q[] = {
+/* 1.00000000000000000000E0L,*/
+ 2.2981886733594175366172E1L,
+ 1.4399096122250781605352E2L,
+ 3.6144079386152023162701E2L,
+ 3.9157570175111990631099E2L,
+ 1.5268235069887081006606E2L,
+};
+
+/* tan( 3*pi/8 ) */
+static long double T3P8 = 2.41421356237309504880169L;
+
+/* tan( pi/8 ) */
+static long double TP8 = 4.1421356237309504880169e-1L;
+#endif
+
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x8ece,0xce53,0x1266,0xde5f,0xbffe, XPD
+0x07e6,0xa061,0xa6bf,0xeaef,0xc002, XPD
+0x53ee,0xf291,0x557f,0xffe8,0xc004, XPD
+0xf9d6,0xeda6,0x3f3e,0xc7fa,0xc005, XPD
+0xb6c3,0x6abc,0x9361,0xcb93,0xc004, XPD
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x54d4,0x894e,0xe76e,0xb7da,0x4003, XPD
+0x76b9,0x7a46,0xafa2,0x8ffd,0x4006, XPD
+0xe3a9,0xe9c0,0x6bee,0xb4b8,0x4007, XPD
+0xabc1,0x50a7,0xb098,0xc3c9,0x4007, XPD
+0x891c,0x100d,0xae89,0x98ae,0x4006, XPD
+};
+
+/* tan( 3*pi/8 ) = 2.41421356237309504880 */
+static unsigned short T3P8A[] = {0x3242,0xfcef,0x7999,0x9a82,0x4000, XPD};
+#define T3P8 *(long double *)T3P8A
+
+/* tan( pi/8 ) = 0.41421356237309504880 */
+static unsigned short TP8A[] = {0x9211,0xe779,0xcccf,0xd413,0x3ffd, XPD};
+#define TP8 *(long double *)TP8A
+#endif
+
+#ifdef MIEEE
+static unsigned long P[] = {
+0xbffe0000,0xde5f1266,0xce538ece,
+0xc0020000,0xeaefa6bf,0xa06107e6,
+0xc0040000,0xffe8557f,0xf29153ee,
+0xc0050000,0xc7fa3f3e,0xeda6f9d6,
+0xc0040000,0xcb939361,0x6abcb6c3,
+};
+static unsigned long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40030000,0xb7dae76e,0x894e54d4,
+0x40060000,0x8ffdafa2,0x7a4676b9,
+0x40070000,0xb4b86bee,0xe9c0e3a9,
+0x40070000,0xc3c9b098,0x50a7abc1,
+0x40060000,0x98aeae89,0x100d891c,
+};
+
+/* tan( 3*pi/8 ) = 2.41421356237309504880 */
+static long T3P8A[] = {0x40000000,0x9a827999,0xfcef3242};
+#define T3P8 *(long double *)T3P8A
+
+/* tan( pi/8 ) = 0.41421356237309504880 */
+static long TP8A[] = {0x3ffd0000,0xd413cccf,0xe7799211};
+#define TP8 *(long double *)TP8A
+#endif
+
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double fabsl ( long double );
+extern int signbitl ( long double );
+extern int isnanl ( long double );
+long double atanl ( long double );
+#else
+long double polevll(), p1evll(), fabsl(), signbitl(), isnanl();
+long double atanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+#ifdef MINUSZERO
+extern long double NEGZEROL;
+#endif
+
+long double atanl(x)
+long double x;
+{
+extern long double PIO2L, PIO4L;
+long double y, z;
+short sign;
+
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITYL )
+ return( PIO2L );
+if( x == -INFINITYL )
+ return( -PIO2L );
+#endif
+/* make argument positive and save the sign */
+sign = 1;
+if( x < 0.0L )
+ {
+ sign = -1;
+ x = -x;
+ }
+
+/* range reduction */
+if( x > T3P8 )
+ {
+ y = PIO2L;
+ x = -( 1.0L/x );
+ }
+
+else if( x > TP8 )
+ {
+ y = PIO4L;
+ x = (x-1.0L)/(x+1.0L);
+ }
+else
+ y = 0.0L;
+
+/* rational form in x**2 */
+z = x * x;
+y = y + ( polevll( z, P, 4 ) / p1evll( z, Q, 5 ) ) * z * x + x;
+
+if( sign < 0 )
+ y = -y;
+
+return(y);
+}
+
+/* atan2 */
+
+
+extern long double PIL, PIO2L, MAXNUML;
+
+#if ANSIC
+long double atan2l( y, x )
+#else
+long double atan2l( x, y )
+#endif
+long double x, y;
+{
+long double z, w;
+short code;
+
+code = 0;
+
+if( x < 0.0L )
+ code = 2;
+if( y < 0.0L )
+ code |= 1;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+if( isnanl(y) )
+ return(y);
+#endif
+#ifdef MINUSZERO
+if( y == 0.0L )
+ {
+ if( signbitl(y) )
+ {
+ if( x > 0.0L )
+ z = y;
+ else if( x < 0.0L )
+ z = -PIL;
+ else
+ {
+ if( signbitl(x) )
+ z = -PIL;
+ else
+ z = y;
+ }
+ }
+ else /* y is +0 */
+ {
+ if( x == 0.0L )
+ {
+ if( signbitl(x) )
+ z = PIL;
+ else
+ z = 0.0L;
+ }
+ else if( x > 0.0L )
+ z = 0.0L;
+ else
+ z = PIL;
+ }
+ return z;
+ }
+if( x == 0.0L )
+ {
+ if( y > 0.0L )
+ z = PIO2L;
+ else
+ z = -PIO2L;
+ return z;
+ }
+#endif /* MINUSZERO */
+#ifdef INFINITIES
+if( x == INFINITYL )
+ {
+ if( y == INFINITYL )
+ z = 0.25L * PIL;
+ else if( y == -INFINITYL )
+ z = -0.25L * PIL;
+ else if( y < 0.0L )
+ z = NEGZEROL;
+ else
+ z = 0.0L;
+ return z;
+ }
+if( x == -INFINITYL )
+ {
+ if( y == INFINITYL )
+ z = 0.75L * PIL;
+ else if( y == -INFINITYL )
+ z = -0.75L * PIL;
+ else if( y >= 0.0L )
+ z = PIL;
+ else
+ z = -PIL;
+ return z;
+ }
+if( y == INFINITYL )
+ return( PIO2L );
+if( y == -INFINITYL )
+ return( -PIO2L );
+#endif /* INFINITIES */
+
+#ifdef INFINITIES
+if( x == 0.0L )
+#else
+if( fabsl(x) <= (fabsl(y) / MAXNUML) )
+#endif
+ {
+ if( code & 1 )
+ {
+#if ANSIC
+ return( -PIO2L );
+#else
+ return( 3.0L*PIO2L );
+#endif
+ }
+ if( y == 0.0L )
+ return( 0.0L );
+ return( PIO2L );
+ }
+
+if( y == 0.0L )
+ {
+ if( code & 2 )
+ return( PIL );
+ return( 0.0L );
+ }
+
+
+switch( code )
+ {
+ default:
+#if ANSIC
+ case 0:
+ case 1: w = 0.0L; break;
+ case 2: w = PIL; break;
+ case 3: w = -PIL; break;
+#else
+ case 0: w = 0.0L; break;
+ case 1: w = 2.0L * PIL; break;
+ case 2:
+ case 3: w = PIL; break;
+#endif
+ }
+
+z = w + atanl( y/x );
+#ifdef MINUSZERO
+if( z == 0.0L && y < 0.0L )
+ z = NEGZEROL;
+#endif
+return( z );
+}
diff --git a/libm/ldouble/bdtrl.c b/libm/ldouble/bdtrl.c
new file mode 100644
index 000000000..aca9577d1
--- /dev/null
+++ b/libm/ldouble/bdtrl.c
@@ -0,0 +1,260 @@
+/* bdtrl.c
+ *
+ * Binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtrl();
+ *
+ * y = bdtrl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms 0 through k of the Binomial
+ * probability density:
+ *
+ * k
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (k,n,p) with a and b between 0
+ * and 10000 and p between 0 and 1.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,10000 3000 1.6e-14 2.2e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrl domain k < 0 0.0
+ * n < k
+ * x < 0, x > 1
+ *
+ */
+ /* bdtrcl()
+ *
+ * Complemented binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtrcl();
+ *
+ * y = bdtrcl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 through n of the Binomial
+ * probability density:
+ *
+ * n
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=k+1
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrcl domain x<0, x>1, n<k 0.0
+ */
+ /* bdtril()
+ *
+ * Inverse binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, bdtril();
+ *
+ * p = bdtril( k, n, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the event probability p such that the sum of the
+ * terms 0 through k of the Binomial probability density
+ * is equal to the given cumulative probability y.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relation
+ *
+ * 1 - p = incbi( n-k, k+1, y ).
+ *
+ * ACCURACY:
+ *
+ * See incbi.c.
+ * Tested at random k, n between 1 and 10000. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 3500 2.0e-15 8.2e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtril domain k < 0, n <= k 0.0
+ * x < 0, x > 1
+ */
+
+/* bdtr() */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double incbetl ( long double, long double, long double );
+extern long double incbil ( long double, long double, long double );
+extern long double powl ( long double, long double );
+extern long double expm1l ( long double );
+extern long double log1pl ( long double );
+#else
+long double incbetl(), incbil(), powl(), expm1l(), log1pl();
+#endif
+
+long double bdtrcl( k, n, p )
+int k, n;
+long double p;
+{
+long double dk, dn;
+
+if( (p < 0.0L) || (p > 1.0L) )
+ goto domerr;
+if( k < 0 )
+ return( 1.0L );
+
+if( n < k )
+ {
+domerr:
+ mtherr( "bdtrcl", DOMAIN );
+ return( 0.0L );
+ }
+
+if( k == n )
+ return( 0.0L );
+dn = n - k;
+if( k == 0 )
+ {
+ if( p < .01L )
+ dk = -expm1l( dn * log1pl(-p) );
+ else
+ dk = 1.0L - powl( 1.0L-p, dn );
+ }
+else
+ {
+ dk = k + 1;
+ dk = incbetl( dk, dn, p );
+ }
+return( dk );
+}
+
+
+
+long double bdtrl( k, n, p )
+int k, n;
+long double p;
+{
+long double dk, dn, q;
+
+if( (p < 0.0L) || (p > 1.0L) )
+ goto domerr;
+if( (k < 0) || (n < k) )
+ {
+domerr:
+ mtherr( "bdtrl", DOMAIN );
+ return( 0.0L );
+ }
+
+if( k == n )
+ return( 1.0L );
+
+q = 1.0L - p;
+dn = n - k;
+if( k == 0 )
+ {
+ dk = powl( q, dn );
+ }
+else
+ {
+ dk = k + 1;
+ dk = incbetl( dn, dk, q );
+ }
+return( dk );
+}
+
+
+long double bdtril( k, n, y )
+int k, n;
+long double y;
+{
+long double dk, dn, p;
+
+if( (y < 0.0L) || (y > 1.0L) )
+ goto domerr;
+if( (k < 0) || (n <= k) )
+ {
+domerr:
+ mtherr( "bdtril", DOMAIN );
+ return( 0.0L );
+ }
+
+dn = n - k;
+if( k == 0 )
+ {
+ if( y > 0.8L )
+ p = -expm1l( log1pl(y-1.0L) / dn );
+ else
+ p = 1.0L - powl( y, 1.0L/dn );
+ }
+else
+ {
+ dk = k + 1;
+ p = incbetl( dn, dk, y );
+ if( p > 0.5 )
+ p = incbil( dk, dn, 1.0L-y );
+ else
+ p = 1.0 - incbil( dn, dk, y );
+ }
+return( p );
+}
diff --git a/libm/ldouble/btdtrl.c b/libm/ldouble/btdtrl.c
new file mode 100644
index 000000000..cbc4515da
--- /dev/null
+++ b/libm/ldouble/btdtrl.c
@@ -0,0 +1,68 @@
+
+/* btdtrl.c
+ *
+ * Beta distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, btdtrl();
+ *
+ * y = btdtrl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the beta density
+ * function:
+ *
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * P(x) = ---------- | t (1-t) dt
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ *
+ * The mean value of this distribution is a/(a+b). The variance
+ * is ab/[(a+b)^2 (a+b+1)].
+ *
+ * This function is identical to the incomplete beta integral
+ * function, incbetl(a, b, x).
+ *
+ * The complemented function is
+ *
+ * 1 - P(1-x) = incbetl( b, a, x );
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbetl.c.
+ *
+ */
+
+/* btdtrl() */
+
+
+/*
+Cephes Math Library Release 2.0: April, 1987
+Copyright 1984, 1995 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+#include <math.h>
+#ifdef ANSIPROT
+extern long double incbetl ( long double, long double, long double );
+#else
+long double incbetl();
+#endif
+
+long double btdtrl( a, b, x )
+long double a, b, x;
+{
+
+return( incbetl( a, b, x ) );
+}
diff --git a/libm/ldouble/cbrtl.c b/libm/ldouble/cbrtl.c
new file mode 100644
index 000000000..89ed11a06
--- /dev/null
+++ b/libm/ldouble/cbrtl.c
@@ -0,0 +1,143 @@
+/* cbrtl.c
+ *
+ * Cube root, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cbrtl();
+ *
+ * y = cbrtl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the cube root of the argument, which may be negative.
+ *
+ * Range reduction involves determining the power of 2 of
+ * the argument. A polynomial of degree 2 applied to the
+ * mantissa, and multiplication by the cube root of 1, 2, or 4
+ * approximates the root to within about 0.1%. Then Newton's
+ * iteration is used three times to converge to an accurate
+ * result.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE .125,8 80000 7.0e-20 2.2e-20
+ * IEEE exp(+-707) 100000 7.0e-20 2.4e-20
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.2: January, 1991
+Copyright 1984, 1991 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+#include <math.h>
+
+static long double CBRT2 = 1.2599210498948731647672L;
+static long double CBRT4 = 1.5874010519681994747517L;
+static long double CBRT2I = 0.79370052598409973737585L;
+static long double CBRT4I = 0.62996052494743658238361L;
+
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+#else
+long double frexpl(), ldexpl();
+extern int isnanl();
+#endif
+
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+
+long double cbrtl(x)
+long double x;
+{
+int e, rem, sign;
+long double z;
+
+
+#ifdef NANS
+if(isnanl(x))
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITYL)
+ return(x);
+if( x == -INFINITYL)
+ return(x);
+#endif
+if( x == 0 )
+ return( x );
+if( x > 0 )
+ sign = 1;
+else
+ {
+ sign = -1;
+ x = -x;
+ }
+
+z = x;
+/* extract power of 2, leaving
+ * mantissa between 0.5 and 1
+ */
+x = frexpl( x, &e );
+
+/* Approximate cube root of number between .5 and 1,
+ * peak relative error = 1.2e-6
+ */
+x = (((( 1.3584464340920900529734e-1L * x
+ - 6.3986917220457538402318e-1L) * x
+ + 1.2875551670318751538055e0L) * x
+ - 1.4897083391357284957891e0L) * x
+ + 1.3304961236013647092521e0L) * x
+ + 3.7568280825958912391243e-1L;
+
+/* exponent divided by 3 */
+if( e >= 0 )
+ {
+ rem = e;
+ e /= 3;
+ rem -= 3*e;
+ if( rem == 1 )
+ x *= CBRT2;
+ else if( rem == 2 )
+ x *= CBRT4;
+ }
+else
+ { /* argument less than 1 */
+ e = -e;
+ rem = e;
+ e /= 3;
+ rem -= 3*e;
+ if( rem == 1 )
+ x *= CBRT2I;
+ else if( rem == 2 )
+ x *= CBRT4I;
+ e = -e;
+ }
+
+/* multiply by power of 2 */
+x = ldexpl( x, e );
+
+/* Newton iteration */
+
+x -= ( x - (z/(x*x)) )*0.3333333333333333333333L;
+x -= ( x - (z/(x*x)) )*0.3333333333333333333333L;
+
+if( sign < 0 )
+ x = -x;
+return(x);
+}
diff --git a/libm/ldouble/chdtrl.c b/libm/ldouble/chdtrl.c
new file mode 100644
index 000000000..e55361e1f
--- /dev/null
+++ b/libm/ldouble/chdtrl.c
@@ -0,0 +1,200 @@
+/* chdtrl.c
+ *
+ * Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double df, x, y, chdtrl();
+ *
+ * y = chdtrl( df, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the left hand tail (from 0 to x)
+ * of the Chi square probability density function with
+ * v degrees of freedom.
+ *
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chdtr( v, x ) = igam( v/2.0, x/2.0 ).
+ *
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtr domain x < 0 or v < 1 0.0
+ */
+ /* chdtrcl()
+ *
+ * Complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double v, x, y, chdtrcl();
+ *
+ * y = chdtrcl( v, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the right hand tail (from x to
+ * infinity) of the Chi square probability density function
+ * with v degrees of freedom:
+ *
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ).
+ *
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtrc domain x < 0 or v < 1 0.0
+ */
+ /* chdtril()
+ *
+ * Inverse of complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double df, x, y, chdtril();
+ *
+ * x = chdtril( df, y );
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the Chi-square argument x such that the integral
+ * from x to infinity of the Chi-square density is equal
+ * to the given cumulative probability y.
+ *
+ * This is accomplished using the inverse gamma integral
+ * function and the relation
+ *
+ * x/2 = igami( df/2, y );
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtri domain y < 0 or y > 1 0.0
+ * v < 1
+ *
+ */
+
+/* chdtr() */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double igamcl ( long double, long double );
+extern long double igaml ( long double, long double );
+extern long double igamil ( long double, long double );
+#else
+long double igamcl(), igaml(), igamil();
+#endif
+
+long double chdtrcl(df,x)
+long double df, x;
+{
+
+if( (x < 0.0L) || (df < 1.0L) )
+ {
+ mtherr( "chdtrcl", DOMAIN );
+ return(0.0L);
+ }
+return( igamcl( 0.5L*df, 0.5L*x ) );
+}
+
+
+
+long double chdtrl(df,x)
+long double df, x;
+{
+
+if( (x < 0.0L) || (df < 1.0L) )
+ {
+ mtherr( "chdtrl", DOMAIN );
+ return(0.0L);
+ }
+return( igaml( 0.5L*df, 0.5L*x ) );
+}
+
+
+
+long double chdtril( df, y )
+long double df, y;
+{
+long double x;
+
+if( (y < 0.0L) || (y > 1.0L) || (df < 1.0L) )
+ {
+ mtherr( "chdtril", DOMAIN );
+ return(0.0L);
+ }
+
+x = igamil( 0.5L * df, y );
+return( 2.0L * x );
+}
diff --git a/libm/ldouble/clogl.c b/libm/ldouble/clogl.c
new file mode 100644
index 000000000..b3e6b25fb
--- /dev/null
+++ b/libm/ldouble/clogl.c
@@ -0,0 +1,720 @@
+/* clogl.c
+ *
+ * Complex natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void clogl();
+ * cmplxl z, w;
+ *
+ * clogl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns complex logarithm to the base e (2.718...) of
+ * the complex argument x.
+ *
+ * If z = x + iy, r = sqrt( x**2 + y**2 ),
+ * then
+ * w = log(r) + i arctan(y/x).
+ *
+ * The arctangent ranges from -PI to +PI.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 7000 8.5e-17 1.9e-17
+ * IEEE -10,+10 30000 5.0e-15 1.1e-16
+ *
+ * Larger relative error can be observed for z near 1 +i0.
+ * In IEEE arithmetic the peak absolute error is 5.2e-16, rms
+ * absolute error 1.0e-16.
+ */
+
+#include <math.h>
+#ifdef ANSIPROT
+static void cchshl ( long double x, long double *c, long double *s );
+static long double redupil ( long double x );
+static long double ctansl ( cmplxl *z );
+long double cabsl ( cmplxl *x );
+void csqrtl ( cmplxl *x, cmplxl *y );
+void caddl ( cmplxl *x, cmplxl *y, cmplxl *z );
+extern long double fabsl ( long double );
+extern long double sqrtl ( long double );
+extern long double logl ( long double );
+extern long double expl ( long double );
+extern long double atan2l ( long double, long double );
+extern long double coshl ( long double );
+extern long double sinhl ( long double );
+extern long double asinl ( long double );
+extern long double sinl ( long double );
+extern long double cosl ( long double );
+void clogl ( cmplxl *, cmplxl *);
+void casinl ( cmplxl *, cmplxl *);
+#else
+static void cchshl();
+static long double redupil();
+static long double ctansl();
+long double cabsl(), fabsl(), sqrtl();
+lnog double logl(), expl(), atan2l(), coshl(), sinhl();
+long double asinl(), sinl(), cosl();
+void caddl(), csqrtl(), clogl(), casinl();
+#endif
+
+extern long double MAXNUML, MACHEPL, PIL, PIO2L;
+
+void clogl( z, w )
+register cmplxl *z, *w;
+{
+long double p, rr;
+
+/*rr = sqrt( z->r * z->r + z->i * z->i );*/
+rr = cabsl(z);
+p = logl(rr);
+#if ANSIC
+rr = atan2l( z->i, z->r );
+#else
+rr = atan2l( z->r, z->i );
+if( rr > PIL )
+ rr -= PIL + PIL;
+#endif
+w->i = rr;
+w->r = p;
+}
+ /* cexpl()
+ *
+ * Complex exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cexpl();
+ * cmplxl z, w;
+ *
+ * cexpl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the exponential of the complex argument z
+ * into the complex result w.
+ *
+ * If
+ * z = x + iy,
+ * r = exp(x),
+ *
+ * then
+ *
+ * w = r cos y + i r sin y.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8700 3.7e-17 1.1e-17
+ * IEEE -10,+10 30000 3.0e-16 8.7e-17
+ *
+ */
+
+void cexpl( z, w )
+register cmplxl *z, *w;
+{
+long double r;
+
+r = expl( z->r );
+w->r = r * cosl( z->i );
+w->i = r * sinl( z->i );
+}
+ /* csinl()
+ *
+ * Complex circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csinl();
+ * cmplxl z, w;
+ *
+ * csinl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * w = sin x cosh y + i cos x sinh y.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8400 5.3e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ * Also tested by csin(casin(z)) = z.
+ *
+ */
+
+void csinl( z, w )
+register cmplxl *z, *w;
+{
+long double ch, sh;
+
+cchshl( z->i, &ch, &sh );
+w->r = sinl( z->r ) * ch;
+w->i = cosl( z->r ) * sh;
+}
+
+
+
+/* calculate cosh and sinh */
+
+static void cchshl( x, c, s )
+long double x, *c, *s;
+{
+long double e, ei;
+
+if( fabsl(x) <= 0.5L )
+ {
+ *c = coshl(x);
+ *s = sinhl(x);
+ }
+else
+ {
+ e = expl(x);
+ ei = 0.5L/e;
+ e = 0.5L * e;
+ *s = e - ei;
+ *c = e + ei;
+ }
+}
+
+ /* ccosl()
+ *
+ * Complex circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccosl();
+ * cmplxl z, w;
+ *
+ * ccosl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * w = cos x cosh y - i sin x sinh y.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 8400 4.5e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ */
+
+void ccosl( z, w )
+register cmplxl *z, *w;
+{
+long double ch, sh;
+
+cchshl( z->i, &ch, &sh );
+w->r = cosl( z->r ) * ch;
+w->i = -sinl( z->r ) * sh;
+}
+ /* ctanl()
+ *
+ * Complex circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ctanl();
+ * cmplxl z, w;
+ *
+ * ctanl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * sin 2x + i sinh 2y
+ * w = --------------------.
+ * cos 2x + cosh 2y
+ *
+ * On the real axis the denominator is zero at odd multiples
+ * of PI/2. The denominator is evaluated by its Taylor
+ * series near these points.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 7.1e-17 1.6e-17
+ * IEEE -10,+10 30000 7.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z.
+ */
+
+void ctanl( z, w )
+register cmplxl *z, *w;
+{
+long double d;
+
+d = cosl( 2.0L * z->r ) + coshl( 2.0L * z->i );
+
+if( fabsl(d) < 0.25L )
+ d = ctansl(z);
+
+if( d == 0.0L )
+ {
+ mtherr( "ctan", OVERFLOW );
+ w->r = MAXNUML;
+ w->i = MAXNUML;
+ return;
+ }
+
+w->r = sinl( 2.0L * z->r ) / d;
+w->i = sinhl( 2.0L * z->i ) / d;
+}
+ /* ccotl()
+ *
+ * Complex circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccotl();
+ * cmplxl z, w;
+ *
+ * ccotl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ *
+ * sin 2x - i sinh 2y
+ * w = --------------------.
+ * cosh 2y - cos 2x
+ *
+ * On the real axis, the denominator has zeros at even
+ * multiples of PI/2. Near these points it is evaluated
+ * by a Taylor series.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 3000 6.5e-17 1.6e-17
+ * IEEE -10,+10 30000 9.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 + i0.
+ */
+
+void ccotl( z, w )
+register cmplxl *z, *w;
+{
+long double d;
+
+d = coshl(2.0L * z->i) - cosl(2.0L * z->r);
+
+if( fabsl(d) < 0.25L )
+ d = ctansl(z);
+
+if( d == 0.0L )
+ {
+ mtherr( "ccot", OVERFLOW );
+ w->r = MAXNUML;
+ w->i = MAXNUML;
+ return;
+ }
+
+w->r = sinl( 2.0L * z->r ) / d;
+w->i = -sinhl( 2.0L * z->i ) / d;
+}
+
+/* Program to subtract nearest integer multiple of PI */
+/* extended precision value of PI: */
+#ifdef UNK
+static double DP1 = 3.14159265160560607910E0;
+static double DP2 = 1.98418714791870343106E-9;
+static double DP3 = 1.14423774522196636802E-17;
+#endif
+
+#ifdef DEC
+static unsigned short P1[] = {0040511,0007732,0120000,0000000,};
+static unsigned short P2[] = {0031010,0055060,0100000,0000000,};
+static unsigned short P3[] = {0022123,0011431,0105056,0001560,};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef IBMPC
+static unsigned short P1[] = {0x0000,0x5400,0x21fb,0x4009};
+static unsigned short P2[] = {0x0000,0x1000,0x0b46,0x3e21};
+static unsigned short P3[] = {0xc06e,0x3145,0x6263,0x3c6a};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef MIEEE
+static unsigned short P1[] = {
+0x4009,0x21fb,0x5400,0x0000
+};
+static unsigned short P2[] = {
+0x3e21,0x0b46,0x1000,0x0000
+};
+static unsigned short P3[] = {
+0x3c6a,0x6263,0x3145,0xc06e
+};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+static long double redupil(x)
+long double x;
+{
+long double t;
+long i;
+
+t = x/PIL;
+if( t >= 0.0L )
+ t += 0.5L;
+else
+ t -= 0.5L;
+
+i = t; /* the multiple */
+t = i;
+t = ((x - t * DP1) - t * DP2) - t * DP3;
+return(t);
+}
+
+/* Taylor series expansion for cosh(2y) - cos(2x) */
+
+static long double ctansl(z)
+cmplxl *z;
+{
+long double f, x, x2, y, y2, rn, t;
+long double d;
+
+x = fabsl( 2.0L * z->r );
+y = fabsl( 2.0L * z->i );
+
+x = redupil(x);
+
+x = x * x;
+y = y * y;
+x2 = 1.0L;
+y2 = 1.0L;
+f = 1.0L;
+rn = 0.0;
+d = 0.0;
+do
+ {
+ rn += 1.0L;
+ f *= rn;
+ rn += 1.0L;
+ f *= rn;
+ x2 *= x;
+ y2 *= y;
+ t = y2 + x2;
+ t /= f;
+ d += t;
+
+ rn += 1.0L;
+ f *= rn;
+ rn += 1.0L;
+ f *= rn;
+ x2 *= x;
+ y2 *= y;
+ t = y2 - x2;
+ t /= f;
+ d += t;
+ }
+while( fabsl(t/d) > MACHEPL );
+return(d);
+}
+ /* casinl()
+ *
+ * Complex circular arc sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void casinl();
+ * cmplxl z, w;
+ *
+ * casinl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Inverse complex sine:
+ *
+ * 2
+ * w = -i clog( iz + csqrt( 1 - z ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 10100 2.1e-15 3.4e-16
+ * IEEE -10,+10 30000 2.2e-14 2.7e-15
+ * Larger relative error can be observed for z near zero.
+ * Also tested by csin(casin(z)) = z.
+ */
+
+void casinl( z, w )
+cmplxl *z, *w;
+{
+static cmplxl ca, ct, zz, z2;
+long double x, y;
+
+x = z->r;
+y = z->i;
+
+if( y == 0.0L )
+ {
+ if( fabsl(x) > 1.0L )
+ {
+ w->r = PIO2L;
+ w->i = 0.0L;
+ mtherr( "casinl", DOMAIN );
+ }
+ else
+ {
+ w->r = asinl(x);
+ w->i = 0.0L;
+ }
+ return;
+ }
+
+/* Power series expansion */
+/*
+b = cabsl(z);
+if( b < 0.125L )
+{
+z2.r = (x - y) * (x + y);
+z2.i = 2.0L * x * y;
+
+cn = 1.0L;
+n = 1.0L;
+ca.r = x;
+ca.i = y;
+sum.r = x;
+sum.i = y;
+do
+ {
+ ct.r = z2.r * ca.r - z2.i * ca.i;
+ ct.i = z2.r * ca.i + z2.i * ca.r;
+ ca.r = ct.r;
+ ca.i = ct.i;
+
+ cn *= n;
+ n += 1.0L;
+ cn /= n;
+ n += 1.0L;
+ b = cn/n;
+
+ ct.r *= b;
+ ct.i *= b;
+ sum.r += ct.r;
+ sum.i += ct.i;
+ b = fabsl(ct.r) + fabs(ct.i);
+ }
+while( b > MACHEPL );
+w->r = sum.r;
+w->i = sum.i;
+return;
+}
+*/
+
+
+ca.r = x;
+ca.i = y;
+
+ct.r = -ca.i; /* iz */
+ct.i = ca.r;
+
+ /* sqrt( 1 - z*z) */
+/* cmul( &ca, &ca, &zz ) */
+zz.r = (ca.r - ca.i) * (ca.r + ca.i); /*x * x - y * y */
+zz.i = 2.0L * ca.r * ca.i;
+
+zz.r = 1.0L - zz.r;
+zz.i = -zz.i;
+csqrtl( &zz, &z2 );
+
+caddl( &z2, &ct, &zz );
+clogl( &zz, &zz );
+w->r = zz.i; /* mult by 1/i = -i */
+w->i = -zz.r;
+return;
+}
+ /* cacosl()
+ *
+ * Complex circular arc cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cacosl();
+ * cmplxl z, w;
+ *
+ * cacosl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * w = arccos z = PI/2 - arcsin z.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 1.6e-15 2.8e-16
+ * IEEE -10,+10 30000 1.8e-14 2.2e-15
+ */
+
+void cacosl( z, w )
+cmplxl *z, *w;
+{
+
+casinl( z, w );
+w->r = PIO2L - w->r;
+w->i = -w->i;
+}
+ /* catanl()
+ *
+ * Complex circular arc tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void catanl();
+ * cmplxl z, w;
+ *
+ * catanl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ * 1 ( 2x )
+ * Re w = - arctan(-----------) + k PI
+ * 2 ( 2 2)
+ * (1 - x - y )
+ *
+ * ( 2 2)
+ * 1 (x + (y+1) )
+ * Im w = - log(------------)
+ * 4 ( 2 2)
+ * (x + (y-1) )
+ *
+ * Where k is an arbitrary integer.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+void catanl( z, w )
+cmplxl *z, *w;
+{
+long double a, t, x, x2, y;
+
+x = z->r;
+y = z->i;
+
+if( (x == 0.0L) && (y > 1.0L) )
+ goto ovrf;
+
+x2 = x * x;
+a = 1.0L - x2 - (y * y);
+if( a == 0.0L )
+ goto ovrf;
+
+#if ANSIC
+t = atan2l( 2.0L * x, a ) * 0.5L;
+#else
+t = atan2l( a, 2.0 * x ) * 0.5L;
+#endif
+w->r = redupil( t );
+
+t = y - 1.0L;
+a = x2 + (t * t);
+if( a == 0.0L )
+ goto ovrf;
+
+t = y + 1.0L;
+a = (x2 + (t * t))/a;
+w->i = logl(a)/4.0;
+return;
+
+ovrf:
+mtherr( "catanl", OVERFLOW );
+w->r = MAXNUML;
+w->i = MAXNUML;
+}
diff --git a/libm/ldouble/cmplxl.c b/libm/ldouble/cmplxl.c
new file mode 100644
index 000000000..ef130618d
--- /dev/null
+++ b/libm/ldouble/cmplxl.c
@@ -0,0 +1,461 @@
+/* cmplxl.c
+ *
+ * Complex number arithmetic
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct {
+ * long double r; real part
+ * long double i; imaginary part
+ * }cmplxl;
+ *
+ * cmplxl *a, *b, *c;
+ *
+ * caddl( a, b, c ); c = b + a
+ * csubl( a, b, c ); c = b - a
+ * cmull( a, b, c ); c = b * a
+ * cdivl( a, b, c ); c = b / a
+ * cnegl( c ); c = -c
+ * cmovl( b, c ); c = b
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Addition:
+ * c.r = b.r + a.r
+ * c.i = b.i + a.i
+ *
+ * Subtraction:
+ * c.r = b.r - a.r
+ * c.i = b.i - a.i
+ *
+ * Multiplication:
+ * c.r = b.r * a.r - b.i * a.i
+ * c.i = b.r * a.i + b.i * a.r
+ *
+ * Division:
+ * d = a.r * a.r + a.i * a.i
+ * c.r = (b.r * a.r + b.i * a.i)/d
+ * c.i = (b.i * a.r - b.r * a.i)/d
+ * ACCURACY:
+ *
+ * In DEC arithmetic, the test (1/z) * z = 1 had peak relative
+ * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had
+ * peak relative error 8.3e-17, rms 2.1e-17.
+ *
+ * Tests in the rectangle {-10,+10}:
+ * Relative error:
+ * arithmetic function # trials peak rms
+ * DEC cadd 10000 1.4e-17 3.4e-18
+ * IEEE cadd 100000 1.1e-16 2.7e-17
+ * DEC csub 10000 1.4e-17 4.5e-18
+ * IEEE csub 100000 1.1e-16 3.4e-17
+ * DEC cmul 3000 2.3e-17 8.7e-18
+ * IEEE cmul 100000 2.1e-16 6.9e-17
+ * DEC cdiv 18000 4.9e-17 1.3e-17
+ * IEEE cdiv 100000 3.7e-16 1.1e-16
+ */
+ /* cmplx.c
+ * complex number arithmetic
+ */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+/*
+typedef struct
+ {
+ long double r;
+ long double i;
+ }cmplxl;
+*/
+
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double cabsl ( cmplxl * );
+extern long double sqrtl ( long double );
+extern long double atan2l ( long double, long double );
+extern long double cosl ( long double );
+extern long double sinl ( long double );
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+void cdivl ( cmplxl *, cmplxl *, cmplxl * );
+void caddl ( cmplxl *, cmplxl *, cmplxl * );
+#else
+long double fabsl(), cabsl(), sqrtl(), atan2l(), cosl(), sinl();
+long double frexpl(), ldexpl();
+int isnanl();
+void cdivl(), caddl();
+#endif
+
+
+extern double MAXNUML, MACHEPL, PIL, PIO2L, INFINITYL, NANL;
+cmplx czerol = {0.0L, 0.0L};
+cmplx conel = {1.0L, 0.0L};
+
+
+/* c = b + a */
+
+void caddl( a, b, c )
+register cmplxl *a, *b;
+cmplxl *c;
+{
+
+c->r = b->r + a->r;
+c->i = b->i + a->i;
+}
+
+
+/* c = b - a */
+
+void csubl( a, b, c )
+register cmplxl *a, *b;
+cmplxl *c;
+{
+
+c->r = b->r - a->r;
+c->i = b->i - a->i;
+}
+
+/* c = b * a */
+
+void cmull( a, b, c )
+register cmplxl *a, *b;
+cmplxl *c;
+{
+long double y;
+
+y = b->r * a->r - b->i * a->i;
+c->i = b->r * a->i + b->i * a->r;
+c->r = y;
+}
+
+
+
+/* c = b / a */
+
+void cdivl( a, b, c )
+register cmplxl *a, *b;
+cmplxl *c;
+{
+long double y, p, q, w;
+
+
+y = a->r * a->r + a->i * a->i;
+p = b->r * a->r + b->i * a->i;
+q = b->i * a->r - b->r * a->i;
+
+if( y < 1.0L )
+ {
+ w = MAXNUML * y;
+ if( (fabsl(p) > w) || (fabsl(q) > w) || (y == 0.0L) )
+ {
+ c->r = INFINITYL;
+ c->i = INFINITYL;
+ mtherr( "cdivl", OVERFLOW );
+ return;
+ }
+ }
+c->r = p/y;
+c->i = q/y;
+}
+
+
+/* b = a
+ Caution, a `short' is assumed to be 16 bits wide. */
+
+void cmovl( a, b )
+void *a, *b;
+{
+register short *pa, *pb;
+int i;
+
+pa = (short *) a;
+pb = (short *) b;
+i = 16;
+do
+ *pb++ = *pa++;
+while( --i );
+}
+
+
+void cnegl( a )
+register cmplxl *a;
+{
+
+a->r = -a->r;
+a->i = -a->i;
+}
+
+/* cabsl()
+ *
+ * Complex absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double cabsl();
+ * cmplxl z;
+ * long double a;
+ *
+ * a = cabs( &z );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * If z = x + iy
+ *
+ * then
+ *
+ * a = sqrt( x**2 + y**2 ).
+ *
+ * Overflow and underflow are avoided by testing the magnitudes
+ * of x and y before squaring. If either is outside half of
+ * the floating point full scale range, both are rescaled.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -30,+30 30000 3.2e-17 9.2e-18
+ * IEEE -10,+10 100000 2.7e-16 6.9e-17
+ */
+
+
+/*
+Cephes Math Library Release 2.1: January, 1989
+Copyright 1984, 1987, 1989 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+/*
+typedef struct
+ {
+ long double r;
+ long double i;
+ }cmplxl;
+*/
+
+#ifdef UNK
+#define PRECL 32
+#define MAXEXPL 16384
+#define MINEXPL -16384
+#endif
+#ifdef IBMPC
+#define PRECL 32
+#define MAXEXPL 16384
+#define MINEXPL -16384
+#endif
+#ifdef MIEEE
+#define PRECL 32
+#define MAXEXPL 16384
+#define MINEXPL -16384
+#endif
+
+
+long double cabsl( z )
+register cmplxl *z;
+{
+long double x, y, b, re, im;
+int ex, ey, e;
+
+#ifdef INFINITIES
+/* Note, cabs(INFINITY,NAN) = INFINITY. */
+if( z->r == INFINITYL || z->i == INFINITYL
+ || z->r == -INFINITYL || z->i == -INFINITYL )
+ return( INFINITYL );
+#endif
+
+#ifdef NANS
+if( isnanl(z->r) )
+ return(z->r);
+if( isnanl(z->i) )
+ return(z->i);
+#endif
+
+re = fabsl( z->r );
+im = fabsl( z->i );
+
+if( re == 0.0 )
+ return( im );
+if( im == 0.0 )
+ return( re );
+
+/* Get the exponents of the numbers */
+x = frexpl( re, &ex );
+y = frexpl( im, &ey );
+
+/* Check if one number is tiny compared to the other */
+e = ex - ey;
+if( e > PRECL )
+ return( re );
+if( e < -PRECL )
+ return( im );
+
+/* Find approximate exponent e of the geometric mean. */
+e = (ex + ey) >> 1;
+
+/* Rescale so mean is about 1 */
+x = ldexpl( re, -e );
+y = ldexpl( im, -e );
+
+/* Hypotenuse of the right triangle */
+b = sqrtl( x * x + y * y );
+
+/* Compute the exponent of the answer. */
+y = frexpl( b, &ey );
+ey = e + ey;
+
+/* Check it for overflow and underflow. */
+if( ey > MAXEXPL )
+ {
+ mtherr( "cabsl", OVERFLOW );
+ return( INFINITYL );
+ }
+if( ey < MINEXPL )
+ return(0.0L);
+
+/* Undo the scaling */
+b = ldexpl( b, e );
+return( b );
+}
+ /* csqrtl()
+ *
+ * Complex square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csqrtl();
+ * cmplxl z, w;
+ *
+ * csqrtl( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * If z = x + iy, r = |z|, then
+ *
+ * 1/2
+ * Im w = [ (r - x)/2 ] ,
+ *
+ * Re w = y / 2 Im w.
+ *
+ *
+ * Note that -w is also a square root of z. The root chosen
+ * is always in the upper half plane.
+ *
+ * Because of the potential for cancellation error in r - x,
+ * the result is sharpened by doing a Heron iteration
+ * (see sqrt.c) in complex arithmetic.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 25000 3.2e-17 9.6e-18
+ * IEEE -10,+10 100000 3.2e-16 7.7e-17
+ *
+ * 2
+ * Also tested by csqrt( z ) = z, and tested by arguments
+ * close to the real axis.
+ */
+
+
+void csqrtl( z, w )
+cmplxl *z, *w;
+{
+cmplxl q, s;
+long double x, y, r, t;
+
+x = z->r;
+y = z->i;
+
+if( y == 0.0L )
+ {
+ if( x < 0.0L )
+ {
+ w->r = 0.0L;
+ w->i = sqrtl(-x);
+ return;
+ }
+ else
+ {
+ w->r = sqrtl(x);
+ w->i = 0.0L;
+ return;
+ }
+ }
+
+
+if( x == 0.0L )
+ {
+ r = fabsl(y);
+ r = sqrtl(0.5L*r);
+ if( y > 0.0L )
+ w->r = r;
+ else
+ w->r = -r;
+ w->i = r;
+ return;
+ }
+
+/* Approximate sqrt(x^2+y^2) - x = y^2/2x - y^4/24x^3 + ... .
+ * The relative error in the first term is approximately y^2/12x^2 .
+ */
+if( (fabsl(y) < 2.e-4L * fabsl(x))
+ && (x > 0) )
+ {
+ t = 0.25L*y*(y/x);
+ }
+else
+ {
+ r = cabsl(z);
+ t = 0.5L*(r - x);
+ }
+
+r = sqrtl(t);
+q.i = r;
+q.r = y/(2.0L*r);
+/* Heron iteration in complex arithmetic */
+cdivl( &q, z, &s );
+caddl( &q, &s, w );
+w->r *= 0.5L;
+w->i *= 0.5L;
+
+cdivl( &q, z, &s );
+caddl( &q, &s, w );
+w->r *= 0.5L;
+w->i *= 0.5L;
+}
+
+
+long double hypotl( x, y )
+long double x, y;
+{
+cmplxl z;
+
+z.r = x;
+z.i = y;
+return( cabsl(&z) );
+}
diff --git a/libm/ldouble/coshl.c b/libm/ldouble/coshl.c
new file mode 100644
index 000000000..46212ae44
--- /dev/null
+++ b/libm/ldouble/coshl.c
@@ -0,0 +1,89 @@
+/* coshl.c
+ *
+ * Hyperbolic cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, coshl();
+ *
+ * y = coshl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic cosine of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * cosh(x) = ( exp(x) + exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-10000 30000 1.1e-19 2.8e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cosh overflow |x| > MAXLOGL+LOGE2L INFINITYL
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1985, 1991, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+extern long double MAXLOGL, MAXNUML, LOGE2L;
+#ifdef ANSIPROT
+extern long double expl ( long double );
+extern int isnanl ( long double );
+#else
+long double expl(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double coshl(x)
+long double x;
+{
+long double y;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+if( x < 0 )
+ x = -x;
+if( x > (MAXLOGL + LOGE2L) )
+ {
+ mtherr( "coshl", OVERFLOW );
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ return( MAXNUML );
+#endif
+ }
+if( x >= (MAXLOGL - LOGE2L) )
+ {
+ y = expl(0.5L * x);
+ y = (0.5L * y) * y;
+ return(y);
+ }
+y = expl(x);
+y = 0.5L * (y + 1.0L / y);
+return( y );
+}
diff --git a/libm/ldouble/econst.c b/libm/ldouble/econst.c
new file mode 100644
index 000000000..cfddbe3e2
--- /dev/null
+++ b/libm/ldouble/econst.c
@@ -0,0 +1,96 @@
+/* econst.c */
+/* e type constants used by high precision check routines */
+
+#include "ehead.h"
+
+
+#if NE == 10
+/* 0.0 */
+unsigned short ezero[NE] =
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,};
+
+/* 5.0E-1 */
+unsigned short ehalf[NE] =
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3ffe,};
+
+/* 1.0E0 */
+unsigned short eone[NE] =
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3fff,};
+
+/* 2.0E0 */
+unsigned short etwo[NE] =
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4000,};
+
+/* 3.2E1 */
+unsigned short e32[NE] =
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4004,};
+
+/* 6.93147180559945309417232121458176568075500134360255E-1 */
+unsigned short elog2[NE] =
+ {0x40f3, 0xf6af, 0x03f2, 0xb398,
+ 0xc9e3, 0x79ab, 0150717, 0013767, 0130562, 0x3ffe,};
+
+/* 1.41421356237309504880168872420969807856967187537695E0 */
+unsigned short esqrt2[NE] =
+ {0x1d6f, 0xbe9f, 0x754a, 0x89b3,
+ 0x597d, 0x6484, 0174736, 0171463, 0132404, 0x3fff,};
+
+/* 3.14159265358979323846264338327950288419716939937511E0 */
+unsigned short epi[NE] =
+ {0x2902, 0x1cd1, 0x80dc, 0x628b,
+ 0xc4c6, 0xc234, 0020550, 0155242, 0144417, 0040000,};
+
+/* 5.7721566490153286060651209008240243104215933593992E-1 */
+unsigned short eeul[NE] = {
+0xd1be,0xc7a4,0076660,0063743,0111704,0x3ffe,};
+
+#else
+
+/* 0.0 */
+unsigned short ezero[NE] = {
+0, 0000000,0000000,0000000,0000000,0000000,};
+/* 5.0E-1 */
+unsigned short ehalf[NE] = {
+0, 0000000,0000000,0000000,0100000,0x3ffe,};
+/* 1.0E0 */
+unsigned short eone[NE] = {
+0, 0000000,0000000,0000000,0100000,0x3fff,};
+/* 2.0E0 */
+unsigned short etwo[NE] = {
+0, 0000000,0000000,0000000,0100000,0040000,};
+/* 3.2E1 */
+unsigned short e32[NE] = {
+0, 0000000,0000000,0000000,0100000,0040004,};
+/* 6.93147180559945309417232121458176568075500134360255E-1 */
+unsigned short elog2[NE] = {
+0xc9e4,0x79ab,0150717,0013767,0130562,0x3ffe,};
+/* 1.41421356237309504880168872420969807856967187537695E0 */
+unsigned short esqrt2[NE] = {
+0x597e,0x6484,0174736,0171463,0132404,0x3fff,};
+/* 2/sqrt(PI) =
+ * 1.12837916709551257389615890312154517168810125865800E0 */
+unsigned short eoneopi[NE] = {
+0x71d5,0x688d,0012333,0135202,0110156,0x3fff,};
+/* 3.14159265358979323846264338327950288419716939937511E0 */
+unsigned short epi[NE] = {
+0xc4c6,0xc234,0020550,0155242,0144417,0040000,};
+/* 5.7721566490153286060651209008240243104215933593992E-1 */
+unsigned short eeul[NE] = {
+0xd1be,0xc7a4,0076660,0063743,0111704,0x3ffe,};
+#endif
+extern unsigned short ezero[];
+extern unsigned short ehalf[];
+extern unsigned short eone[];
+extern unsigned short etwo[];
+extern unsigned short e32[];
+extern unsigned short elog2[];
+extern unsigned short esqrt2[];
+extern unsigned short eoneopi[];
+extern unsigned short epi[];
+extern unsigned short eeul[];
+
diff --git a/libm/ldouble/ehead.h b/libm/ldouble/ehead.h
new file mode 100644
index 000000000..785396dce
--- /dev/null
+++ b/libm/ldouble/ehead.h
@@ -0,0 +1,45 @@
+
+/* Include file for extended precision arithmetic programs.
+ */
+
+/* Number of 16 bit words in external x type format */
+#define NE 6
+/* #define NE 10 */
+
+/* Number of 16 bit words in internal format */
+#define NI (NE+3)
+
+/* Array offset to exponent */
+#define E 1
+
+/* Array offset to high guard word */
+#define M 2
+
+/* Number of bits of precision */
+#define NBITS ((NI-4)*16)
+
+/* Maximum number of decimal digits in ASCII conversion
+ * = NBITS*log10(2)
+ */
+#define NDEC (NBITS*8/27)
+
+/* The exponent of 1.0 */
+#define EXONE (0x3fff)
+
+
+void eadd(), esub(), emul(), ediv();
+int ecmp(), enormlz(), eshift();
+void eshup1(), eshup8(), eshup6(), eshdn1(), eshdn8(), eshdn6();
+void eabs(), eneg(), emov(), eclear(), einfin(), efloor();
+void eldexp(), efrexp(), eifrac(), ltoe();
+void esqrt(), elog(), eexp(), etanh(), epow();
+void asctoe(), asctoe24(), asctoe53(), asctoe64();
+void etoasc(), e24toasc(), e53toasc(), e64toasc();
+void etoe64(), etoe53(), etoe24(), e64toe(), e53toe(), e24toe();
+int mtherr();
+
+extern unsigned short ezero[], ehalf[], eone[], etwo[];
+extern unsigned short elog2[], esqrt2[];
+
+
+/* by Stephen L. Moshier. */
diff --git a/libm/ldouble/elliel.c b/libm/ldouble/elliel.c
new file mode 100644
index 000000000..851914454
--- /dev/null
+++ b/libm/ldouble/elliel.c
@@ -0,0 +1,146 @@
+/* elliel.c
+ *
+ * Incomplete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double phi, m, y, elliel();
+ *
+ * y = elliel( phi, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ * phi
+ * -
+ * | |
+ * | 2
+ * E(phi_\m) = | sqrt( 1 - m sin t ) dt
+ * |
+ * | |
+ * -
+ * 0
+ *
+ * of amplitude phi and modulus m, using the arithmetic -
+ * geometric mean algorithm.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random arguments with phi in [-10, 10] and m in
+ * [0, 1].
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 50000 2.7e-18 2.3e-19
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1984, 1987, 1993, 1995 by Stephen L. Moshier
+*/
+
+/* Incomplete elliptic integral of second kind */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double fabsl ( long double );
+extern long double logl ( long double );
+extern long double sinl ( long double );
+extern long double tanl ( long double );
+extern long double atanl ( long double );
+extern long double floorl ( long double );
+extern long double ellpel ( long double );
+extern long double ellpkl ( long double );
+long double elliel ( long double, long double );
+#else
+long double sqrtl(), fabsl(), logl(), sinl(), tanl(), atanl(), floorl();
+long double ellpel(), ellpkl(), elliel();
+#endif
+extern long double PIL, PIO2L, MACHEPL;
+
+
+long double elliel( phi, m )
+long double phi, m;
+{
+long double a, b, c, e, temp, lphi, t, E;
+int d, mod, npio2, sign;
+
+if( m == 0.0L )
+ return( phi );
+lphi = phi;
+npio2 = floorl( lphi/PIO2L );
+if( npio2 & 1 )
+ npio2 += 1;
+lphi = lphi - npio2 * PIO2L;
+if( lphi < 0.0L )
+ {
+ lphi = -lphi;
+ sign = -1;
+ }
+else
+ {
+ sign = 1;
+ }
+a = 1.0L - m;
+E = ellpel( a );
+if( a == 0.0L )
+ {
+ temp = sinl( lphi );
+ goto done;
+ }
+t = tanl( lphi );
+b = sqrtl(a);
+if( fabsl(t) > 10.0L )
+ {
+ /* Transform the amplitude */
+ e = 1.0L/(b*t);
+ /* ... but avoid multiple recursions. */
+ if( fabsl(e) < 10.0L )
+ {
+ e = atanl(e);
+ temp = E + m * sinl( lphi ) * sinl( e ) - elliel( e, m );
+ goto done;
+ }
+ }
+c = sqrtl(m);
+a = 1.0L;
+d = 1;
+e = 0.0L;
+mod = 0;
+
+while( fabsl(c/a) > MACHEPL )
+ {
+ temp = b/a;
+ lphi = lphi + atanl(t*temp) + mod * PIL;
+ mod = (lphi + PIO2L)/PIL;
+ t = t * ( 1.0L + temp )/( 1.0L - temp * t * t );
+ c = 0.5L*( a - b );
+ temp = sqrtl( a * b );
+ a = 0.5L*( a + b );
+ b = temp;
+ d += d;
+ e += c * sinl(lphi);
+ }
+
+temp = E / ellpkl( 1.0L - m );
+temp *= (atanl(t) + mod * PIL)/(d * a);
+temp += e;
+
+done:
+
+if( sign < 0 )
+ temp = -temp;
+temp += npio2 * E;
+return( temp );
+}
diff --git a/libm/ldouble/ellikl.c b/libm/ldouble/ellikl.c
new file mode 100644
index 000000000..4eeffe0f5
--- /dev/null
+++ b/libm/ldouble/ellikl.c
@@ -0,0 +1,148 @@
+/* ellikl.c
+ *
+ * Incomplete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double phi, m, y, ellikl();
+ *
+ * y = ellikl( phi, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ *
+ * phi
+ * -
+ * | |
+ * | dt
+ * F(phi_\m) = | ------------------
+ * | 2
+ * | | sqrt( 1 - m sin t )
+ * -
+ * 0
+ *
+ * of amplitude phi and modulus m, using the arithmetic -
+ * geometric mean algorithm.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points with m in [0, 1] and phi as indicated.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 30000 3.6e-18 4.1e-19
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1984, 1987, 1995 by Stephen L. Moshier
+*/
+
+/* Incomplete elliptic integral of first kind */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double fabsl ( long double );
+extern long double logl ( long double );
+extern long double tanl ( long double );
+extern long double atanl ( long double );
+extern long double floorl ( long double );
+extern long double ellpkl ( long double );
+long double ellikl ( long double, long double );
+#else
+long double sqrtl(), fabsl(), logl(), tanl(), atanl(), floorl(), ellpkl();
+long double ellikl();
+#endif
+extern long double PIL, PIO2L, MACHEPL, MAXNUML;
+
+long double ellikl( phi, m )
+long double phi, m;
+{
+long double a, b, c, e, temp, t, K;
+int d, mod, sign, npio2;
+
+if( m == 0.0L )
+ return( phi );
+a = 1.0L - m;
+if( a == 0.0L )
+ {
+ if( fabsl(phi) >= PIO2L )
+ {
+ mtherr( "ellikl", SING );
+ return( MAXNUML );
+ }
+ return( logl( tanl( 0.5L*(PIO2L + phi) ) ) );
+ }
+npio2 = floorl( phi/PIO2L );
+if( npio2 & 1 )
+ npio2 += 1;
+if( npio2 )
+ {
+ K = ellpkl( a );
+ phi = phi - npio2 * PIO2L;
+ }
+else
+ K = 0.0L;
+if( phi < 0.0L )
+ {
+ phi = -phi;
+ sign = -1;
+ }
+else
+ sign = 0;
+b = sqrtl(a);
+t = tanl( phi );
+if( fabsl(t) > 10.0L )
+ {
+ /* Transform the amplitude */
+ e = 1.0L/(b*t);
+ /* ... but avoid multiple recursions. */
+ if( fabsl(e) < 10.0L )
+ {
+ e = atanl(e);
+ if( npio2 == 0 )
+ K = ellpkl( a );
+ temp = K - ellikl( e, m );
+ goto done;
+ }
+ }
+a = 1.0L;
+c = sqrtl(m);
+d = 1;
+mod = 0;
+
+while( fabsl(c/a) > MACHEPL )
+ {
+ temp = b/a;
+ phi = phi + atanl(t*temp) + mod * PIL;
+ mod = (phi + PIO2L)/PIL;
+ t = t * ( 1.0L + temp )/( 1.0L - temp * t * t );
+ c = 0.5L * ( a - b );
+ temp = sqrtl( a * b );
+ a = 0.5L * ( a + b );
+ b = temp;
+ d += d;
+ }
+
+temp = (atanl(t) + mod * PIL)/(d * a);
+
+done:
+if( sign < 0 )
+ temp = -temp;
+temp += npio2 * K;
+return( temp );
+}
diff --git a/libm/ldouble/ellpel.c b/libm/ldouble/ellpel.c
new file mode 100644
index 000000000..6965db066
--- /dev/null
+++ b/libm/ldouble/ellpel.c
@@ -0,0 +1,173 @@
+/* ellpel.c
+ *
+ * Complete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double m1, y, ellpel();
+ *
+ * y = ellpel( m1 );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ * pi/2
+ * -
+ * | | 2
+ * E(m) = | sqrt( 1 - m sin t ) dt
+ * | |
+ * -
+ * 0
+ *
+ * Where m = 1 - m1, using the approximation
+ *
+ * P(x) - x log x Q(x).
+ *
+ * Though there are no singularities, the argument m1 is used
+ * rather than m for compatibility with ellpk().
+ *
+ * E(1) = 1; E(0) = pi/2.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 1 10000 1.1e-19 3.5e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpel domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpe.c */
+
+/* Elliptic integral of second kind */
+
+/*
+Cephes Math Library, Release 2.3: October, 1995
+Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#if UNK
+static long double P[12] = {
+ 3.198937812032341294902E-5L,
+ 7.742523238588775116241E-4L,
+ 4.140384701571542000550E-3L,
+ 7.963509564694454269086E-3L,
+ 7.280911706839967541799E-3L,
+ 5.044067167184043853799E-3L,
+ 5.076832243257395296304E-3L,
+ 7.155775630578315248130E-3L,
+ 1.154485760526450950611E-2L,
+ 2.183137319801117971860E-2L,
+ 5.680519271556930583433E-2L,
+ 4.431471805599467050354E-1L,
+};
+static long double Q[12] = {
+ 6.393938134301205485085E-6L,
+ 2.741404591220851603273E-4L,
+ 2.480876752984331133799E-3L,
+ 8.770638497964078750003E-3L,
+ 1.676835725889463343319E-2L,
+ 2.281970801531577700830E-2L,
+ 2.767367465121309044166E-2L,
+ 3.364167778770018154356E-2L,
+ 4.272453406734691973083E-2L,
+ 5.859374951483909267451E-2L,
+ 9.374999999923942267270E-2L,
+ 2.499999999999998643587E-1L,
+};
+#endif
+#if IBMPC
+static short P[] = {
+0x7a78,0x5a02,0x554d,0x862c,0x3ff0, XPD
+0x34db,0xa965,0x31a3,0xcaf7,0x3ff4, XPD
+0xca6c,0x6c00,0x1071,0x87ac,0x3ff7, XPD
+0x4cdb,0x125d,0x6149,0x8279,0x3ff8, XPD
+0xadbd,0x3d8f,0xb6d5,0xee94,0x3ff7, XPD
+0x8189,0xcd0e,0xb3c2,0xa548,0x3ff7, XPD
+0x32b5,0xdd64,0x8e39,0xa65b,0x3ff7, XPD
+0x0344,0xc9db,0xff27,0xea7a,0x3ff7, XPD
+0xba2d,0x806a,0xa476,0xbd26,0x3ff8, XPD
+0xc3e0,0x30fa,0xb53d,0xb2d7,0x3ff9, XPD
+0x23b8,0x4d33,0x8fcf,0xe8ac,0x3ffa, XPD
+0xbc79,0xa39f,0x2fef,0xe2e4,0x3ffd, XPD
+};
+static short Q[] = {
+0x89f1,0xe234,0x82a6,0xd68b,0x3fed, XPD
+0x202a,0x96b3,0x8273,0x8fba,0x3ff3, XPD
+0xc183,0xfc45,0x3484,0xa296,0x3ff6, XPD
+0x683e,0xe201,0xb960,0x8fb2,0x3ff8, XPD
+0x721a,0x1b6a,0xcb41,0x895d,0x3ff9, XPD
+0x4eee,0x295f,0x6574,0xbaf0,0x3ff9, XPD
+0x3ade,0xc98f,0xe6f2,0xe2b3,0x3ff9, XPD
+0xd470,0x1784,0xdb1e,0x89cb,0x3ffa, XPD
+0xa649,0xe5c1,0xebc8,0xaeff,0x3ffa, XPD
+0x84c0,0xa8f5,0xffde,0xefff,0x3ffa, XPD
+0x5506,0xf94f,0xffff,0xbfff,0x3ffb, XPD
+0xd8e7,0xffff,0xffff,0xffff,0x3ffc, XPD
+};
+#endif
+#if MIEEE
+static long P[36] = {
+0x3ff00000,0x862c554d,0x5a027a78,
+0x3ff40000,0xcaf731a3,0xa96534db,
+0x3ff70000,0x87ac1071,0x6c00ca6c,
+0x3ff80000,0x82796149,0x125d4cdb,
+0x3ff70000,0xee94b6d5,0x3d8fadbd,
+0x3ff70000,0xa548b3c2,0xcd0e8189,
+0x3ff70000,0xa65b8e39,0xdd6432b5,
+0x3ff70000,0xea7aff27,0xc9db0344,
+0x3ff80000,0xbd26a476,0x806aba2d,
+0x3ff90000,0xb2d7b53d,0x30fac3e0,
+0x3ffa0000,0xe8ac8fcf,0x4d3323b8,
+0x3ffd0000,0xe2e42fef,0xa39fbc79,
+};
+static long Q[36] = {
+0x3fed0000,0xd68b82a6,0xe23489f1,
+0x3ff30000,0x8fba8273,0x96b3202a,
+0x3ff60000,0xa2963484,0xfc45c183,
+0x3ff80000,0x8fb2b960,0xe201683e,
+0x3ff90000,0x895dcb41,0x1b6a721a,
+0x3ff90000,0xbaf06574,0x295f4eee,
+0x3ff90000,0xe2b3e6f2,0xc98f3ade,
+0x3ffa0000,0x89cbdb1e,0x1784d470,
+0x3ffa0000,0xaeffebc8,0xe5c1a649,
+0x3ffa0000,0xefffffde,0xa8f584c0,
+0x3ffb0000,0xbfffffff,0xf94f5506,
+0x3ffc0000,0xffffffff,0xffffd8e7,
+};
+#endif
+
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double logl ( long double );
+#else
+long double polevll(), logl();
+#endif
+
+long double ellpel(x)
+long double x;
+{
+
+if( (x <= 0.0L) || (x > 1.0L) )
+ {
+ if( x == 0.0L )
+ return( 1.0L );
+ mtherr( "ellpel", DOMAIN );
+ return( 0.0L );
+ }
+return( 1.0L + x * polevll(x,P,11) - logl(x) * (x * polevll(x,Q,11)) );
+}
diff --git a/libm/ldouble/ellpjl.c b/libm/ldouble/ellpjl.c
new file mode 100644
index 000000000..bb57fe6a1
--- /dev/null
+++ b/libm/ldouble/ellpjl.c
@@ -0,0 +1,164 @@
+/* ellpjl.c
+ *
+ * Jacobian Elliptic Functions
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double u, m, sn, cn, dn, phi;
+ * int ellpjl();
+ *
+ * ellpjl( u, m, _&sn, _&cn, _&dn, _&phi );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m),
+ * and dn(u|m) of parameter m between 0 and 1, and real
+ * argument u.
+ *
+ * These functions are periodic, with quarter-period on the
+ * real axis equal to the complete elliptic integral
+ * ellpk(1.0-m).
+ *
+ * Relation to incomplete elliptic integral:
+ * If u = ellik(phi,m), then sn(u|m) = sin(phi),
+ * and cn(u|m) = cos(phi). Phi is called the amplitude of u.
+ *
+ * Computation is by means of the arithmetic-geometric mean
+ * algorithm, except when m is within 1e-12 of 0 or 1. In the
+ * latter case with m close to 1, the approximation applies
+ * only for phi < pi/2.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points with u between 0 and 10, m between
+ * 0 and 1.
+ *
+ * Absolute error (* = relative error):
+ * arithmetic function # trials peak rms
+ * IEEE sn 10000 1.7e-18 2.3e-19
+ * IEEE cn 20000 1.6e-18 2.2e-19
+ * IEEE dn 10000 4.7e-15 2.7e-17
+ * IEEE phi 10000 4.0e-19* 6.6e-20*
+ *
+ * Accuracy deteriorates when u is large.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1984, 1987, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double fabsl ( long double );
+extern long double sinl ( long double );
+extern long double cosl ( long double );
+extern long double asinl ( long double );
+extern long double tanhl ( long double );
+extern long double sinhl ( long double );
+extern long double coshl ( long double );
+extern long double atanl ( long double );
+extern long double expl ( long double );
+#else
+long double sqrtl(), fabsl(), sinl(), cosl(), asinl(), tanhl();
+long double sinhl(), coshl(), atanl(), expl();
+#endif
+extern long double PIO2L, MACHEPL;
+
+int ellpjl( u, m, sn, cn, dn, ph )
+long double u, m;
+long double *sn, *cn, *dn, *ph;
+{
+long double ai, b, phi, t, twon;
+long double a[9], c[9];
+int i;
+
+
+/* Check for special cases */
+
+if( m < 0.0L || m > 1.0L )
+ {
+ mtherr( "ellpjl", DOMAIN );
+ *sn = 0.0L;
+ *cn = 0.0L;
+ *ph = 0.0L;
+ *dn = 0.0L;
+ return(-1);
+ }
+if( m < 1.0e-12L )
+ {
+ t = sinl(u);
+ b = cosl(u);
+ ai = 0.25L * m * (u - t*b);
+ *sn = t - ai*b;
+ *cn = b + ai*t;
+ *ph = u - ai;
+ *dn = 1.0L - 0.5L*m*t*t;
+ return(0);
+ }
+
+if( m >= 0.999999999999L )
+ {
+ ai = 0.25L * (1.0L-m);
+ b = coshl(u);
+ t = tanhl(u);
+ phi = 1.0L/b;
+ twon = b * sinhl(u);
+ *sn = t + ai * (twon - u)/(b*b);
+ *ph = 2.0L*atanl(expl(u)) - PIO2L + ai*(twon - u)/b;
+ ai *= t * phi;
+ *cn = phi - ai * (twon - u);
+ *dn = phi + ai * (twon + u);
+ return(0);
+ }
+
+
+/* A. G. M. scale */
+a[0] = 1.0L;
+b = sqrtl(1.0L - m);
+c[0] = sqrtl(m);
+twon = 1.0L;
+i = 0;
+
+while( fabsl(c[i]/a[i]) > MACHEPL )
+ {
+ if( i > 7 )
+ {
+ mtherr( "ellpjl", OVERFLOW );
+ goto done;
+ }
+ ai = a[i];
+ ++i;
+ c[i] = 0.5L * ( ai - b );
+ t = sqrtl( ai * b );
+ a[i] = 0.5L * ( ai + b );
+ b = t;
+ twon *= 2.0L;
+ }
+
+done:
+
+/* backward recurrence */
+phi = twon * a[i] * u;
+do
+ {
+ t = c[i] * sinl(phi) / a[i];
+ b = phi;
+ phi = 0.5L * (asinl(t) + phi);
+ }
+while( --i );
+
+*sn = sinl(phi);
+t = cosl(phi);
+*cn = t;
+*dn = t/cosl(phi-b);
+*ph = phi;
+return(0);
+}
diff --git a/libm/ldouble/ellpkl.c b/libm/ldouble/ellpkl.c
new file mode 100644
index 000000000..dd42ac861
--- /dev/null
+++ b/libm/ldouble/ellpkl.c
@@ -0,0 +1,203 @@
+/* ellpkl.c
+ *
+ * Complete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double m1, y, ellpkl();
+ *
+ * y = ellpkl( m1 );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Approximates the integral
+ *
+ *
+ *
+ * pi/2
+ * -
+ * | |
+ * | dt
+ * K(m) = | ------------------
+ * | 2
+ * | | sqrt( 1 - m sin t )
+ * -
+ * 0
+ *
+ * where m = 1 - m1, using the approximation
+ *
+ * P(x) - log x Q(x).
+ *
+ * The argument m1 is used rather than m so that the logarithmic
+ * singularity at m = 1 will be shifted to the origin; this
+ * preserves maximum accuracy.
+ *
+ * K(0) = pi/2.
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 10000 1.1e-19 3.3e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpkl domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpkl.c */
+
+
+/*
+Cephes Math Library, Release 2.3: October, 1995
+Copyright 1984, 1987, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#if UNK
+static long double P[13] = {
+ 1.247539729154838838628E-6L,
+ 2.149421654232011240659E-4L,
+ 2.265267575136470585139E-3L,
+ 6.723088676584254248821E-3L,
+ 8.092066790639263075808E-3L,
+ 5.664069509748147028621E-3L,
+ 4.579865994050801042865E-3L,
+ 5.797368411662027645234E-3L,
+ 8.767698209432225911803E-3L,
+ 1.493761594388688915057E-2L,
+ 3.088514457872042326871E-2L,
+ 9.657359027999314232753E-2L,
+ 1.386294361119890618992E0L,
+};
+static long double Q[12] = {
+ 5.568631677757315398993E-5L,
+ 1.036110372590318802997E-3L,
+ 5.500459122138244213579E-3L,
+ 1.337330436245904844528E-2L,
+ 2.033103735656990487115E-2L,
+ 2.522868345512332304268E-2L,
+ 3.026786461242788135379E-2L,
+ 3.738370118296930305919E-2L,
+ 4.882812208418620146046E-2L,
+ 7.031249999330222751046E-2L,
+ 1.249999999999978263154E-1L,
+ 4.999999999999999999924E-1L,
+};
+static long double C1 = 1.386294361119890618834L; /* log(4) */
+#endif
+#if IBMPC
+static short P[] = {
+0xf098,0xad01,0x2381,0xa771,0x3feb, XPD
+0xd6ed,0xea22,0x1922,0xe162,0x3ff2, XPD
+0x3733,0xe2f1,0xe226,0x9474,0x3ff6, XPD
+0x3031,0x3c9d,0x5aff,0xdc4d,0x3ff7, XPD
+0x9a46,0x4310,0x968e,0x8494,0x3ff8, XPD
+0xbe4c,0x3ff2,0xa8a7,0xb999,0x3ff7, XPD
+0xf35c,0x0eaf,0xb355,0x9612,0x3ff7, XPD
+0xbc56,0x8fd4,0xd9dd,0xbdf7,0x3ff7, XPD
+0xc01e,0x867f,0x6444,0x8fa6,0x3ff8, XPD
+0x4ba3,0x6392,0xe6fd,0xf4bc,0x3ff8, XPD
+0x62c3,0xbb12,0xd7bc,0xfd02,0x3ff9, XPD
+0x08fe,0x476c,0x5fdf,0xc5c8,0x3ffb, XPD
+0x79ad,0xd1cf,0x17f7,0xb172,0x3fff, XPD
+};
+static short Q[] = {
+0x96a4,0x8474,0xba33,0xe990,0x3ff0, XPD
+0xe5a7,0xa50e,0x1854,0x87ce,0x3ff5, XPD
+0x8999,0x72e3,0x3205,0xb43d,0x3ff7, XPD
+0x3255,0x13eb,0xb438,0xdb1b,0x3ff8, XPD
+0xb717,0x497f,0x4691,0xa68d,0x3ff9, XPD
+0x30be,0x8c6b,0x624b,0xceac,0x3ff9, XPD
+0xa858,0x2a0d,0x5014,0xf7f4,0x3ff9, XPD
+0x8615,0xbfa6,0xa6df,0x991f,0x3ffa, XPD
+0x103c,0xa076,0xff37,0xc7ff,0x3ffa, XPD
+0xf508,0xc515,0xffff,0x8fff,0x3ffb, XPD
+0x1af5,0xfffb,0xffff,0xffff,0x3ffb, XPD
+0x0000,0x0000,0x0000,0x8000,0x3ffe, XPD
+};
+static unsigned short ac1[] = {
+0x79ac,0xd1cf,0x17f7,0xb172,0x3fff, XPD
+};
+#define C1 (*(long double *)ac1)
+#endif
+
+#ifdef MIEEE
+static long P[39] = {
+0x3feb0000,0xa7712381,0xad01f098,
+0x3ff20000,0xe1621922,0xea22d6ed,
+0x3ff60000,0x9474e226,0xe2f13733,
+0x3ff70000,0xdc4d5aff,0x3c9d3031,
+0x3ff80000,0x8494968e,0x43109a46,
+0x3ff70000,0xb999a8a7,0x3ff2be4c,
+0x3ff70000,0x9612b355,0x0eaff35c,
+0x3ff70000,0xbdf7d9dd,0x8fd4bc56,
+0x3ff80000,0x8fa66444,0x867fc01e,
+0x3ff80000,0xf4bce6fd,0x63924ba3,
+0x3ff90000,0xfd02d7bc,0xbb1262c3,
+0x3ffb0000,0xc5c85fdf,0x476c08fe,
+0x3fff0000,0xb17217f7,0xd1cf79ad,
+};
+static long Q[36] = {
+0x3ff00000,0xe990ba33,0x847496a4,
+0x3ff50000,0x87ce1854,0xa50ee5a7,
+0x3ff70000,0xb43d3205,0x72e38999,
+0x3ff80000,0xdb1bb438,0x13eb3255,
+0x3ff90000,0xa68d4691,0x497fb717,
+0x3ff90000,0xceac624b,0x8c6b30be,
+0x3ff90000,0xf7f45014,0x2a0da858,
+0x3ffa0000,0x991fa6df,0xbfa68615,
+0x3ffa0000,0xc7ffff37,0xa076103c,
+0x3ffb0000,0x8fffffff,0xc515f508,
+0x3ffb0000,0xffffffff,0xfffb1af5,
+0x3ffe0000,0x80000000,0x00000000,
+};
+static unsigned long ac1[] = {
+0x3fff0000,0xb17217f7,0xd1cf79ac
+};
+#define C1 (*(long double *)ac1)
+#endif
+
+
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double logl ( long double );
+#else
+long double polevll(), logl();
+#endif
+extern long double MACHEPL, MAXNUML;
+
+long double ellpkl(x)
+long double x;
+{
+
+if( (x < 0.0L) || (x > 1.0L) )
+ {
+ mtherr( "ellpkl", DOMAIN );
+ return( 0.0L );
+ }
+
+if( x > MACHEPL )
+ {
+ return( polevll(x,P,12) - logl(x) * polevll(x,Q,11) );
+ }
+else
+ {
+ if( x == 0.0L )
+ {
+ mtherr( "ellpkl", SING );
+ return( MAXNUML );
+ }
+ else
+ {
+ return( C1 - 0.5L * logl(x) );
+ }
+ }
+}
diff --git a/libm/ldouble/exp10l.c b/libm/ldouble/exp10l.c
new file mode 100644
index 000000000..b837571b4
--- /dev/null
+++ b/libm/ldouble/exp10l.c
@@ -0,0 +1,192 @@
+/* exp10l.c
+ *
+ * Base 10 exponential function, long double precision
+ * (Common antilogarithm)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, exp10l()
+ *
+ * y = exp10l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns 10 raised to the x power.
+ *
+ * Range reduction is accomplished by expressing the argument
+ * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2).
+ * The Pade' form
+ *
+ * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ *
+ * is used to approximate 10**f.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-4900 30000 1.0e-19 2.7e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp10l underflow x < -MAXL10 0.0
+ * exp10l overflow x > MAXL10 MAXNUM
+ *
+ * IEEE arithmetic: MAXL10 = 4932.0754489586679023819
+ *
+ */
+
+/*
+Cephes Math Library Release 2.2: January, 1991
+Copyright 1984, 1991 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 3.1341179396892496811523E1L,
+ 4.5618283154904699073999E3L,
+ 1.3433113468542797218610E5L,
+ 7.6025447914440301593592E5L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 4.7705440288425157637739E2L,
+ 2.9732606548049614870598E4L,
+ 4.0843697951001026189583E5L,
+ 6.6034865026929015925608E5L,
+};
+/*static long double LOG102 = 3.0102999566398119521373889e-1L;*/
+static long double LOG210 = 3.3219280948873623478703L;
+static long double LG102A = 3.01025390625e-1L;
+static long double LG102B = 4.6050389811952137388947e-6L;
+#endif
+
+
+#ifdef IBMPC
+static short P[] = {
+0x399a,0x7dc7,0xbc43,0xfaba,0x4003, XPD
+0xb526,0xdf32,0xa063,0x8e8e,0x400b, XPD
+0x18da,0xafa1,0xc89e,0x832e,0x4010, XPD
+0x503d,0x9352,0xe7aa,0xb99b,0x4012, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x947d,0x7855,0xf6ac,0xee86,0x4007, XPD
+0x18cf,0x7749,0x368d,0xe849,0x400d, XPD
+0x85be,0x2560,0x9f58,0xc76e,0x4011, XPD
+0x6d3c,0x80c5,0xca67,0xa137,0x4012, XPD
+};
+/*
+static short L102[] = {0xf799,0xfbcf,0x9a84,0x9a20,0x3ffd, XPD};
+#define LOG102 *(long double *)L102
+*/
+static short L210[] = {0x8afe,0xcd1b,0x784b,0xd49a,0x4000, XPD};
+#define LOG210 *(long double *)L210
+static short L102A[] = {0x0000,0x0000,0x0000,0x9a20,0x3ffd, XPD};
+#define LG102A *(long double *)L102A
+static short L102B[] = {0x8f89,0xf798,0xfbcf,0x9a84,0x3fed, XPD};
+#define LG102B *(long double *)L102B
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x40030000,0xfababc43,0x7dc7399a,
+0x400b0000,0x8e8ea063,0xdf32b526,
+0x40100000,0x832ec89e,0xafa118da,
+0x40120000,0xb99be7aa,0x9352503d,
+};
+static long Q[] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40070000,0xee86f6ac,0x7855947d,
+0x400d0000,0xe849368d,0x774918cf,
+0x40110000,0xc76e9f58,0x256085be,
+0x40120000,0xa137ca67,0x80c56d3c,
+};
+/*
+static long L102[] = {0x3ffd0000,0x9a209a84,0xfbcff799};
+#define LOG102 *(long double *)L102
+*/
+static long L210[] = {0x40000000,0xd49a784b,0xcd1b8afe};
+#define LOG210 *(long double *)L210
+static long L102A[] = {0x3ffd0000,0x9a200000,0x00000000};
+#define LG102A *(long double *)L102A
+static long L102B[] = {0x3fed0000,0x9a84fbcf,0xf7988f89};
+#define LG102B *(long double *)L102B
+#endif
+
+static long double MAXL10 = 4.9320754489586679023819e3L;
+extern long double MAXNUML;
+#ifdef ANSIPROT
+extern long double floorl ( long double );
+extern long double ldexpl ( long double, int );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+#else
+long double floorl(), ldexpl(), polevll(), p1evll(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+
+long double exp10l(x)
+long double x;
+{
+long double px, xx;
+short n;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+if( x > MAXL10 )
+ {
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ mtherr( "exp10l", OVERFLOW );
+ return( MAXNUML );
+#endif
+ }
+
+if( x < -MAXL10 ) /* Would like to use MINLOG but can't */
+ {
+#ifndef INFINITIES
+ mtherr( "exp10l", UNDERFLOW );
+#endif
+ return(0.0L);
+ }
+
+/* Express 10**x = 10**g 2**n
+ * = 10**g 10**( n log10(2) )
+ * = 10**( g + n log10(2) )
+ */
+px = floorl( LOG210 * x + 0.5L );
+n = px;
+x -= px * LG102A;
+x -= px * LG102B;
+
+/* rational approximation for exponential
+ * of the fractional part:
+ * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ */
+xx = x * x;
+px = x * polevll( xx, P, 3 );
+x = px/( p1evll( xx, Q, 4 ) - px );
+x = 1.0L + ldexpl( x, 1 );
+
+/* multiply by power of 2 */
+x = ldexpl( x, n );
+return(x);
+}
diff --git a/libm/ldouble/exp2l.c b/libm/ldouble/exp2l.c
new file mode 100644
index 000000000..076f8bca5
--- /dev/null
+++ b/libm/ldouble/exp2l.c
@@ -0,0 +1,166 @@
+/* exp2l.c
+ *
+ * Base 2 exponential function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, exp2l();
+ *
+ * y = exp2l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns 2 raised to the x power.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ * x k f
+ * 2 = 2 2.
+ *
+ * A Pade' form
+ *
+ * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) )
+ *
+ * approximates 2**x in the basic range [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-16300 300000 9.1e-20 2.6e-20
+ *
+ *
+ * See exp.c for comments on error amplification.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp2l underflow x < -16382 0.0
+ * exp2l overflow x >= 16384 MAXNUM
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 6.0614853552242266094567E1L,
+ 3.0286971917562792508623E4L,
+ 2.0803843631901852422887E6L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 1.7492876999891839021063E3L,
+ 3.2772515434906797273099E5L,
+ 6.0027204078348487957118E6L,
+};
+#endif
+
+
+#ifdef IBMPC
+static short P[] = {
+0xffd8,0x6ad6,0x9c2b,0xf275,0x4004, XPD
+0x3426,0x2dc5,0xf19f,0xec9d,0x400d, XPD
+0x7ec0,0xd041,0x02e7,0xfdf4,0x4013, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x575b,0x9b93,0x34d6,0xdaa9,0x4009, XPD
+0xe38d,0x6d74,0xa4f0,0xa005,0x4011, XPD
+0xb37e,0xcfba,0x40d0,0xb730,0x4015, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x40040000,0xf2759c2b,0x6ad6ffd8,
+0x400d0000,0xec9df19f,0x2dc53426,
+0x40130000,0xfdf402e7,0xd0417ec0,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40090000,0xdaa934d6,0x9b93575b,
+0x40110000,0xa005a4f0,0x6d74e38d,
+0x40150000,0xb73040d0,0xcfbab37e,
+};
+#endif
+
+#define MAXL2L 16384.0L
+#define MINL2L -16382.0L
+
+
+extern long double MAXNUML;
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double floorl ( long double );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+#else
+long double polevll(), p1evll(), floorl(), ldexpl(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+
+long double exp2l(x)
+long double x;
+{
+long double px, xx;
+int n;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+if( x > MAXL2L)
+ {
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ mtherr( "exp2l", OVERFLOW );
+ return( MAXNUML );
+#endif
+ }
+
+if( x < MINL2L )
+ {
+#ifndef INFINITIES
+ mtherr( "exp2l", UNDERFLOW );
+#endif
+ return(0.0L);
+ }
+
+xx = x; /* save x */
+/* separate into integer and fractional parts */
+px = floorl(x+0.5L);
+n = px;
+x = x - px;
+
+/* rational approximation
+ * exp2(x) = 1.0 + 2xP(xx)/(Q(xx) - P(xx))
+ * where xx = x**2
+ */
+xx = x * x;
+px = x * polevll( xx, P, 2 );
+x = px / ( p1evll( xx, Q, 3 ) - px );
+x = 1.0L + ldexpl( x, 1 );
+
+/* scale by power of 2 */
+x = ldexpl( x, n );
+return(x);
+}
diff --git a/libm/ldouble/expl.c b/libm/ldouble/expl.c
new file mode 100644
index 000000000..524246987
--- /dev/null
+++ b/libm/ldouble/expl.c
@@ -0,0 +1,183 @@
+/* expl.c
+ *
+ * Exponential function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, expl();
+ *
+ * y = expl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns e (2.71828...) raised to the x power.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ *
+ * x k f
+ * e = 2 e.
+ *
+ * A Pade' form of degree 2/3 is used to approximate exp(f) - 1
+ * in the basic range [-0.5 ln 2, 0.5 ln 2].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-10000 50000 1.12e-19 2.81e-20
+ *
+ *
+ * Error amplification in the exponential function can be
+ * a serious matter. The error propagation involves
+ * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ),
+ * which shows that a 1 lsb error in representing X produces
+ * a relative error of X times 1 lsb in the function.
+ * While the routine gives an accurate result for arguments
+ * that are exactly represented by a long double precision
+ * computer number, the result contains amplified roundoff
+ * error for large arguments not exactly represented.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp underflow x < MINLOG 0.0
+ * exp overflow x > MAXLOG MAXNUM
+ *
+ */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1990, 1998 by Stephen L. Moshier
+*/
+
+
+/* Exponential function */
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[3] = {
+ 1.2617719307481059087798E-4L,
+ 3.0299440770744196129956E-2L,
+ 9.9999999999999999991025E-1L,
+};
+static long double Q[4] = {
+ 3.0019850513866445504159E-6L,
+ 2.5244834034968410419224E-3L,
+ 2.2726554820815502876593E-1L,
+ 2.0000000000000000000897E0L,
+};
+static long double C1 = 6.9314575195312500000000E-1L;
+static long double C2 = 1.4286068203094172321215E-6L;
+#endif
+
+#ifdef DEC
+not supported in long double precision
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0x424e,0x225f,0x6eaf,0x844e,0x3ff2, XPD
+0xf39e,0x5163,0x8866,0xf836,0x3ff9, XPD
+0xfffe,0xffff,0xffff,0xffff,0x3ffe, XPD
+};
+static short Q[] = {
+0xff1e,0xb2fc,0xb5e1,0xc975,0x3fec, XPD
+0xff3e,0x45b5,0xcda8,0xa571,0x3ff6, XPD
+0x9ee1,0x3f03,0x4cc4,0xe8b8,0x3ffc, XPD
+0x0000,0x0000,0x0000,0x8000,0x4000, XPD
+};
+static short sc1[] = {0x0000,0x0000,0x0000,0xb172,0x3ffe, XPD};
+#define C1 (*(long double *)sc1)
+static short sc2[] = {0x4f1e,0xcd5e,0x8e7b,0xbfbe,0x3feb, XPD};
+#define C2 (*(long double *)sc2)
+#endif
+
+#ifdef MIEEE
+static long P[9] = {
+0x3ff20000,0x844e6eaf,0x225f424e,
+0x3ff90000,0xf8368866,0x5163f39e,
+0x3ffe0000,0xffffffff,0xfffffffe,
+};
+static long Q[12] = {
+0x3fec0000,0xc975b5e1,0xb2fcff1e,
+0x3ff60000,0xa571cda8,0x45b5ff3e,
+0x3ffc0000,0xe8b84cc4,0x3f039ee1,
+0x40000000,0x80000000,0x00000000,
+};
+static long sc1[] = {0x3ffe0000,0xb1720000,0x00000000};
+#define C1 (*(long double *)sc1)
+static long sc2[] = {0x3feb0000,0xbfbe8e7b,0xcd5e4f1e};
+#define C2 (*(long double *)sc2)
+#endif
+
+extern long double LOG2EL, MAXLOGL, MINLOGL, MAXNUML;
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double floorl ( long double );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+#else
+long double polevll(), floorl(), ldexpl(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+
+long double expl(x)
+long double x;
+{
+long double px, xx;
+int n;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+if( x > MAXLOGL)
+ {
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ mtherr( "expl", OVERFLOW );
+ return( MAXNUML );
+#endif
+ }
+
+if( x < MINLOGL )
+ {
+#ifndef INFINITIES
+ mtherr( "expl", UNDERFLOW );
+#endif
+ return(0.0L);
+ }
+
+/* Express e**x = e**g 2**n
+ * = e**g e**( n loge(2) )
+ * = e**( g + n loge(2) )
+ */
+px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */
+n = px;
+x -= px * C1;
+x -= px * C2;
+
+
+/* rational approximation for exponential
+ * of the fractional part:
+ * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ */
+xx = x * x;
+px = x * polevll( xx, P, 2 );
+x = px/( polevll( xx, Q, 3 ) - px );
+x = 1.0L + ldexpl( x, 1 );
+
+x = ldexpl( x, n );
+return(x);
+}
diff --git a/libm/ldouble/fdtrl.c b/libm/ldouble/fdtrl.c
new file mode 100644
index 000000000..da2f8910a
--- /dev/null
+++ b/libm/ldouble/fdtrl.c
@@ -0,0 +1,237 @@
+/* fdtrl.c
+ *
+ * F distribution, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, y, fdtrl();
+ *
+ * y = fdtrl( df1, df2, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the F density
+ * function (also known as Snedcor's density or the
+ * variance ratio density). This is the density
+ * of x = (u1/df1)/(u2/df2), where u1 and u2 are random
+ * variables having Chi square distributions with df1
+ * and df2 degrees of freedom, respectively.
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbetl( df1/2, df2/2, (df1*x/(df2 + df1*x) ).
+ *
+ *
+ * The arguments a and b are greater than zero, and x
+ * x is nonnegative.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) in the indicated intervals.
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 1,100 10000 9.3e-18 2.9e-19
+ * IEEE 0,1 1,10000 10000 1.9e-14 2.9e-15
+ * IEEE 1,5 1,10000 10000 5.8e-15 1.4e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrl domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtrcl()
+ *
+ * Complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, y, fdtrcl();
+ *
+ * y = fdtrcl( df1, df2, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from x to infinity under the F density
+ * function (also known as Snedcor's density or the
+ * variance ratio density).
+ *
+ *
+ * inf.
+ * -
+ * 1 | | a-1 b-1
+ * 1-P(x) = ------ | t (1-t) dt
+ * B(a,b) | |
+ * -
+ * x
+ *
+ * (See fdtr.c.)
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ * Tested at random points (a,b,x).
+ *
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 0,100 10000 4.2e-18 3.3e-19
+ * IEEE 0,1 1,10000 10000 7.2e-15 2.6e-16
+ * IEEE 1,5 1,10000 10000 1.7e-14 3.0e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrcl domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtril()
+ *
+ * Inverse of complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * long double x, p, fdtril();
+ *
+ * x = fdtril( df1, df2, p );
+ *
+ * DESCRIPTION:
+ *
+ * Finds the F density argument x such that the integral
+ * from x to infinity of the F density is equal to the
+ * given probability p.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relations
+ *
+ * z = incbi( df2/2, df1/2, p )
+ * x = df2 (1-z) / (df1 z).
+ *
+ * Note: the following relations hold for the inverse of
+ * the uncomplemented F distribution:
+ *
+ * z = incbi( df1/2, df2/2, p )
+ * x = df2 z / (df1 (1-z)).
+ *
+ * ACCURACY:
+ *
+ * See incbi.c.
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between .001 and 1:
+ * IEEE 1,100 40000 4.6e-18 2.7e-19
+ * IEEE 1,10000 30000 1.7e-14 1.4e-16
+ * For p between 10^-6 and .001:
+ * IEEE 1,100 20000 1.9e-15 3.9e-17
+ * IEEE 1,10000 30000 2.7e-15 4.0e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtril domain p <= 0 or p > 1 0.0
+ * v < 1
+ */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double incbetl ( long double, long double, long double );
+extern long double incbil ( long double, long double, long double );
+#else
+long double incbetl(), incbil();
+#endif
+
+long double fdtrcl( ia, ib, x )
+int ia, ib;
+long double x;
+{
+long double a, b, w;
+
+if( (ia < 1) || (ib < 1) || (x < 0.0L) )
+ {
+ mtherr( "fdtrcl", DOMAIN );
+ return( 0.0L );
+ }
+a = ia;
+b = ib;
+w = b / (b + a * x);
+return( incbetl( 0.5L*b, 0.5L*a, w ) );
+}
+
+
+
+long double fdtrl( ia, ib, x )
+int ia, ib;
+long double x;
+{
+long double a, b, w;
+
+if( (ia < 1) || (ib < 1) || (x < 0.0L) )
+ {
+ mtherr( "fdtrl", DOMAIN );
+ return( 0.0L );
+ }
+a = ia;
+b = ib;
+w = a * x;
+w = w / (b + w);
+return( incbetl(0.5L*a, 0.5L*b, w) );
+}
+
+
+long double fdtril( ia, ib, y )
+int ia, ib;
+long double y;
+{
+long double a, b, w, x;
+
+if( (ia < 1) || (ib < 1) || (y <= 0.0L) || (y > 1.0L) )
+ {
+ mtherr( "fdtril", DOMAIN );
+ return( 0.0L );
+ }
+a = ia;
+b = ib;
+/* Compute probability for x = 0.5. */
+w = incbetl( 0.5L*b, 0.5L*a, 0.5L );
+/* If that is greater than y, then the solution w < .5.
+ Otherwise, solve at 1-y to remove cancellation in (b - b*w). */
+if( w > y || y < 0.001L)
+ {
+ w = incbil( 0.5L*b, 0.5L*a, y );
+ x = (b - b*w)/(a*w);
+ }
+else
+ {
+ w = incbil( 0.5L*a, 0.5L*b, 1.0L - y );
+ x = b*w/(a*(1.0L-w));
+ }
+return(x);
+}
diff --git a/libm/ldouble/floorl.c b/libm/ldouble/floorl.c
new file mode 100644
index 000000000..1abdfb2cd
--- /dev/null
+++ b/libm/ldouble/floorl.c
@@ -0,0 +1,432 @@
+/* ceill()
+ * floorl()
+ * frexpl()
+ * ldexpl()
+ * fabsl()
+ * signbitl()
+ * isnanl()
+ * isfinitel()
+ *
+ * Floating point numeric utilities
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double ceill(), floorl(), frexpl(), ldexpl(), fabsl();
+ * int signbitl(), isnanl(), isfinitel();
+ * long double x, y;
+ * int expnt, n;
+ *
+ * y = floorl(x);
+ * y = ceill(x);
+ * y = frexpl( x, &expnt );
+ * y = ldexpl( x, n );
+ * y = fabsl( x );
+ * n = signbitl(x);
+ * n = isnanl(x);
+ * n = isfinitel(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The following routines return a long double precision floating point
+ * result:
+ *
+ * floorl() returns the largest integer less than or equal to x.
+ * It truncates toward minus infinity.
+ *
+ * ceill() returns the smallest integer greater than or equal
+ * to x. It truncates toward plus infinity.
+ *
+ * frexpl() extracts the exponent from x. It returns an integer
+ * power of two to expnt and the significand between 0.5 and 1
+ * to y. Thus x = y * 2**expn.
+ *
+ * ldexpl() multiplies x by 2**n.
+ *
+ * fabsl() returns the absolute value of its argument.
+ *
+ * These functions are part of the standard C run time library
+ * for some but not all C compilers. The ones supplied are
+ * written in C for IEEE arithmetic. They should
+ * be used only if your compiler library does not already have
+ * them.
+ *
+ * The IEEE versions assume that denormal numbers are implemented
+ * in the arithmetic. Some modifications will be required if
+ * the arithmetic has abrupt rather than gradual underflow.
+ */
+
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1987, 1988, 1992, 1998 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+/* This is defined in mconf.h. */
+/* #define DENORMAL 1 */
+
+#ifdef UNK
+/* Change UNK into something else. */
+#undef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+#ifdef IBMPC
+#define EXPMSK 0x800f
+#define MEXP 0x7ff
+#define NBITS 64
+#endif
+
+#ifdef MIEEE
+#define EXPMSK 0x800f
+#define MEXP 0x7ff
+#define NBITS 64
+#endif
+
+extern double MAXNUML;
+
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double floorl ( long double );
+extern int isnanl ( long double );
+#else
+long double fabsl(), floorl();
+int isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double fabsl(x)
+long double x;
+{
+union
+ {
+ long double d;
+ short i[6];
+ } u;
+
+u.d = x;
+#ifdef IBMPC
+ u.i[4] &= 0x7fff;
+#endif
+#ifdef MIEEE
+ u.i[0] &= 0x7fff;
+#endif
+return( u.d );
+}
+
+
+
+long double ceill(x)
+long double x;
+{
+long double y;
+
+#ifdef UNK
+mtherr( "ceill", DOMAIN );
+return(0.0L);
+#endif
+#ifdef INFINITIES
+if(x == -INFINITYL)
+ return(x);
+#endif
+#ifdef MINUSZERO
+if(x == 0.0L)
+ return(x);
+#endif
+y = floorl(x);
+if( y < x )
+ y += 1.0L;
+return(y);
+}
+
+
+
+
+/* Bit clearing masks: */
+
+static unsigned short bmask[] = {
+0xffff,
+0xfffe,
+0xfffc,
+0xfff8,
+0xfff0,
+0xffe0,
+0xffc0,
+0xff80,
+0xff00,
+0xfe00,
+0xfc00,
+0xf800,
+0xf000,
+0xe000,
+0xc000,
+0x8000,
+0x0000,
+};
+
+
+
+
+long double floorl(x)
+long double x;
+{
+unsigned short *p;
+union
+ {
+ long double y;
+ unsigned short sh[6];
+ } u;
+int e;
+
+#ifdef UNK
+mtherr( "floor", DOMAIN );
+return(0.0L);
+#endif
+#ifdef INFINITIES
+if( x == INFINITYL )
+ return(x);
+#endif
+#ifdef MINUSZERO
+if(x == 0.0L)
+ return(x);
+#endif
+u.y = x;
+/* find the exponent (power of 2) */
+#ifdef IBMPC
+p = (unsigned short *)&u.sh[4];
+e = (*p & 0x7fff) - 0x3fff;
+p -= 4;
+#endif
+
+#ifdef MIEEE
+p = (unsigned short *)&u.sh[0];
+e = (*p & 0x7fff) - 0x3fff;
+p += 5;
+#endif
+
+if( e < 0 )
+ {
+ if( u.y < 0.0L )
+ return( -1.0L );
+ else
+ return( 0.0L );
+ }
+
+e = (NBITS -1) - e;
+/* clean out 16 bits at a time */
+while( e >= 16 )
+ {
+#ifdef IBMPC
+ *p++ = 0;
+#endif
+
+#ifdef MIEEE
+ *p-- = 0;
+#endif
+ e -= 16;
+ }
+
+/* clear the remaining bits */
+if( e > 0 )
+ *p &= bmask[e];
+
+if( (x < 0) && (u.y != x) )
+ u.y -= 1.0L;
+
+return(u.y);
+}
+
+
+
+long double frexpl( x, pw2 )
+long double x;
+int *pw2;
+{
+union
+ {
+ long double y;
+ unsigned short sh[6];
+ } u;
+int i, k;
+short *q;
+
+u.y = x;
+
+#ifdef NANS
+if(isnanl(x))
+ {
+ *pw2 = 0;
+ return(x);
+ }
+#endif
+#ifdef INFINITIES
+if(x == -INFINITYL)
+ {
+ *pw2 = 0;
+ return(x);
+ }
+#endif
+#ifdef MINUSZERO
+if(x == 0.0L)
+ {
+ *pw2 = 0;
+ return(x);
+ }
+#endif
+
+#ifdef UNK
+mtherr( "frexpl", DOMAIN );
+return(0.0L);
+#endif
+
+/* find the exponent (power of 2) */
+#ifdef IBMPC
+q = (short *)&u.sh[4];
+i = *q & 0x7fff;
+#endif
+
+#ifdef MIEEE
+q = (short *)&u.sh[0];
+i = *q & 0x7fff;
+#endif
+
+if( i == 0 )
+ {
+ if( u.y == 0.0L )
+ {
+ *pw2 = 0;
+ return(0.0L);
+ }
+/* Number is denormal or zero */
+#ifdef DENORMAL
+/* Handle denormal number. */
+do
+ {
+ u.y *= 2.0L;
+ i -= 1;
+ k = *q & 0x7fff;
+ }
+while( (k == 0) && (i > -66) );
+i = i + k;
+#else
+ *pw2 = 0;
+ return(0.0L);
+#endif /* DENORMAL */
+ }
+
+*pw2 = i - 0x3ffe;
+/* *q = 0x3ffe; */
+/* Preserve sign of argument. */
+*q &= 0x8000;
+*q |= 0x3ffe;
+return( u.y );
+}
+
+
+
+
+
+
+long double ldexpl( x, pw2 )
+long double x;
+int pw2;
+{
+union
+ {
+ long double y;
+ unsigned short sh[6];
+ } u;
+unsigned short *q;
+long e;
+
+#ifdef UNK
+mtherr( "ldexp", DOMAIN );
+return(0.0L);
+#endif
+
+u.y = x;
+#ifdef IBMPC
+q = (unsigned short *)&u.sh[4];
+#endif
+#ifdef MIEEE
+q = (unsigned short *)&u.sh[0];
+#endif
+while( (e = (*q & 0x7fffL)) == 0 )
+ {
+#ifdef DENORMAL
+ if( u.y == 0.0L )
+ {
+ return( 0.0L );
+ }
+/* Input is denormal. */
+ if( pw2 > 0 )
+ {
+ u.y *= 2.0L;
+ pw2 -= 1;
+ }
+ if( pw2 < 0 )
+ {
+ if( pw2 < -64 )
+ return(0.0L);
+ u.y *= 0.5L;
+ pw2 += 1;
+ }
+ if( pw2 == 0 )
+ return(u.y);
+#else
+ return( 0.0L );
+#endif
+ }
+
+e = e + pw2;
+
+/* Handle overflow */
+if( e > 0x7fffL )
+ {
+ return( MAXNUML );
+ }
+*q &= 0x8000;
+/* Handle denormalized results */
+if( e < 1 )
+ {
+#ifdef DENORMAL
+ if( e < -64 )
+ return(0.0L);
+
+#ifdef IBMPC
+ *(q-1) |= 0x8000;
+#endif
+#ifdef MIEEE
+ *(q+2) |= 0x8000;
+#endif
+
+ while( e < 1 )
+ {
+ u.y *= 0.5L;
+ e += 1;
+ }
+ e = 0;
+#else
+ return(0.0L);
+#endif
+ }
+
+*q |= (unsigned short) e & 0x7fff;
+return(u.y);
+}
+
diff --git a/libm/ldouble/flrtstl.c b/libm/ldouble/flrtstl.c
new file mode 100644
index 000000000..77a389324
--- /dev/null
+++ b/libm/ldouble/flrtstl.c
@@ -0,0 +1,104 @@
+long double floorl(), ldexpl(), frexpl();
+
+#define N 16382
+void prnum();
+int printf();
+void exit();
+
+void main()
+{
+long double x, f, y, last, z, z0, y1;
+int i, k, e, e0, errs;
+
+errs = 0;
+f = 0.1L;
+x = f;
+last = x;
+z0 = frexpl( x, &e0 );
+printf( "frexpl(%.2Le) = %.5Le, %d\n", x, z0, e0 );
+k = 0;
+for( i=0; i<N+5; i++ )
+ {
+ y = ldexpl( f, k );
+ if( y != x )
+ {
+ printf( "ldexpl(%.1Le, %d) = %.5Le, s.b. %.5Le\n",
+ f, k, y, x );
+ ++errs;
+ }
+ z = frexpl( y, &e );
+ if( (e != k+e0) || (z != z0) )
+ {
+ printf( "frexpl(%.1Le) = %.5Le, %d; s.b. %.5Le, %d\n",
+ y, z, e, z0, k+e0 );
+ ++errs;
+ }
+ x += x;
+ if( x == last )
+ break;
+ last = x;
+ k += 1;
+ }
+printf( "i = %d\n", k );
+prnum( "last y =", &y );
+printf("\n");
+
+f = 0.1L;
+x = f;
+last = x;
+k = 0;
+for( i=0; i<N+64; i++ )
+ {
+ y = ldexpl( f, k );
+ if( y != x )
+ {
+ printf( "ldexpl(%.1Le, %d) = %.5Le, s.b. %.5Le\n",
+ f, k, y, x );
+ ++errs;
+ }
+ z = frexpl( y, &e );
+ if(
+#if 1
+ (e > -N+1) &&
+#endif
+ ((e != k+e0) || (z != z0)) )
+ {
+ printf( "frexpl(%.1Le) = %.5Le, %d; s.b. %.5Le, %d\n",
+ y, z, e, z0, k+e0 );
+ ++errs;
+ }
+ y1 = ldexpl( z, e );
+ if( y1 != y )
+ {
+ printf( "ldexpl(%.1Le, %d) = %.5Le, s.b. %.5Le\n",
+ z, e, y1, y );
+ ++errs;
+ }
+
+ x *= 0.5L;
+ if( x == 0.0L )
+ break;
+ if( x == last )
+ break;
+ last = x;
+ k -= 1;
+ }
+printf( "i = %d\n", k );
+prnum( "last y =", &y );
+
+printf( "\n%d errors\n", errs );
+exit(0);
+}
+
+
+void prnum(str, x)
+char *str;
+unsigned short *x;
+{
+int i;
+
+printf( "%s ", str );
+printf( "%.5Le = ", *(long double *)x );
+for( i=0; i<5; i++ )
+ printf( "%04x ", *x++ );
+}
diff --git a/libm/ldouble/fltestl.c b/libm/ldouble/fltestl.c
new file mode 100644
index 000000000..963e92467
--- /dev/null
+++ b/libm/ldouble/fltestl.c
@@ -0,0 +1,265 @@
+/* fltest.c
+ * Test program for floor(), frexp(), ldexp()
+ */
+
+/*
+Cephes Math Library Release 2.1: December, 1988
+Copyright 1984, 1987, 1988 by Stephen L. Moshier (moshier@world.std.com)
+*/
+
+
+
+/*#include <math.h>*/
+#define MACHEPL 5.42101086242752217003726400434970855712890625E-20L
+#define N 16300
+
+void flierr();
+int printf();
+void exit();
+
+int
+main()
+{
+long double x, y, y0, z, f, x00, y00;
+int i, j, e, e0;
+int errfr, errld, errfl, underexp, err, errth, e00;
+long double frexpl(), ldexpl(), floorl();
+
+
+/*
+if( 1 )
+ goto flrtst;
+*/
+
+printf( "Testing frexpl() and ldexpl().\n" );
+errth = 0.0L;
+errfr = 0;
+errld = 0;
+underexp = 0;
+f = 1.0L;
+x00 = 2.0L;
+y00 = 0.5L;
+e00 = 2;
+
+for( j=0; j<20; j++ )
+{
+if( j == 10 )
+ {
+ f = 1.0L;
+ x00 = 2.0L;
+ e00 = 1;
+/* Find 2**(2**14) / 2 */
+ for( i=0; i<13; i++ )
+ {
+ x00 *= x00;
+ e00 += e00;
+ }
+ y00 = x00/2.0L;
+ x00 = x00 * y00;
+ e00 += e00;
+ y00 = 0.5L;
+ }
+x = x00 * f;
+y0 = y00 * f;
+e0 = e00;
+
+#if 1
+/* If ldexp, frexp support denormal numbers, this should work. */
+for( i=0; i<16448; i++ )
+#else
+for( i=0; i<16383; i++ )
+#endif
+ {
+ x /= 2.0L;
+ e0 -= 1;
+ if( x == 0.0L )
+ {
+ if( f == 1.0L )
+ underexp = e0;
+ y0 = 0.0L;
+ e0 = 0;
+ }
+ y = frexpl( x, &e );
+ if( (e0 < -16383) && (e != e0) )
+ {
+ if( e == (e0 - 1) )
+ {
+ e += 1;
+ y /= 2.0L;
+ }
+ if( e == (e0 + 1) )
+ {
+ e -= 1;
+ y *= 2.0L;
+ }
+ }
+ err = y - y0;
+ if( y0 != 0.0L )
+ err /= y0;
+ if( err < 0.0L )
+ err = -err;
+ if( e0 > -1023 )
+ errth = 0.0L;
+ else
+ {/* Denormal numbers may have rounding errors */
+ if( e0 == -16383 )
+ {
+ errth = 2.0L * MACHEPL;
+ }
+ else
+ {
+ errth *= 2.0L;
+ }
+ }
+
+ if( (x != 0.0L) && ((err > errth) || (e != e0)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( " frexpl( %.20Le) =?= %.20Le * 2**%d;", x, y, e );
+ printf( " should be %.20Le * 2**%d\n", y0, e0 );
+ errfr += 1;
+ }
+ y = ldexpl( x, 1-e0 );
+ err = y - 1.0L;
+ if( err < 0.0L )
+ err = -err;
+ if( (err > errth) && ((x == 0.0L) && (y != 0.0L)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( "ldexpl( %.15Le, %d ) =?= %.15Le;", x, 1-e0, y );
+ if( x != 0.0L )
+ printf( " should be %.15Le\n", f );
+ else
+ printf( " should be %.15Le\n", 0.0L );
+ errld += 1;
+ }
+ if( x == 0.0L )
+ {
+ break;
+ }
+ }
+f = f * 1.08005973889L;
+}
+
+if( (errld == 0) && (errfr == 0) )
+ {
+ printf( "No errors found.\n" );
+ }
+
+/*flrtst:*/
+
+printf( "Testing floorl().\n" );
+errfl = 0;
+
+f = 1.0L/MACHEPL;
+x00 = 1.0L;
+for( j=0; j<57; j++ )
+{
+x = x00 - 1.0L;
+for( i=0; i<128; i++ )
+ {
+ y = floorl(x);
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+/* Warning! the if() statement is compiler dependent,
+ * since x-0.49 may be held in extra precision accumulator
+ * so would never compare equal to x! The subroutine call
+ * y = floor() forces z to be stored as a double and reloaded
+ * for the if() statement.
+ */
+ z = x - 0.49L;
+ y = floorl(z);
+ if( z == x )
+ break;
+ if( y != (x - 1.0L) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+
+ z = x + 0.49L;
+ y = floorl(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ y = floorl(x);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+ }
+ z = x + 0.49L;
+ y = floorl(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ z = x - 0.49L;
+ y = floorl(z);
+ if( z != x )
+ {
+ if( y != (x - 1.0L) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ x += 1.0L;
+ }
+x00 = x00 + x00;
+}
+y = floorl(0.0L);
+if( y != 0.0L )
+ {
+ flierr( 0.0L, y, 57 );
+ errfl += 1;
+ }
+y = floorl(-0.0L);
+if( y != 0.0L )
+ {
+ flierr( -0.0L, y, 58 );
+ errfl += 1;
+ }
+y = floorl(-1.0L);
+if( y != -1.0L )
+ {
+ flierr( -1.0L, y, 59 );
+ errfl += 1;
+ }
+y = floorl(-0.1L);
+if( y != -1.0l )
+ {
+ flierr( -0.1L, y, 60 );
+ errfl += 1;
+ }
+
+if( errfl == 0 )
+ printf( "No errors found in floorl().\n" );
+exit(0);
+return 0;
+}
+
+void flierr( x, y, k )
+long double x, y;
+int k;
+{
+printf( "Test %d: ", k+1 );
+printf( "floorl(%.15Le) =?= %.15Le\n", x, y );
+}
diff --git a/libm/ldouble/gammal.c b/libm/ldouble/gammal.c
new file mode 100644
index 000000000..de7ed89a2
--- /dev/null
+++ b/libm/ldouble/gammal.c
@@ -0,0 +1,764 @@
+/* gammal.c
+ *
+ * Gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, gammal();
+ * extern int sgngam;
+ *
+ * y = gammal( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns gamma function of the argument. The result is
+ * correctly signed, and the sign (+1 or -1) is also
+ * returned in a global (extern) variable named sgngam.
+ * This variable is also filled in by the logarithmic gamma
+ * function lgam().
+ *
+ * Arguments |x| <= 13 are reduced by recurrence and the function
+ * approximated by a rational function of degree 7/8 in the
+ * interval (2,3). Large arguments are handled by Stirling's
+ * formula. Large negative arguments are made positive using
+ * a reflection formula.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -40,+40 10000 3.6e-19 7.9e-20
+ * IEEE -1755,+1755 10000 4.8e-18 6.5e-19
+ *
+ * Accuracy for large arguments is dominated by error in powl().
+ *
+ */
+/* lgaml()
+ *
+ * Natural logarithm of gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, lgaml();
+ * extern int sgngam;
+ *
+ * y = lgaml( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of the absolute
+ * value of the gamma function of the argument.
+ * The sign (+1 or -1) of the gamma function is returned in a
+ * global (extern) variable named sgngam.
+ *
+ * For arguments greater than 33, the logarithm of the gamma
+ * function is approximated by the logarithmic version of
+ * Stirling's formula using a polynomial approximation of
+ * degree 4. Arguments between -33 and +33 are reduced by
+ * recurrence to the interval [2,3] of a rational approximation.
+ * The cosecant reflection formula is employed for arguments
+ * less than -33.
+ *
+ * Arguments greater than MAXLGML (10^4928) return MAXNUML.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE -40, 40 100000 2.2e-19 4.6e-20
+ * IEEE 10^-2000,10^+2000 20000 1.6e-19 3.3e-20
+ * The error criterion was relative when the function magnitude
+ * was greater than one but absolute when it was less than one.
+ *
+ */
+
+/* gamma.c */
+/* gamma function */
+
+/*
+Copyright 1994 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+/*
+gamma(x+2) = gamma(x+2) P(x)/Q(x)
+0 <= x <= 1
+Relative error
+n=7, d=8
+Peak error = 1.83e-20
+Relative error spread = 8.4e-23
+*/
+#if UNK
+static long double P[8] = {
+ 4.212760487471622013093E-5L,
+ 4.542931960608009155600E-4L,
+ 4.092666828394035500949E-3L,
+ 2.385363243461108252554E-2L,
+ 1.113062816019361559013E-1L,
+ 3.629515436640239168939E-1L,
+ 8.378004301573126728826E-1L,
+ 1.000000000000000000009E0L,
+};
+static long double Q[9] = {
+-1.397148517476170440917E-5L,
+ 2.346584059160635244282E-4L,
+-1.237799246653152231188E-3L,
+-7.955933682494738320586E-4L,
+ 2.773706565840072979165E-2L,
+-4.633887671244534213831E-2L,
+-2.243510905670329164562E-1L,
+ 4.150160950588455434583E-1L,
+ 9.999999999999999999908E-1L,
+};
+#endif
+#if IBMPC
+static short P[] = {
+0x434a,0x3f22,0x2bda,0xb0b2,0x3ff0, XPD
+0xf5aa,0xe82f,0x335b,0xee2e,0x3ff3, XPD
+0xbe6c,0x3757,0xc717,0x861b,0x3ff7, XPD
+0x7f43,0x5196,0xb166,0xc368,0x3ff9, XPD
+0x9549,0x8eb5,0x8c3a,0xe3f4,0x3ffb, XPD
+0x8d75,0x23af,0xc8e4,0xb9d4,0x3ffd, XPD
+0x29cf,0x19b3,0x16c8,0xd67a,0x3ffe, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+static short Q[] = {
+0x5473,0x2de8,0x1268,0xea67,0xbfee, XPD
+0x334b,0xc2f0,0xa2dd,0xf60e,0x3ff2, XPD
+0xbeed,0x1853,0xa691,0xa23d,0xbff5, XPD
+0x296e,0x7cb1,0x5dfd,0xd08f,0xbff4, XPD
+0x0417,0x7989,0xd7bc,0xe338,0x3ff9, XPD
+0x3295,0x3698,0xd580,0xbdcd,0xbffa, XPD
+0x75ef,0x3ab7,0x4ad3,0xe5bc,0xbffc, XPD
+0xe458,0x2ec7,0xfd57,0xd47c,0x3ffd, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+#endif
+#if MIEEE
+static long P[24] = {
+0x3ff00000,0xb0b22bda,0x3f22434a,
+0x3ff30000,0xee2e335b,0xe82ff5aa,
+0x3ff70000,0x861bc717,0x3757be6c,
+0x3ff90000,0xc368b166,0x51967f43,
+0x3ffb0000,0xe3f48c3a,0x8eb59549,
+0x3ffd0000,0xb9d4c8e4,0x23af8d75,
+0x3ffe0000,0xd67a16c8,0x19b329cf,
+0x3fff0000,0x80000000,0x00000000,
+};
+static long Q[27] = {
+0xbfee0000,0xea671268,0x2de85473,
+0x3ff20000,0xf60ea2dd,0xc2f0334b,
+0xbff50000,0xa23da691,0x1853beed,
+0xbff40000,0xd08f5dfd,0x7cb1296e,
+0x3ff90000,0xe338d7bc,0x79890417,
+0xbffa0000,0xbdcdd580,0x36983295,
+0xbffc0000,0xe5bc4ad3,0x3ab775ef,
+0x3ffd0000,0xd47cfd57,0x2ec7e458,
+0x3fff0000,0x80000000,0x00000000,
+};
+#endif
+/*
+static long double P[] = {
+-3.01525602666895735709e0L,
+-3.25157411956062339893e1L,
+-2.92929976820724030353e2L,
+-1.70730828800510297666e3L,
+-7.96667499622741999770e3L,
+-2.59780216007146401957e4L,
+-5.99650230220855581642e4L,
+-7.15743521530849602425e4L
+};
+static long double Q[] = {
+ 1.00000000000000000000e0L,
+-1.67955233807178858919e1L,
+ 8.85946791747759881659e1L,
+ 5.69440799097468430177e1L,
+-1.98526250512761318471e3L,
+ 3.31667508019495079814e3L,
+ 1.60577839621734713377e4L,
+-2.97045081369399940529e4L,
+-7.15743521530849602412e4L
+};
+*/
+#define MAXGAML 1755.455L
+/*static long double LOGPI = 1.14472988584940017414L;*/
+
+/* Stirling's formula for the gamma function
+gamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x))
+z(x) = x
+13 <= x <= 1024
+Relative error
+n=8, d=0
+Peak error = 9.44e-21
+Relative error spread = 8.8e-4
+*/
+#if UNK
+static long double STIR[9] = {
+ 7.147391378143610789273E-4L,
+-2.363848809501759061727E-5L,
+-5.950237554056330156018E-4L,
+ 6.989332260623193171870E-5L,
+ 7.840334842744753003862E-4L,
+-2.294719747873185405699E-4L,
+-2.681327161876304418288E-3L,
+ 3.472222222230075327854E-3L,
+ 8.333333333333331800504E-2L,
+};
+#endif
+#if IBMPC
+static short STIR[] = {
+0x6ede,0x69f7,0x54e3,0xbb5d,0x3ff4, XPD
+0xc395,0x0295,0x4443,0xc64b,0xbfef, XPD
+0xba6f,0x7c59,0x5e47,0x9bfb,0xbff4, XPD
+0x5704,0x1a39,0xb11d,0x9293,0x3ff1, XPD
+0x30b7,0x1a21,0x98b2,0xcd87,0x3ff4, XPD
+0xbef3,0x7023,0x6a08,0xf09e,0xbff2, XPD
+0x3a1c,0x5ac8,0x3478,0xafb9,0xbff6, XPD
+0xc3c9,0x906e,0x38e3,0xe38e,0x3ff6, XPD
+0xa1d5,0xaaaa,0xaaaa,0xaaaa,0x3ffb, XPD
+};
+#endif
+#if MIEEE
+static long STIR[27] = {
+0x3ff40000,0xbb5d54e3,0x69f76ede,
+0xbfef0000,0xc64b4443,0x0295c395,
+0xbff40000,0x9bfb5e47,0x7c59ba6f,
+0x3ff10000,0x9293b11d,0x1a395704,
+0x3ff40000,0xcd8798b2,0x1a2130b7,
+0xbff20000,0xf09e6a08,0x7023bef3,
+0xbff60000,0xafb93478,0x5ac83a1c,
+0x3ff60000,0xe38e38e3,0x906ec3c9,
+0x3ffb0000,0xaaaaaaaa,0xaaaaa1d5,
+};
+#endif
+#define MAXSTIR 1024.0L
+static long double SQTPI = 2.50662827463100050242E0L;
+
+/* 1/gamma(x) = z P(z)
+ * z(x) = 1/x
+ * 0 < x < 0.03125
+ * Peak relative error 4.2e-23
+ */
+#if UNK
+static long double S[9] = {
+-1.193945051381510095614E-3L,
+ 7.220599478036909672331E-3L,
+-9.622023360406271645744E-3L,
+-4.219773360705915470089E-2L,
+ 1.665386113720805206758E-1L,
+-4.200263503403344054473E-2L,
+-6.558780715202540684668E-1L,
+ 5.772156649015328608253E-1L,
+ 1.000000000000000000000E0L,
+};
+#endif
+#if IBMPC
+static short S[] = {
+0xbaeb,0xd6d3,0x25e5,0x9c7e,0xbff5, XPD
+0xfe9a,0xceb4,0xc74e,0xec9a,0x3ff7, XPD
+0x9225,0xdfef,0xb0e9,0x9da5,0xbff8, XPD
+0x10b0,0xec17,0x87dc,0xacd7,0xbffa, XPD
+0x6b8d,0x7515,0x1905,0xaa89,0x3ffc, XPD
+0xf183,0x126b,0xf47d,0xac0a,0xbffa, XPD
+0x7bf6,0x57d1,0xa013,0xa7e7,0xbffe, XPD
+0xc7a9,0x7db0,0x67e3,0x93c4,0x3ffe, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+#endif
+#if MIEEE
+static long S[27] = {
+0xbff50000,0x9c7e25e5,0xd6d3baeb,
+0x3ff70000,0xec9ac74e,0xceb4fe9a,
+0xbff80000,0x9da5b0e9,0xdfef9225,
+0xbffa0000,0xacd787dc,0xec1710b0,
+0x3ffc0000,0xaa891905,0x75156b8d,
+0xbffa0000,0xac0af47d,0x126bf183,
+0xbffe0000,0xa7e7a013,0x57d17bf6,
+0x3ffe0000,0x93c467e3,0x7db0c7a9,
+0x3fff0000,0x80000000,0x00000000,
+};
+#endif
+/* 1/gamma(-x) = z P(z)
+ * z(x) = 1/x
+ * 0 < x < 0.03125
+ * Peak relative error 5.16e-23
+ * Relative error spread = 2.5e-24
+ */
+#if UNK
+static long double SN[9] = {
+ 1.133374167243894382010E-3L,
+ 7.220837261893170325704E-3L,
+ 9.621911155035976733706E-3L,
+-4.219773343731191721664E-2L,
+-1.665386113944413519335E-1L,
+-4.200263503402112910504E-2L,
+ 6.558780715202536547116E-1L,
+ 5.772156649015328608727E-1L,
+-1.000000000000000000000E0L,
+};
+#endif
+#if IBMPC
+static short SN[] = {
+0x5dd1,0x02de,0xb9f7,0x948d,0x3ff5, XPD
+0x989b,0xdd68,0xc5f1,0xec9c,0x3ff7, XPD
+0x2ca1,0x18f0,0x386f,0x9da5,0x3ff8, XPD
+0x783f,0x41dd,0x87d1,0xacd7,0xbffa, XPD
+0x7a5b,0xd76d,0x1905,0xaa89,0xbffc, XPD
+0x7f64,0x1234,0xf47d,0xac0a,0xbffa, XPD
+0x5e26,0x57d1,0xa013,0xa7e7,0x3ffe, XPD
+0xc7aa,0x7db0,0x67e3,0x93c4,0x3ffe, XPD
+0x0000,0x0000,0x0000,0x8000,0xbfff, XPD
+};
+#endif
+#if MIEEE
+static long SN[27] = {
+0x3ff50000,0x948db9f7,0x02de5dd1,
+0x3ff70000,0xec9cc5f1,0xdd68989b,
+0x3ff80000,0x9da5386f,0x18f02ca1,
+0xbffa0000,0xacd787d1,0x41dd783f,
+0xbffc0000,0xaa891905,0xd76d7a5b,
+0xbffa0000,0xac0af47d,0x12347f64,
+0x3ffe0000,0xa7e7a013,0x57d15e26,
+0x3ffe0000,0x93c467e3,0x7db0c7aa,
+0xbfff0000,0x80000000,0x00000000,
+};
+#endif
+
+int sgngaml = 0;
+extern int sgngaml;
+extern long double MAXLOGL, MAXNUML, PIL;
+/* #define PIL 3.14159265358979323846L */
+/* #define MAXNUML 1.189731495357231765021263853E4932L */
+
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double lgaml ( long double );
+extern long double logl ( long double );
+extern long double expl ( long double );
+extern long double gammal ( long double );
+extern long double sinl ( long double );
+extern long double floorl ( long double );
+extern long double powl ( long double, long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+extern int isfinitel ( long double );
+static long double stirf ( long double );
+#else
+long double fabsl(), lgaml(), logl(), expl(), gammal(), sinl();
+long double floorl(), powl(), polevll(), p1evll(), isnanl(), isfinitel();
+static long double stirf();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+/* Gamma function computed by Stirling's formula.
+ */
+static long double stirf(x)
+long double x;
+{
+long double y, w, v;
+
+w = 1.0L/x;
+/* For large x, use rational coefficients from the analytical expansion. */
+if( x > 1024.0L )
+ w = (((((6.97281375836585777429E-5L * w
+ + 7.84039221720066627474E-4L) * w
+ - 2.29472093621399176955E-4L) * w
+ - 2.68132716049382716049E-3L) * w
+ + 3.47222222222222222222E-3L) * w
+ + 8.33333333333333333333E-2L) * w
+ + 1.0L;
+else
+ w = 1.0L + w * polevll( w, STIR, 8 );
+y = expl(x);
+if( x > MAXSTIR )
+ { /* Avoid overflow in pow() */
+ v = powl( x, 0.5L * x - 0.25L );
+ y = v * (v / y);
+ }
+else
+ {
+ y = powl( x, x - 0.5L ) / y;
+ }
+y = SQTPI * y * w;
+return( y );
+}
+
+
+
+long double gammal(x)
+long double x;
+{
+long double p, q, z;
+int i;
+
+sgngaml = 1;
+#ifdef NANS
+if( isnanl(x) )
+ return(NANL);
+#endif
+#ifdef INFINITIES
+if(x == INFINITYL)
+ return(INFINITYL);
+#ifdef NANS
+if(x == -INFINITYL)
+ goto gamnan;
+#endif
+#endif
+q = fabsl(x);
+
+if( q > 13.0L )
+ {
+ if( q > MAXGAML )
+ goto goverf;
+ if( x < 0.0L )
+ {
+ p = floorl(q);
+ if( p == q )
+ {
+gamnan:
+#ifdef NANS
+ mtherr( "gammal", DOMAIN );
+ return (NANL);
+#else
+ goto goverf;
+#endif
+ }
+ i = p;
+ if( (i & 1) == 0 )
+ sgngaml = -1;
+ z = q - p;
+ if( z > 0.5L )
+ {
+ p += 1.0L;
+ z = q - p;
+ }
+ z = q * sinl( PIL * z );
+ z = fabsl(z) * stirf(q);
+ if( z <= PIL/MAXNUML )
+ {
+goverf:
+#ifdef INFINITIES
+ return( sgngaml * INFINITYL);
+#else
+ mtherr( "gammal", OVERFLOW );
+ return( sgngaml * MAXNUML);
+#endif
+ }
+ z = PIL/z;
+ }
+ else
+ {
+ z = stirf(x);
+ }
+ return( sgngaml * z );
+ }
+
+z = 1.0L;
+while( x >= 3.0L )
+ {
+ x -= 1.0L;
+ z *= x;
+ }
+
+while( x < -0.03125L )
+ {
+ z /= x;
+ x += 1.0L;
+ }
+
+if( x <= 0.03125L )
+ goto small;
+
+while( x < 2.0L )
+ {
+ z /= x;
+ x += 1.0L;
+ }
+
+if( x == 2.0L )
+ return(z);
+
+x -= 2.0L;
+p = polevll( x, P, 7 );
+q = polevll( x, Q, 8 );
+return( z * p / q );
+
+small:
+if( x == 0.0L )
+ {
+ goto gamnan;
+ }
+else
+ {
+ if( x < 0.0L )
+ {
+ x = -x;
+ q = z / (x * polevll( x, SN, 8 ));
+ }
+ else
+ q = z / (x * polevll( x, S, 8 ));
+ }
+return q;
+}
+
+
+
+/* A[]: Stirling's formula expansion of log gamma
+ * B[], C[]: log gamma function between 2 and 3
+ */
+
+
+/* log gamma(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x A(1/x^2)
+ * x >= 8
+ * Peak relative error 1.51e-21
+ * Relative spread of error peaks 5.67e-21
+ */
+#if UNK
+static long double A[7] = {
+ 4.885026142432270781165E-3L,
+-1.880801938119376907179E-3L,
+ 8.412723297322498080632E-4L,
+-5.952345851765688514613E-4L,
+ 7.936507795855070755671E-4L,
+-2.777777777750349603440E-3L,
+ 8.333333333333331447505E-2L,
+};
+#endif
+#if IBMPC
+static short A[] = {
+0xd984,0xcc08,0x91c2,0xa012,0x3ff7, XPD
+0x3d91,0x0304,0x3da1,0xf685,0xbff5, XPD
+0x3bdc,0xaad1,0xd492,0xdc88,0x3ff4, XPD
+0x8b20,0x9fce,0x844e,0x9c09,0xbff4, XPD
+0xf8f2,0x30e5,0x0092,0xd00d,0x3ff4, XPD
+0x4d88,0x03a8,0x60b6,0xb60b,0xbff6, XPD
+0x9fcc,0xaaaa,0xaaaa,0xaaaa,0x3ffb, XPD
+};
+#endif
+#if MIEEE
+static long A[21] = {
+0x3ff70000,0xa01291c2,0xcc08d984,
+0xbff50000,0xf6853da1,0x03043d91,
+0x3ff40000,0xdc88d492,0xaad13bdc,
+0xbff40000,0x9c09844e,0x9fce8b20,
+0x3ff40000,0xd00d0092,0x30e5f8f2,
+0xbff60000,0xb60b60b6,0x03a84d88,
+0x3ffb0000,0xaaaaaaaa,0xaaaa9fcc,
+};
+#endif
+
+/* log gamma(x+2) = x B(x)/C(x)
+ * 0 <= x <= 1
+ * Peak relative error 7.16e-22
+ * Relative spread of error peaks 4.78e-20
+ */
+#if UNK
+static long double B[7] = {
+-2.163690827643812857640E3L,
+-8.723871522843511459790E4L,
+-1.104326814691464261197E6L,
+-6.111225012005214299996E6L,
+-1.625568062543700591014E7L,
+-2.003937418103815175475E7L,
+-8.875666783650703802159E6L,
+};
+static long double C[7] = {
+/* 1.000000000000000000000E0L,*/
+-5.139481484435370143617E2L,
+-3.403570840534304670537E4L,
+-6.227441164066219501697E5L,
+-4.814940379411882186630E6L,
+-1.785433287045078156959E7L,
+-3.138646407656182662088E7L,
+-2.099336717757895876142E7L,
+};
+#endif
+#if IBMPC
+static short B[] = {
+0x9557,0x4995,0x0da1,0x873b,0xc00a, XPD
+0xfe44,0x9af8,0x5b8c,0xaa63,0xc00f, XPD
+0x5aa8,0x7cf5,0x3684,0x86ce,0xc013, XPD
+0x259a,0x258c,0xf206,0xba7f,0xc015, XPD
+0xbe18,0x1ca3,0xc0a0,0xf80a,0xc016, XPD
+0x168f,0x2c42,0x6717,0x98e3,0xc017, XPD
+0x2051,0x9d55,0x92c8,0x876e,0xc016, XPD
+};
+static short C[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xaa77,0xcf2f,0xae76,0x807c,0xc008, XPD
+0xb280,0x0d74,0xb55a,0x84f3,0xc00e, XPD
+0xa505,0xcd30,0x81dc,0x9809,0xc012, XPD
+0x3369,0x4246,0xb8c2,0x92f0,0xc015, XPD
+0x63cf,0x6aee,0xbe6f,0x8837,0xc017, XPD
+0x26bb,0xccc7,0xb009,0xef75,0xc017, XPD
+0x462b,0xbae8,0xab96,0xa02a,0xc017, XPD
+};
+#endif
+#if MIEEE
+static long B[21] = {
+0xc00a0000,0x873b0da1,0x49959557,
+0xc00f0000,0xaa635b8c,0x9af8fe44,
+0xc0130000,0x86ce3684,0x7cf55aa8,
+0xc0150000,0xba7ff206,0x258c259a,
+0xc0160000,0xf80ac0a0,0x1ca3be18,
+0xc0170000,0x98e36717,0x2c42168f,
+0xc0160000,0x876e92c8,0x9d552051,
+};
+static long C[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0080000,0x807cae76,0xcf2faa77,
+0xc00e0000,0x84f3b55a,0x0d74b280,
+0xc0120000,0x980981dc,0xcd30a505,
+0xc0150000,0x92f0b8c2,0x42463369,
+0xc0170000,0x8837be6f,0x6aee63cf,
+0xc0170000,0xef75b009,0xccc726bb,
+0xc0170000,0xa02aab96,0xbae8462b,
+};
+#endif
+
+/* log( sqrt( 2*pi ) ) */
+static long double LS2PI = 0.91893853320467274178L;
+#define MAXLGM 1.04848146839019521116e+4928L
+
+
+/* Logarithm of gamma function */
+
+
+long double lgaml(x)
+long double x;
+{
+long double p, q, w, z, f, nx;
+int i;
+
+sgngaml = 1;
+#ifdef NANS
+if( isnanl(x) )
+ return(NANL);
+#endif
+#ifdef INFINITIES
+if( !isfinitel(x) )
+ return(INFINITYL);
+#endif
+if( x < -34.0L )
+ {
+ q = -x;
+ w = lgaml(q); /* note this modifies sgngam! */
+ p = floorl(q);
+ if( p == q )
+ {
+#ifdef INFINITIES
+ mtherr( "lgaml", SING );
+ return (INFINITYL);
+#else
+ goto loverf;
+#endif
+ }
+ i = p;
+ if( (i & 1) == 0 )
+ sgngaml = -1;
+ else
+ sgngaml = 1;
+ z = q - p;
+ if( z > 0.5L )
+ {
+ p += 1.0L;
+ z = p - q;
+ }
+ z = q * sinl( PIL * z );
+ if( z == 0.0L )
+ goto loverf;
+/* z = LOGPI - logl( z ) - w; */
+ z = logl( PIL/z ) - w;
+ return( z );
+ }
+
+if( x < 13.0L )
+ {
+ z = 1.0L;
+ nx = floorl( x + 0.5L );
+ f = x - nx;
+ while( x >= 3.0L )
+ {
+ nx -= 1.0L;
+ x = nx + f;
+ z *= x;
+ }
+ while( x < 2.0L )
+ {
+ if( fabsl(x) <= 0.03125 )
+ goto lsmall;
+ z /= nx + f;
+ nx += 1.0L;
+ x = nx + f;
+ }
+ if( z < 0.0L )
+ {
+ sgngaml = -1;
+ z = -z;
+ }
+ else
+ sgngaml = 1;
+ if( x == 2.0L )
+ return( logl(z) );
+ x = (nx - 2.0L) + f;
+ p = x * polevll( x, B, 6 ) / p1evll( x, C, 7);
+ return( logl(z) + p );
+ }
+
+if( x > MAXLGM )
+ {
+loverf:
+#ifdef INFINITIES
+ return( sgngaml * INFINITYL );
+#else
+ mtherr( "lgaml", OVERFLOW );
+ return( sgngaml * MAXNUML );
+#endif
+ }
+
+q = ( x - 0.5L ) * logl(x) - x + LS2PI;
+if( x > 1.0e10L )
+ return(q);
+p = 1.0L/(x*x);
+q += polevll( p, A, 6 ) / x;
+return( q );
+
+
+lsmall:
+if( x == 0.0L )
+ goto loverf;
+if( x < 0.0L )
+ {
+ x = -x;
+ q = z / (x * polevll( x, SN, 8 ));
+ }
+else
+ q = z / (x * polevll( x, S, 8 ));
+if( q < 0.0L )
+ {
+ sgngaml = -1;
+ q = -q;
+ }
+else
+ sgngaml = 1;
+q = logl( q );
+return(q);
+}
diff --git a/libm/ldouble/gdtrl.c b/libm/ldouble/gdtrl.c
new file mode 100644
index 000000000..9a41790cb
--- /dev/null
+++ b/libm/ldouble/gdtrl.c
@@ -0,0 +1,130 @@
+/* gdtrl.c
+ *
+ * Gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, gdtrl();
+ *
+ * y = gdtrl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the integral from zero to x of the gamma probability
+ * density function:
+ *
+ *
+ * x
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * 0
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = igam( b, ax ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrl domain x < 0 0.0
+ *
+ */
+ /* gdtrcl.c
+ *
+ * Complemented gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, gdtrcl();
+ *
+ * y = gdtrcl( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the integral from x to infinity of the gamma
+ * probability density function:
+ *
+ *
+ * inf.
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * x
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = igamc( b, ax ).
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrcl domain x < 0 0.0
+ *
+ */
+
+/* gdtrl() */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double igaml ( long double, long double );
+extern long double igamcl ( long double, long double );
+#else
+long double igaml(), igamcl();
+#endif
+
+long double gdtrl( a, b, x )
+long double a, b, x;
+{
+
+if( x < 0.0L )
+ {
+ mtherr( "gdtrl", DOMAIN );
+ return( 0.0L );
+ }
+return( igaml( b, a * x ) );
+}
+
+
+
+long double gdtrcl( a, b, x )
+long double a, b, x;
+{
+
+if( x < 0.0L )
+ {
+ mtherr( "gdtrcl", DOMAIN );
+ return( 0.0L );
+ }
+return( igamcl( b, a * x ) );
+}
diff --git a/libm/ldouble/gelsl.c b/libm/ldouble/gelsl.c
new file mode 100644
index 000000000..d66ad55e9
--- /dev/null
+++ b/libm/ldouble/gelsl.c
@@ -0,0 +1,240 @@
+/*
+C
+C ..................................................................
+C
+C SUBROUTINE GELS
+C
+C PURPOSE
+C TO SOLVE A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH
+C SYMMETRIC COEFFICIENT MATRIX UPPER TRIANGULAR PART OF WHICH
+C IS ASSUMED TO BE STORED COLUMNWISE.
+C
+C USAGE
+C CALL GELS(R,A,M,N,EPS,IER,AUX)
+C
+C DESCRIPTION OF PARAMETERS
+C R - M BY N RIGHT HAND SIDE MATRIX. (DESTROYED)
+C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS.
+C A - UPPER TRIANGULAR PART OF THE SYMMETRIC
+C M BY M COEFFICIENT MATRIX. (DESTROYED)
+C M - THE NUMBER OF EQUATIONS IN THE SYSTEM.
+C N - THE NUMBER OF RIGHT HAND SIDE VECTORS.
+C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE
+C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE.
+C IER - RESULTING ERROR PARAMETER CODED AS FOLLOWS
+C IER=0 - NO ERROR,
+C IER=-1 - NO RESULT BECAUSE OF M LESS THAN 1 OR
+C PIVOT ELEMENT AT ANY ELIMINATION STEP
+C EQUAL TO 0,
+C IER=K - WARNING DUE TO POSSIBLE LOSS OF SIGNIFI-
+C CANCE INDICATED AT ELIMINATION STEP K+1,
+C WHERE PIVOT ELEMENT WAS LESS THAN OR
+C EQUAL TO THE INTERNAL TOLERANCE EPS TIMES
+C ABSOLUTELY GREATEST MAIN DIAGONAL
+C ELEMENT OF MATRIX A.
+C AUX - AN AUXILIARY STORAGE ARRAY WITH DIMENSION M-1.
+C
+C REMARKS
+C UPPER TRIANGULAR PART OF MATRIX A IS ASSUMED TO BE STORED
+C COLUMNWISE IN M*(M+1)/2 SUCCESSIVE STORAGE LOCATIONS, RIGHT
+C HAND SIDE MATRIX R COLUMNWISE IN N*M SUCCESSIVE STORAGE
+C LOCATIONS. ON RETURN SOLUTION MATRIX R IS STORED COLUMNWISE
+C TOO.
+C THE PROCEDURE GIVES RESULTS IF THE NUMBER OF EQUATIONS M IS
+C GREATER THAN 0 AND PIVOT ELEMENTS AT ALL ELIMINATION STEPS
+C ARE DIFFERENT FROM 0. HOWEVER WARNING IER=K - IF GIVEN -
+C INDICATES POSSIBLE LOSS OF SIGNIFICANCE. IN CASE OF A WELL
+C SCALED MATRIX A AND APPROPRIATE TOLERANCE EPS, IER=K MAY BE
+C INTERPRETED THAT MATRIX A HAS THE RANK K. NO WARNING IS
+C GIVEN IN CASE M=1.
+C ERROR PARAMETER IER=-1 DOES NOT NECESSARILY MEAN THAT
+C MATRIX A IS SINGULAR, AS ONLY MAIN DIAGONAL ELEMENTS
+C ARE USED AS PIVOT ELEMENTS. POSSIBLY SUBROUTINE GELG (WHICH
+C WORKS WITH TOTAL PIVOTING) WOULD BE ABLE TO FIND A SOLUTION.
+C
+C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C NONE
+C
+C METHOD
+C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH
+C PIVOTING IN MAIN DIAGONAL, IN ORDER TO PRESERVE
+C SYMMETRY IN REMAINING COEFFICIENT MATRICES.
+C
+C ..................................................................
+C
+*/
+
+#include <stdio.h>
+#define fabsl(x) ( (x) < 0.0L ? -(x) : (x) )
+
+int gels( A, R, M, EPS, AUX )
+long double A[],R[];
+int M;
+long double EPS;
+long double AUX[];
+{
+int I, J, K, L, IER;
+int II, LL, LLD, LR, LT, LST, LLST, LEND;
+long double tb, piv, tol, pivi;
+
+IER = 0;
+if( M <= 0 )
+ {
+fatal:
+ IER = -1;
+ goto done;
+ }
+/* SEARCH FOR GREATEST MAIN DIAGONAL ELEMENT */
+
+/* Diagonal elements are at A(i,i) = 0, 2, 5, 9, 14, ...
+ * A(i,j) = A( i(i-1)/2 + j - 1 )
+ */
+piv = 0.0L;
+I = 0;
+J = 0;
+L = 0;
+for( K=1; K<=M; K++ )
+ {
+ L += K;
+ tb = fabsl( A[L-1] );
+ if( tb > piv )
+ {
+ piv = tb;
+ I = L;
+ J = K;
+ }
+ }
+tol = EPS * piv;
+
+/*
+C MAIN DIAGONAL ELEMENT A(I)=A(J,J) IS FIRST PIVOT ELEMENT.
+C PIV CONTAINS THE ABSOLUTE VALUE OF A(I).
+*/
+
+/* START ELIMINATION LOOP */
+LST = 0;
+LEND = M - 1;
+for( K=1; K<=M; K++ )
+ {
+/* TEST ON USEFULNESS OF SYMMETRIC ALGORITHM */
+ if( piv <= 0.0L )
+ {
+ printf( "gels: piv <= 0 at K = %d\n", K );
+ goto fatal;
+ }
+ if( IER == 0 )
+ {
+ if( piv <= tol )
+ {
+ IER = K;
+/*
+ goto done;
+*/
+ }
+ }
+ LT = J - K;
+ LST += K;
+
+/* PIVOT ROW REDUCTION AND ROW INTERCHANGE IN RIGHT HAND SIDE R */
+ pivi = 1.0L / A[I-1];
+ L = K;
+ LL = L + LT;
+ tb = pivi * R[LL-1];
+ R[LL-1] = R[L-1];
+ R[L-1] = tb;
+/* IS ELIMINATION TERMINATED */
+ if( K >= M )
+ break;
+/*
+C ROW AND COLUMN INTERCHANGE AND PIVOT ROW REDUCTION IN MATRIX A.
+C ELEMENTS OF PIVOT COLUMN ARE SAVED IN AUXILIARY VECTOR AUX.
+*/
+ LR = LST + (LT*(K+J-1))/2;
+ LL = LR;
+ L=LST;
+ for( II=K; II<=LEND; II++ )
+ {
+ L += II;
+ LL += 1;
+ if( L == LR )
+ {
+ A[LL-1] = A[LST-1];
+ tb = A[L-1];
+ goto lab13;
+ }
+ if( L > LR )
+ LL = L + LT;
+
+ tb = A[LL-1];
+ A[LL-1] = A[L-1];
+lab13:
+ AUX[II-1] = tb;
+ A[L-1] = pivi * tb;
+ }
+/* SAVE COLUMN INTERCHANGE INFORMATION */
+ A[LST-1] = LT;
+/* ELEMENT REDUCTION AND SEARCH FOR NEXT PIVOT */
+ piv = 0.0L;
+ LLST = LST;
+ LT = 0;
+ for( II=K; II<=LEND; II++ )
+ {
+ pivi = -AUX[II-1];
+ LL = LLST;
+ LT += 1;
+ for( LLD=II; LLD<=LEND; LLD++ )
+ {
+ LL += LLD;
+ L = LL + LT;
+ A[L-1] += pivi * A[LL-1];
+ }
+ LLST += II;
+ LR = LLST + LT;
+ tb =fabsl( A[LR-1] );
+ if( tb > piv )
+ {
+ piv = tb;
+ I = LR;
+ J = II + 1;
+ }
+ LR = K;
+ LL = LR + LT;
+ R[LL-1] += pivi * R[LR-1];
+ }
+ }
+/* END OF ELIMINATION LOOP */
+
+/* BACK SUBSTITUTION AND BACK INTERCHANGE */
+
+if( LEND <= 0 )
+ {
+ printf( "gels: LEND = %d\n", LEND );
+ if( LEND < 0 )
+ goto fatal;
+ goto done;
+ }
+II = M;
+for( I=2; I<=M; I++ )
+ {
+ LST -= II;
+ II -= 1;
+ L = A[LST-1] + 0.5L;
+ J = II;
+ tb = R[J-1];
+ LL = J;
+ K = LST;
+ for( LT=II; LT<=LEND; LT++ )
+ {
+ LL += 1;
+ K += LT;
+ tb -= A[K-1] * R[LL-1];
+ }
+ K = J + L;
+ R[J-1] = R[K-1];
+ R[K-1] = tb;
+ }
+done:
+if( IER )
+ printf( "gels error %d!\n", IER );
+return( IER );
+}
diff --git a/libm/ldouble/ieee.c b/libm/ldouble/ieee.c
new file mode 100644
index 000000000..584329b0c
--- /dev/null
+++ b/libm/ldouble/ieee.c
@@ -0,0 +1,4182 @@
+/* ieee.c
+ *
+ * Extended precision IEEE binary floating point arithmetic routines
+ *
+ * Numbers are stored in C language as arrays of 16-bit unsigned
+ * short integers. The arguments of the routines are pointers to
+ * the arrays.
+ *
+ *
+ * External e type data structure, simulates Intel 8087 chip
+ * temporary real format but possibly with a larger significand:
+ *
+ * NE-1 significand words (least significant word first,
+ * most significant bit is normally set)
+ * exponent (value = EXONE for 1.0,
+ * top bit is the sign)
+ *
+ *
+ * Internal data structure of a number (a "word" is 16 bits):
+ *
+ * ei[0] sign word (0 for positive, 0xffff for negative)
+ * ei[1] biased exponent (value = EXONE for the number 1.0)
+ * ei[2] high guard word (always zero after normalization)
+ * ei[3]
+ * to ei[NI-2] significand (NI-4 significand words,
+ * most significant word first,
+ * most significant bit is set)
+ * ei[NI-1] low guard word (0x8000 bit is rounding place)
+ *
+ *
+ *
+ * Routines for external format numbers
+ *
+ * asctoe( string, e ) ASCII string to extended double e type
+ * asctoe64( string, &d ) ASCII string to long double
+ * asctoe53( string, &d ) ASCII string to double
+ * asctoe24( string, &f ) ASCII string to single
+ * asctoeg( string, e, prec ) ASCII string to specified precision
+ * e24toe( &f, e ) IEEE single precision to e type
+ * e53toe( &d, e ) IEEE double precision to e type
+ * e64toe( &d, e ) IEEE long double precision to e type
+ * eabs(e) absolute value
+ * eadd( a, b, c ) c = b + a
+ * eclear(e) e = 0
+ * ecmp (a, b) Returns 1 if a > b, 0 if a == b,
+ * -1 if a < b, -2 if either a or b is a NaN.
+ * ediv( a, b, c ) c = b / a
+ * efloor( a, b ) truncate to integer, toward -infinity
+ * efrexp( a, exp, s ) extract exponent and significand
+ * eifrac( e, &l, frac ) e to long integer and e type fraction
+ * euifrac( e, &l, frac ) e to unsigned long integer and e type fraction
+ * einfin( e ) set e to infinity, leaving its sign alone
+ * eldexp( a, n, b ) multiply by 2**n
+ * emov( a, b ) b = a
+ * emul( a, b, c ) c = b * a
+ * eneg(e) e = -e
+ * eround( a, b ) b = nearest integer value to a
+ * esub( a, b, c ) c = b - a
+ * e24toasc( &f, str, n ) single to ASCII string, n digits after decimal
+ * e53toasc( &d, str, n ) double to ASCII string, n digits after decimal
+ * e64toasc( &d, str, n ) long double to ASCII string
+ * etoasc( e, str, n ) e to ASCII string, n digits after decimal
+ * etoe24( e, &f ) convert e type to IEEE single precision
+ * etoe53( e, &d ) convert e type to IEEE double precision
+ * etoe64( e, &d ) convert e type to IEEE long double precision
+ * ltoe( &l, e ) long (32 bit) integer to e type
+ * ultoe( &l, e ) unsigned long (32 bit) integer to e type
+ * eisneg( e ) 1 if sign bit of e != 0, else 0
+ * eisinf( e ) 1 if e has maximum exponent (non-IEEE)
+ * or is infinite (IEEE)
+ * eisnan( e ) 1 if e is a NaN
+ * esqrt( a, b ) b = square root of a
+ *
+ *
+ * Routines for internal format numbers
+ *
+ * eaddm( ai, bi ) add significands, bi = bi + ai
+ * ecleaz(ei) ei = 0
+ * ecleazs(ei) set ei = 0 but leave its sign alone
+ * ecmpm( ai, bi ) compare significands, return 1, 0, or -1
+ * edivm( ai, bi ) divide significands, bi = bi / ai
+ * emdnorm(ai,l,s,exp) normalize and round off
+ * emovi( a, ai ) convert external a to internal ai
+ * emovo( ai, a ) convert internal ai to external a
+ * emovz( ai, bi ) bi = ai, low guard word of bi = 0
+ * emulm( ai, bi ) multiply significands, bi = bi * ai
+ * enormlz(ei) left-justify the significand
+ * eshdn1( ai ) shift significand and guards down 1 bit
+ * eshdn8( ai ) shift down 8 bits
+ * eshdn6( ai ) shift down 16 bits
+ * eshift( ai, n ) shift ai n bits up (or down if n < 0)
+ * eshup1( ai ) shift significand and guards up 1 bit
+ * eshup8( ai ) shift up 8 bits
+ * eshup6( ai ) shift up 16 bits
+ * esubm( ai, bi ) subtract significands, bi = bi - ai
+ *
+ *
+ * The result is always normalized and rounded to NI-4 word precision
+ * after each arithmetic operation.
+ *
+ * Exception flags are NOT fully supported.
+ *
+ * Define INFINITY in mconf.h for support of infinity; otherwise a
+ * saturation arithmetic is implemented.
+ *
+ * Define NANS for support of Not-a-Number items; otherwise the
+ * arithmetic will never produce a NaN output, and might be confused
+ * by a NaN input.
+ * If NaN's are supported, the output of ecmp(a,b) is -2 if
+ * either a or b is a NaN. This means asking if(ecmp(a,b) < 0)
+ * may not be legitimate. Use if(ecmp(a,b) == -1) for less-than
+ * if in doubt.
+ * Signaling NaN's are NOT supported; they are treated the same
+ * as quiet NaN's.
+ *
+ * Denormals are always supported here where appropriate (e.g., not
+ * for conversion to DEC numbers).
+ */
+
+/*
+ * Revision history:
+ *
+ * 5 Jan 84 PDP-11 assembly language version
+ * 2 Mar 86 fixed bug in asctoq()
+ * 6 Dec 86 C language version
+ * 30 Aug 88 100 digit version, improved rounding
+ * 15 May 92 80-bit long double support
+ *
+ * Author: S. L. Moshier.
+ */
+
+#include <stdio.h>
+#include <math.h>
+#include "ehead.h"
+
+/* Change UNK into something else. */
+#ifdef UNK
+#undef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+/* NaN's require infinity support. */
+#ifdef NANS
+#ifndef INFINITY
+#define INFINITY
+#endif
+#endif
+
+/* This handles 64-bit long ints. */
+#define LONGBITS (8 * sizeof(long))
+
+/* Control register for rounding precision.
+ * This can be set to 80 (if NE=6), 64, 56, 53, or 24 bits.
+ */
+int rndprc = NBITS;
+extern int rndprc;
+
+#ifdef ANSIPROT
+extern void eaddm ( unsigned short *, unsigned short * );
+extern void esubm ( unsigned short *, unsigned short * );
+extern void emdnorm ( unsigned short *, int, int, long, int );
+extern void asctoeg ( char *, unsigned short *, int );
+extern void enan ( unsigned short *, int );
+extern void asctoe24 ( char *, unsigned short * );
+extern void asctoe53 ( char *, unsigned short * );
+extern void asctoe64 ( char *, unsigned short * );
+extern void asctoe113 ( char *, unsigned short * );
+extern void eremain ( unsigned short *, unsigned short *, unsigned short * );
+extern void einit ( void );
+extern void eiremain ( unsigned short *, unsigned short * );
+extern int ecmp ( unsigned short *, unsigned short * );
+extern int edivm ( unsigned short *, unsigned short * );
+extern int emulm ( unsigned short *, unsigned short * );
+extern int eisneg ( unsigned short * );
+extern int eisinf ( unsigned short * );
+extern void emovi ( unsigned short *, unsigned short * );
+extern void emovo ( unsigned short *, unsigned short * );
+extern void emovz ( unsigned short *, unsigned short * );
+extern void ecleaz ( unsigned short * );
+extern void eadd1 ( unsigned short *, unsigned short *, unsigned short * );
+extern int eisnan ( unsigned short * );
+extern int eiisnan ( unsigned short * );
+static void toe24( unsigned short *, unsigned short * );
+static void toe53( unsigned short *, unsigned short * );
+static void toe64( unsigned short *, unsigned short * );
+static void toe113( unsigned short *, unsigned short * );
+void einfin ( unsigned short * );
+void eshdn1 ( unsigned short * );
+void eshup1 ( unsigned short * );
+void eshup6 ( unsigned short * );
+void eshdn6 ( unsigned short * );
+void eshup8 ( unsigned short * );
+void eshdn8 ( unsigned short * );
+void m16m ( unsigned short, unsigned short *, unsigned short * );
+int ecmpm ( unsigned short *, unsigned short * );
+int enormlz ( unsigned short * );
+void ecleazs ( unsigned short * );
+int eshift ( unsigned short *, int );
+void emov ( unsigned short *, unsigned short * );
+void eneg ( unsigned short * );
+void eclear ( unsigned short * );
+void efloor ( unsigned short *, unsigned short * );
+void eadd ( unsigned short *, unsigned short *, unsigned short * );
+void esub ( unsigned short *, unsigned short *, unsigned short * );
+void ediv ( unsigned short *, unsigned short *, unsigned short * );
+void emul ( unsigned short *, unsigned short *, unsigned short * );
+void e24toe ( unsigned short *, unsigned short * );
+void e53toe ( unsigned short *, unsigned short * );
+void e64toe ( unsigned short *, unsigned short * );
+void e113toe ( unsigned short *, unsigned short * );
+void etoasc ( unsigned short *, char *, int );
+static int eiisinf ( unsigned short * );
+#else
+void eaddm(), esubm(), emdnorm(), asctoeg(), enan();
+static void toe24(), toe53(), toe64(), toe113();
+void eremain(), einit(), eiremain();
+int ecmpm(), edivm(), emulm(), eisneg(), eisinf();
+void emovi(), emovo(), emovz(), ecleaz(), eadd1();
+/* void etodec(), todec(), dectoe(); */
+int eisnan(), eiisnan(), ecmpm(), enormlz(), eshift();
+void einfin(), eshdn1(), eshup1(), eshup6(), eshdn6();
+void eshup8(), eshdn8(), m16m();
+void eadd(), esub(), ediv(), emul();
+void ecleazs(), emov(), eneg(), eclear(), efloor();
+void e24toe(), e53toe(), e64toe(), e113toe(), etoasc();
+static int eiisinf();
+#endif
+
+
+void einit()
+{
+}
+
+/*
+; Clear out entire external format number.
+;
+; unsigned short x[];
+; eclear( x );
+*/
+
+void eclear( x )
+register unsigned short *x;
+{
+register int i;
+
+for( i=0; i<NE; i++ )
+ *x++ = 0;
+}
+
+
+
+/* Move external format number from a to b.
+ *
+ * emov( a, b );
+ */
+
+void emov( a, b )
+register unsigned short *a, *b;
+{
+register int i;
+
+for( i=0; i<NE; i++ )
+ *b++ = *a++;
+}
+
+
+/*
+; Absolute value of external format number
+;
+; short x[NE];
+; eabs( x );
+*/
+
+void eabs(x)
+unsigned short x[]; /* x is the memory address of a short */
+{
+
+x[NE-1] &= 0x7fff; /* sign is top bit of last word of external format */
+}
+
+
+
+
+/*
+; Negate external format number
+;
+; unsigned short x[NE];
+; eneg( x );
+*/
+
+void eneg(x)
+unsigned short x[];
+{
+
+#ifdef NANS
+if( eisnan(x) )
+ return;
+#endif
+x[NE-1] ^= 0x8000; /* Toggle the sign bit */
+}
+
+
+
+/* Return 1 if external format number is negative,
+ * else return zero.
+ */
+int eisneg(x)
+unsigned short x[];
+{
+
+#ifdef NANS
+if( eisnan(x) )
+ return( 0 );
+#endif
+if( x[NE-1] & 0x8000 )
+ return( 1 );
+else
+ return( 0 );
+}
+
+
+/* Return 1 if external format number has maximum possible exponent,
+ * else return zero.
+ */
+int eisinf(x)
+unsigned short x[];
+{
+
+if( (x[NE-1] & 0x7fff) == 0x7fff )
+ {
+#ifdef NANS
+ if( eisnan(x) )
+ return( 0 );
+#endif
+ return( 1 );
+ }
+else
+ return( 0 );
+}
+
+/* Check if e-type number is not a number.
+ */
+int eisnan(x)
+unsigned short x[];
+{
+
+#ifdef NANS
+int i;
+/* NaN has maximum exponent */
+if( (x[NE-1] & 0x7fff) != 0x7fff )
+ return (0);
+/* ... and non-zero significand field. */
+for( i=0; i<NE-1; i++ )
+ {
+ if( *x++ != 0 )
+ return (1);
+ }
+#endif
+return (0);
+}
+
+/*
+; Fill entire number, including exponent and significand, with
+; largest possible number. These programs implement a saturation
+; value that is an ordinary, legal number. A special value
+; "infinity" may also be implemented; this would require tests
+; for that value and implementation of special rules for arithmetic
+; operations involving inifinity.
+*/
+
+void einfin(x)
+register unsigned short *x;
+{
+register int i;
+
+#ifdef INFINITY
+for( i=0; i<NE-1; i++ )
+ *x++ = 0;
+*x |= 32767;
+#else
+for( i=0; i<NE-1; i++ )
+ *x++ = 0xffff;
+*x |= 32766;
+if( rndprc < NBITS )
+ {
+ if (rndprc == 113)
+ {
+ *(x - 9) = 0;
+ *(x - 8) = 0;
+ }
+ if( rndprc == 64 )
+ {
+ *(x-5) = 0;
+ }
+ if( rndprc == 53 )
+ {
+ *(x-4) = 0xf800;
+ }
+ else
+ {
+ *(x-4) = 0;
+ *(x-3) = 0;
+ *(x-2) = 0xff00;
+ }
+ }
+#endif
+}
+
+
+
+/* Move in external format number,
+ * converting it to internal format.
+ */
+void emovi( a, b )
+unsigned short *a, *b;
+{
+register unsigned short *p, *q;
+int i;
+
+q = b;
+p = a + (NE-1); /* point to last word of external number */
+/* get the sign bit */
+if( *p & 0x8000 )
+ *q++ = 0xffff;
+else
+ *q++ = 0;
+/* get the exponent */
+*q = *p--;
+*q++ &= 0x7fff; /* delete the sign bit */
+#ifdef INFINITY
+if( (*(q-1) & 0x7fff) == 0x7fff )
+ {
+#ifdef NANS
+ if( eisnan(a) )
+ {
+ *q++ = 0;
+ for( i=3; i<NI; i++ )
+ *q++ = *p--;
+ return;
+ }
+#endif
+ for( i=2; i<NI; i++ )
+ *q++ = 0;
+ return;
+ }
+#endif
+/* clear high guard word */
+*q++ = 0;
+/* move in the significand */
+for( i=0; i<NE-1; i++ )
+ *q++ = *p--;
+/* clear low guard word */
+*q = 0;
+}
+
+
+/* Move internal format number out,
+ * converting it to external format.
+ */
+void emovo( a, b )
+unsigned short *a, *b;
+{
+register unsigned short *p, *q;
+unsigned short i;
+
+p = a;
+q = b + (NE-1); /* point to output exponent */
+/* combine sign and exponent */
+i = *p++;
+if( i )
+ *q-- = *p++ | 0x8000;
+else
+ *q-- = *p++;
+#ifdef INFINITY
+if( *(p-1) == 0x7fff )
+ {
+#ifdef NANS
+ if( eiisnan(a) )
+ {
+ enan( b, NBITS );
+ return;
+ }
+#endif
+ einfin(b);
+ return;
+ }
+#endif
+/* skip over guard word */
+++p;
+/* move the significand */
+for( i=0; i<NE-1; i++ )
+ *q-- = *p++;
+}
+
+
+
+
+/* Clear out internal format number.
+ */
+
+void ecleaz( xi )
+register unsigned short *xi;
+{
+register int i;
+
+for( i=0; i<NI; i++ )
+ *xi++ = 0;
+}
+
+/* same, but don't touch the sign. */
+
+void ecleazs( xi )
+register unsigned short *xi;
+{
+register int i;
+
+++xi;
+for(i=0; i<NI-1; i++)
+ *xi++ = 0;
+}
+
+
+
+
+/* Move internal format number from a to b.
+ */
+void emovz( a, b )
+register unsigned short *a, *b;
+{
+register int i;
+
+for( i=0; i<NI-1; i++ )
+ *b++ = *a++;
+/* clear low guard word */
+*b = 0;
+}
+
+/* Return nonzero if internal format number is a NaN.
+ */
+
+int eiisnan (x)
+unsigned short x[];
+{
+int i;
+
+if( (x[E] & 0x7fff) == 0x7fff )
+ {
+ for( i=M+1; i<NI; i++ )
+ {
+ if( x[i] != 0 )
+ return(1);
+ }
+ }
+return(0);
+}
+
+#ifdef INFINITY
+/* Return nonzero if internal format number is infinite. */
+
+static int
+eiisinf (x)
+ unsigned short x[];
+{
+
+#ifdef NANS
+ if (eiisnan (x))
+ return (0);
+#endif
+ if ((x[E] & 0x7fff) == 0x7fff)
+ return (1);
+ return (0);
+}
+#endif
+
+/*
+; Compare significands of numbers in internal format.
+; Guard words are included in the comparison.
+;
+; unsigned short a[NI], b[NI];
+; cmpm( a, b );
+;
+; for the significands:
+; returns +1 if a > b
+; 0 if a == b
+; -1 if a < b
+*/
+int ecmpm( a, b )
+register unsigned short *a, *b;
+{
+int i;
+
+a += M; /* skip up to significand area */
+b += M;
+for( i=M; i<NI; i++ )
+ {
+ if( *a++ != *b++ )
+ goto difrnt;
+ }
+return(0);
+
+difrnt:
+if( *(--a) > *(--b) )
+ return(1);
+else
+ return(-1);
+}
+
+
+/*
+; Shift significand down by 1 bit
+*/
+
+void eshdn1(x)
+register unsigned short *x;
+{
+register unsigned short bits;
+int i;
+
+x += M; /* point to significand area */
+
+bits = 0;
+for( i=M; i<NI; i++ )
+ {
+ if( *x & 1 )
+ bits |= 1;
+ *x >>= 1;
+ if( bits & 2 )
+ *x |= 0x8000;
+ bits <<= 1;
+ ++x;
+ }
+}
+
+
+
+/*
+; Shift significand up by 1 bit
+*/
+
+void eshup1(x)
+register unsigned short *x;
+{
+register unsigned short bits;
+int i;
+
+x += NI-1;
+bits = 0;
+
+for( i=M; i<NI; i++ )
+ {
+ if( *x & 0x8000 )
+ bits |= 1;
+ *x <<= 1;
+ if( bits & 2 )
+ *x |= 1;
+ bits <<= 1;
+ --x;
+ }
+}
+
+
+
+/*
+; Shift significand down by 8 bits
+*/
+
+void eshdn8(x)
+register unsigned short *x;
+{
+register unsigned short newbyt, oldbyt;
+int i;
+
+x += M;
+oldbyt = 0;
+for( i=M; i<NI; i++ )
+ {
+ newbyt = *x << 8;
+ *x >>= 8;
+ *x |= oldbyt;
+ oldbyt = newbyt;
+ ++x;
+ }
+}
+
+/*
+; Shift significand up by 8 bits
+*/
+
+void eshup8(x)
+register unsigned short *x;
+{
+int i;
+register unsigned short newbyt, oldbyt;
+
+x += NI-1;
+oldbyt = 0;
+
+for( i=M; i<NI; i++ )
+ {
+ newbyt = *x >> 8;
+ *x <<= 8;
+ *x |= oldbyt;
+ oldbyt = newbyt;
+ --x;
+ }
+}
+
+/*
+; Shift significand up by 16 bits
+*/
+
+void eshup6(x)
+register unsigned short *x;
+{
+int i;
+register unsigned short *p;
+
+p = x + M;
+x += M + 1;
+
+for( i=M; i<NI-1; i++ )
+ *p++ = *x++;
+
+*p = 0;
+}
+
+/*
+; Shift significand down by 16 bits
+*/
+
+void eshdn6(x)
+register unsigned short *x;
+{
+int i;
+register unsigned short *p;
+
+x += NI-1;
+p = x + 1;
+
+for( i=M; i<NI-1; i++ )
+ *(--p) = *(--x);
+
+*(--p) = 0;
+}
+
+/*
+; Add significands
+; x + y replaces y
+*/
+
+void eaddm( x, y )
+unsigned short *x, *y;
+{
+register unsigned long a;
+int i;
+unsigned int carry;
+
+x += NI-1;
+y += NI-1;
+carry = 0;
+for( i=M; i<NI; i++ )
+ {
+ a = (unsigned long )(*x) + (unsigned long )(*y) + carry;
+ if( a & 0x10000 )
+ carry = 1;
+ else
+ carry = 0;
+ *y = (unsigned short )a;
+ --x;
+ --y;
+ }
+}
+
+/*
+; Subtract significands
+; y - x replaces y
+*/
+
+void esubm( x, y )
+unsigned short *x, *y;
+{
+unsigned long a;
+int i;
+unsigned int carry;
+
+x += NI-1;
+y += NI-1;
+carry = 0;
+for( i=M; i<NI; i++ )
+ {
+ a = (unsigned long )(*y) - (unsigned long )(*x) - carry;
+ if( a & 0x10000 )
+ carry = 1;
+ else
+ carry = 0;
+ *y = (unsigned short )a;
+ --x;
+ --y;
+ }
+}
+
+
+/* Divide significands */
+
+static unsigned short equot[NI] = {0}; /* was static */
+
+#if 0
+int edivm( den, num )
+unsigned short den[], num[];
+{
+int i;
+register unsigned short *p, *q;
+unsigned short j;
+
+p = &equot[0];
+*p++ = num[0];
+*p++ = num[1];
+
+for( i=M; i<NI; i++ )
+ {
+ *p++ = 0;
+ }
+
+/* Use faster compare and subtraction if denominator
+ * has only 15 bits of significane.
+ */
+p = &den[M+2];
+if( *p++ == 0 )
+ {
+ for( i=M+3; i<NI; i++ )
+ {
+ if( *p++ != 0 )
+ goto fulldiv;
+ }
+ if( (den[M+1] & 1) != 0 )
+ goto fulldiv;
+ eshdn1(num);
+ eshdn1(den);
+
+ p = &den[M+1];
+ q = &num[M+1];
+
+ for( i=0; i<NBITS+2; i++ )
+ {
+ if( *p <= *q )
+ {
+ *q -= *p;
+ j = 1;
+ }
+ else
+ {
+ j = 0;
+ }
+ eshup1(equot);
+ equot[NI-2] |= j;
+ eshup1(num);
+ }
+ goto divdon;
+ }
+
+/* The number of quotient bits to calculate is
+ * NBITS + 1 scaling guard bit + 1 roundoff bit.
+ */
+fulldiv:
+
+p = &equot[NI-2];
+for( i=0; i<NBITS+2; i++ )
+ {
+ if( ecmpm(den,num) <= 0 )
+ {
+ esubm(den, num);
+ j = 1; /* quotient bit = 1 */
+ }
+ else
+ j = 0;
+ eshup1(equot);
+ *p |= j;
+ eshup1(num);
+ }
+
+divdon:
+
+eshdn1( equot );
+eshdn1( equot );
+
+/* test for nonzero remainder after roundoff bit */
+p = &num[M];
+j = 0;
+for( i=M; i<NI; i++ )
+ {
+ j |= *p++;
+ }
+if( j )
+ j = 1;
+
+
+for( i=0; i<NI; i++ )
+ num[i] = equot[i];
+return( (int )j );
+}
+
+/* Multiply significands */
+int emulm( a, b )
+unsigned short a[], b[];
+{
+unsigned short *p, *q;
+int i, j, k;
+
+equot[0] = b[0];
+equot[1] = b[1];
+for( i=M; i<NI; i++ )
+ equot[i] = 0;
+
+p = &a[NI-2];
+k = NBITS;
+while( *p == 0 ) /* significand is not supposed to be all zero */
+ {
+ eshdn6(a);
+ k -= 16;
+ }
+if( (*p & 0xff) == 0 )
+ {
+ eshdn8(a);
+ k -= 8;
+ }
+
+q = &equot[NI-1];
+j = 0;
+for( i=0; i<k; i++ )
+ {
+ if( *p & 1 )
+ eaddm(b, equot);
+/* remember if there were any nonzero bits shifted out */
+ if( *q & 1 )
+ j |= 1;
+ eshdn1(a);
+ eshdn1(equot);
+ }
+
+for( i=0; i<NI; i++ )
+ b[i] = equot[i];
+
+/* return flag for lost nonzero bits */
+return(j);
+}
+
+#else
+
+/* Multiply significand of e-type number b
+by 16-bit quantity a, e-type result to c. */
+
+void m16m( a, b, c )
+unsigned short a;
+unsigned short b[], c[];
+{
+register unsigned short *pp;
+register unsigned long carry;
+unsigned short *ps;
+unsigned short p[NI];
+unsigned long aa, m;
+int i;
+
+aa = a;
+pp = &p[NI-2];
+*pp++ = 0;
+*pp = 0;
+ps = &b[NI-1];
+
+for( i=M+1; i<NI; i++ )
+ {
+ if( *ps == 0 )
+ {
+ --ps;
+ --pp;
+ *(pp-1) = 0;
+ }
+ else
+ {
+ m = (unsigned long) aa * *ps--;
+ carry = (m & 0xffff) + *pp;
+ *pp-- = (unsigned short )carry;
+ carry = (carry >> 16) + (m >> 16) + *pp;
+ *pp = (unsigned short )carry;
+ *(pp-1) = carry >> 16;
+ }
+ }
+for( i=M; i<NI; i++ )
+ c[i] = p[i];
+}
+
+
+/* Divide significands. Neither the numerator nor the denominator
+is permitted to have its high guard word nonzero. */
+
+
+int edivm( den, num )
+unsigned short den[], num[];
+{
+int i;
+register unsigned short *p;
+unsigned long tnum;
+unsigned short j, tdenm, tquot;
+unsigned short tprod[NI+1];
+
+p = &equot[0];
+*p++ = num[0];
+*p++ = num[1];
+
+for( i=M; i<NI; i++ )
+ {
+ *p++ = 0;
+ }
+eshdn1( num );
+tdenm = den[M+1];
+for( i=M; i<NI; i++ )
+ {
+ /* Find trial quotient digit (the radix is 65536). */
+ tnum = (((unsigned long) num[M]) << 16) + num[M+1];
+
+ /* Do not execute the divide instruction if it will overflow. */
+ if( (tdenm * ((unsigned long)0xffffL)) < tnum )
+ tquot = 0xffff;
+ else
+ tquot = tnum / tdenm;
+
+ /* Prove that the divide worked. */
+/*
+ tcheck = (unsigned long )tquot * tdenm;
+ if( tnum - tcheck > tdenm )
+ tquot = 0xffff;
+*/
+ /* Multiply denominator by trial quotient digit. */
+ m16m( tquot, den, tprod );
+ /* The quotient digit may have been overestimated. */
+ if( ecmpm( tprod, num ) > 0 )
+ {
+ tquot -= 1;
+ esubm( den, tprod );
+ if( ecmpm( tprod, num ) > 0 )
+ {
+ tquot -= 1;
+ esubm( den, tprod );
+ }
+ }
+/*
+ if( ecmpm( tprod, num ) > 0 )
+ {
+ eshow( "tprod", tprod );
+ eshow( "num ", num );
+ printf( "tnum = %08lx, tden = %04x, tquot = %04x\n",
+ tnum, den[M+1], tquot );
+ }
+*/
+ esubm( tprod, num );
+/*
+ if( ecmpm( num, den ) >= 0 )
+ {
+ eshow( "num ", num );
+ eshow( "den ", den );
+ printf( "tnum = %08lx, tden = %04x, tquot = %04x\n",
+ tnum, den[M+1], tquot );
+ }
+*/
+ equot[i] = tquot;
+ eshup6(num);
+ }
+/* test for nonzero remainder after roundoff bit */
+p = &num[M];
+j = 0;
+for( i=M; i<NI; i++ )
+ {
+ j |= *p++;
+ }
+if( j )
+ j = 1;
+
+for( i=0; i<NI; i++ )
+ num[i] = equot[i];
+
+return( (int )j );
+}
+
+
+
+/* Multiply significands */
+int emulm( a, b )
+unsigned short a[], b[];
+{
+unsigned short *p, *q;
+unsigned short pprod[NI];
+unsigned short j;
+int i;
+
+equot[0] = b[0];
+equot[1] = b[1];
+for( i=M; i<NI; i++ )
+ equot[i] = 0;
+
+j = 0;
+p = &a[NI-1];
+q = &equot[NI-1];
+for( i=M+1; i<NI; i++ )
+ {
+ if( *p == 0 )
+ {
+ --p;
+ }
+ else
+ {
+ m16m( *p--, b, pprod );
+ eaddm(pprod, equot);
+ }
+ j |= *q;
+ eshdn6(equot);
+ }
+
+for( i=0; i<NI; i++ )
+ b[i] = equot[i];
+
+/* return flag for lost nonzero bits */
+return( (int)j );
+}
+
+
+/*
+eshow(str, x)
+char *str;
+unsigned short *x;
+{
+int i;
+
+printf( "%s ", str );
+for( i=0; i<NI; i++ )
+ printf( "%04x ", *x++ );
+printf( "\n" );
+}
+*/
+#endif
+
+
+
+/*
+ * Normalize and round off.
+ *
+ * The internal format number to be rounded is "s".
+ * Input "lost" indicates whether the number is exact.
+ * This is the so-called sticky bit.
+ *
+ * Input "subflg" indicates whether the number was obtained
+ * by a subtraction operation. In that case if lost is nonzero
+ * then the number is slightly smaller than indicated.
+ *
+ * Input "exp" is the biased exponent, which may be negative.
+ * the exponent field of "s" is ignored but is replaced by
+ * "exp" as adjusted by normalization and rounding.
+ *
+ * Input "rcntrl" is the rounding control.
+ */
+
+static int rlast = -1;
+static int rw = 0;
+static unsigned short rmsk = 0;
+static unsigned short rmbit = 0;
+static unsigned short rebit = 0;
+static int re = 0;
+static unsigned short rbit[NI] = {0,0,0,0,0,0,0,0};
+
+void emdnorm( s, lost, subflg, exp, rcntrl )
+unsigned short s[];
+int lost;
+int subflg;
+long exp;
+int rcntrl;
+{
+int i, j;
+unsigned short r;
+
+/* Normalize */
+j = enormlz( s );
+
+/* a blank significand could mean either zero or infinity. */
+#ifndef INFINITY
+if( j > NBITS )
+ {
+ ecleazs( s );
+ return;
+ }
+#endif
+exp -= j;
+#ifndef INFINITY
+if( exp >= 32767L )
+ goto overf;
+#else
+if( (j > NBITS) && (exp < 32767L) )
+ {
+ ecleazs( s );
+ return;
+ }
+#endif
+if( exp < 0L )
+ {
+ if( exp > (long )(-NBITS-1) )
+ {
+ j = (int )exp;
+ i = eshift( s, j );
+ if( i )
+ lost = 1;
+ }
+ else
+ {
+ ecleazs( s );
+ return;
+ }
+ }
+/* Round off, unless told not to by rcntrl. */
+if( rcntrl == 0 )
+ goto mdfin;
+/* Set up rounding parameters if the control register changed. */
+if( rndprc != rlast )
+ {
+ ecleaz( rbit );
+ switch( rndprc )
+ {
+ default:
+ case NBITS:
+ rw = NI-1; /* low guard word */
+ rmsk = 0xffff;
+ rmbit = 0x8000;
+ rebit = 1;
+ re = rw - 1;
+ break;
+ case 113:
+ rw = 10;
+ rmsk = 0x7fff;
+ rmbit = 0x4000;
+ rebit = 0x8000;
+ re = rw;
+ break;
+ case 64:
+ rw = 7;
+ rmsk = 0xffff;
+ rmbit = 0x8000;
+ rebit = 1;
+ re = rw-1;
+ break;
+/* For DEC arithmetic */
+ case 56:
+ rw = 6;
+ rmsk = 0xff;
+ rmbit = 0x80;
+ rebit = 0x100;
+ re = rw;
+ break;
+ case 53:
+ rw = 6;
+ rmsk = 0x7ff;
+ rmbit = 0x0400;
+ rebit = 0x800;
+ re = rw;
+ break;
+ case 24:
+ rw = 4;
+ rmsk = 0xff;
+ rmbit = 0x80;
+ rebit = 0x100;
+ re = rw;
+ break;
+ }
+ rbit[re] = rebit;
+ rlast = rndprc;
+ }
+
+/* Shift down 1 temporarily if the data structure has an implied
+ * most significant bit and the number is denormal.
+ * For rndprc = 64 or NBITS, there is no implied bit.
+ * But Intel long double denormals lose one bit of significance even so.
+ */
+#ifdef IBMPC
+if( (exp <= 0) && (rndprc != NBITS) )
+#else
+if( (exp <= 0) && (rndprc != 64) && (rndprc != NBITS) )
+#endif
+ {
+ lost |= s[NI-1] & 1;
+ eshdn1(s);
+ }
+/* Clear out all bits below the rounding bit,
+ * remembering in r if any were nonzero.
+ */
+r = s[rw] & rmsk;
+if( rndprc < NBITS )
+ {
+ i = rw + 1;
+ while( i < NI )
+ {
+ if( s[i] )
+ r |= 1;
+ s[i] = 0;
+ ++i;
+ }
+ }
+s[rw] &= ~rmsk;
+if( (r & rmbit) != 0 )
+ {
+ if( r == rmbit )
+ {
+ if( lost == 0 )
+ { /* round to even */
+ if( (s[re] & rebit) == 0 )
+ goto mddone;
+ }
+ else
+ {
+ if( subflg != 0 )
+ goto mddone;
+ }
+ }
+ eaddm( rbit, s );
+ }
+mddone:
+#ifdef IBMPC
+if( (exp <= 0) && (rndprc != NBITS) )
+#else
+if( (exp <= 0) && (rndprc != 64) && (rndprc != NBITS) )
+#endif
+ {
+ eshup1(s);
+ }
+if( s[2] != 0 )
+ { /* overflow on roundoff */
+ eshdn1(s);
+ exp += 1;
+ }
+mdfin:
+s[NI-1] = 0;
+if( exp >= 32767L )
+ {
+#ifndef INFINITY
+overf:
+#endif
+#ifdef INFINITY
+ s[1] = 32767;
+ for( i=2; i<NI-1; i++ )
+ s[i] = 0;
+#else
+ s[1] = 32766;
+ s[2] = 0;
+ for( i=M+1; i<NI-1; i++ )
+ s[i] = 0xffff;
+ s[NI-1] = 0;
+ if( (rndprc < 64) || (rndprc == 113) )
+ {
+ s[rw] &= ~rmsk;
+ if( rndprc == 24 )
+ {
+ s[5] = 0;
+ s[6] = 0;
+ }
+ }
+#endif
+ return;
+ }
+if( exp < 0 )
+ s[1] = 0;
+else
+ s[1] = (unsigned short )exp;
+}
+
+
+
+/*
+; Subtract external format numbers.
+;
+; unsigned short a[NE], b[NE], c[NE];
+; esub( a, b, c ); c = b - a
+*/
+
+static int subflg = 0;
+
+void esub( a, b, c )
+unsigned short *a, *b, *c;
+{
+
+#ifdef NANS
+if( eisnan(a) )
+ {
+ emov (a, c);
+ return;
+ }
+if( eisnan(b) )
+ {
+ emov(b,c);
+ return;
+ }
+/* Infinity minus infinity is a NaN.
+ * Test for subtracting infinities of the same sign.
+ */
+if( eisinf(a) && eisinf(b) && ((eisneg (a) ^ eisneg (b)) == 0))
+ {
+ mtherr( "esub", DOMAIN );
+ enan( c, NBITS );
+ return;
+ }
+#endif
+subflg = 1;
+eadd1( a, b, c );
+}
+
+
+/*
+; Add.
+;
+; unsigned short a[NE], b[NE], c[NE];
+; eadd( a, b, c ); c = b + a
+*/
+void eadd( a, b, c )
+unsigned short *a, *b, *c;
+{
+
+#ifdef NANS
+/* NaN plus anything is a NaN. */
+if( eisnan(a) )
+ {
+ emov(a,c);
+ return;
+ }
+if( eisnan(b) )
+ {
+ emov(b,c);
+ return;
+ }
+/* Infinity minus infinity is a NaN.
+ * Test for adding infinities of opposite signs.
+ */
+if( eisinf(a) && eisinf(b)
+ && ((eisneg(a) ^ eisneg(b)) != 0) )
+ {
+ mtherr( "eadd", DOMAIN );
+ enan( c, NBITS );
+ return;
+ }
+#endif
+subflg = 0;
+eadd1( a, b, c );
+}
+
+void eadd1( a, b, c )
+unsigned short *a, *b, *c;
+{
+unsigned short ai[NI], bi[NI], ci[NI];
+int i, lost, j, k;
+long lt, lta, ltb;
+
+#ifdef INFINITY
+if( eisinf(a) )
+ {
+ emov(a,c);
+ if( subflg )
+ eneg(c);
+ return;
+ }
+if( eisinf(b) )
+ {
+ emov(b,c);
+ return;
+ }
+#endif
+emovi( a, ai );
+emovi( b, bi );
+if( subflg )
+ ai[0] = ~ai[0];
+
+/* compare exponents */
+lta = ai[E];
+ltb = bi[E];
+lt = lta - ltb;
+if( lt > 0L )
+ { /* put the larger number in bi */
+ emovz( bi, ci );
+ emovz( ai, bi );
+ emovz( ci, ai );
+ ltb = bi[E];
+ lt = -lt;
+ }
+lost = 0;
+if( lt != 0L )
+ {
+ if( lt < (long )(-NBITS-1) )
+ goto done; /* answer same as larger addend */
+ k = (int )lt;
+ lost = eshift( ai, k ); /* shift the smaller number down */
+ }
+else
+ {
+/* exponents were the same, so must compare significands */
+ i = ecmpm( ai, bi );
+ if( i == 0 )
+ { /* the numbers are identical in magnitude */
+ /* if different signs, result is zero */
+ if( ai[0] != bi[0] )
+ {
+ eclear(c);
+ return;
+ }
+ /* if same sign, result is double */
+ /* double denomalized tiny number */
+ if( (bi[E] == 0) && ((bi[3] & 0x8000) == 0) )
+ {
+ eshup1( bi );
+ goto done;
+ }
+ /* add 1 to exponent unless both are zero! */
+ for( j=1; j<NI-1; j++ )
+ {
+ if( bi[j] != 0 )
+ {
+/* This could overflow, but let emovo take care of that. */
+ ltb += 1;
+ break;
+ }
+ }
+ bi[E] = (unsigned short )ltb;
+ goto done;
+ }
+ if( i > 0 )
+ { /* put the larger number in bi */
+ emovz( bi, ci );
+ emovz( ai, bi );
+ emovz( ci, ai );
+ }
+ }
+if( ai[0] == bi[0] )
+ {
+ eaddm( ai, bi );
+ subflg = 0;
+ }
+else
+ {
+ esubm( ai, bi );
+ subflg = 1;
+ }
+emdnorm( bi, lost, subflg, ltb, 64 );
+
+done:
+emovo( bi, c );
+}
+
+
+
+/*
+; Divide.
+;
+; unsigned short a[NE], b[NE], c[NE];
+; ediv( a, b, c ); c = b / a
+*/
+void ediv( a, b, c )
+unsigned short *a, *b, *c;
+{
+unsigned short ai[NI], bi[NI];
+int i, sign;
+long lt, lta, ltb;
+
+/* IEEE says if result is not a NaN, the sign is "-" if and only if
+ operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
+sign = eisneg(a) ^ eisneg(b);
+
+#ifdef NANS
+/* Return any NaN input. */
+if( eisnan(a) )
+ {
+ emov(a,c);
+ return;
+ }
+if( eisnan(b) )
+ {
+ emov(b,c);
+ return;
+ }
+/* Zero over zero, or infinity over infinity, is a NaN. */
+if( ((ecmp(a,ezero) == 0) && (ecmp(b,ezero) == 0))
+ || (eisinf (a) && eisinf (b)) )
+ {
+ mtherr( "ediv", DOMAIN );
+ enan( c, NBITS );
+ return;
+ }
+#endif
+/* Infinity over anything else is infinity. */
+#ifdef INFINITY
+if( eisinf(b) )
+ {
+ einfin(c);
+ goto divsign;
+ }
+if( eisinf(a) )
+ {
+ eclear(c);
+ goto divsign;
+ }
+#endif
+emovi( a, ai );
+emovi( b, bi );
+lta = ai[E];
+ltb = bi[E];
+if( bi[E] == 0 )
+ { /* See if numerator is zero. */
+ for( i=1; i<NI-1; i++ )
+ {
+ if( bi[i] != 0 )
+ {
+ ltb -= enormlz( bi );
+ goto dnzro1;
+ }
+ }
+ eclear(c);
+ goto divsign;
+ }
+dnzro1:
+
+if( ai[E] == 0 )
+ { /* possible divide by zero */
+ for( i=1; i<NI-1; i++ )
+ {
+ if( ai[i] != 0 )
+ {
+ lta -= enormlz( ai );
+ goto dnzro2;
+ }
+ }
+ einfin(c);
+ mtherr( "ediv", SING );
+ goto divsign;
+ }
+dnzro2:
+
+i = edivm( ai, bi );
+/* calculate exponent */
+lt = ltb - lta + EXONE;
+emdnorm( bi, i, 0, lt, 64 );
+emovo( bi, c );
+
+divsign:
+
+if( sign )
+ *(c+(NE-1)) |= 0x8000;
+else
+ *(c+(NE-1)) &= ~0x8000;
+}
+
+
+
+/*
+; Multiply.
+;
+; unsigned short a[NE], b[NE], c[NE];
+; emul( a, b, c ); c = b * a
+*/
+void emul( a, b, c )
+unsigned short *a, *b, *c;
+{
+unsigned short ai[NI], bi[NI];
+int i, j, sign;
+long lt, lta, ltb;
+
+/* IEEE says if result is not a NaN, the sign is "-" if and only if
+ operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
+sign = eisneg(a) ^ eisneg(b);
+
+#ifdef NANS
+/* NaN times anything is the same NaN. */
+if( eisnan(a) )
+ {
+ emov(a,c);
+ return;
+ }
+if( eisnan(b) )
+ {
+ emov(b,c);
+ return;
+ }
+/* Zero times infinity is a NaN. */
+if( (eisinf(a) && (ecmp(b,ezero) == 0))
+ || (eisinf(b) && (ecmp(a,ezero) == 0)) )
+ {
+ mtherr( "emul", DOMAIN );
+ enan( c, NBITS );
+ return;
+ }
+#endif
+/* Infinity times anything else is infinity. */
+#ifdef INFINITY
+if( eisinf(a) || eisinf(b) )
+ {
+ einfin(c);
+ goto mulsign;
+ }
+#endif
+emovi( a, ai );
+emovi( b, bi );
+lta = ai[E];
+ltb = bi[E];
+if( ai[E] == 0 )
+ {
+ for( i=1; i<NI-1; i++ )
+ {
+ if( ai[i] != 0 )
+ {
+ lta -= enormlz( ai );
+ goto mnzer1;
+ }
+ }
+ eclear(c);
+ goto mulsign;
+ }
+mnzer1:
+
+if( bi[E] == 0 )
+ {
+ for( i=1; i<NI-1; i++ )
+ {
+ if( bi[i] != 0 )
+ {
+ ltb -= enormlz( bi );
+ goto mnzer2;
+ }
+ }
+ eclear(c);
+ goto mulsign;
+ }
+mnzer2:
+
+/* Multiply significands */
+j = emulm( ai, bi );
+/* calculate exponent */
+lt = lta + ltb - (EXONE - 1);
+emdnorm( bi, j, 0, lt, 64 );
+emovo( bi, c );
+/* IEEE says sign is "-" if and only if operands have opposite signs. */
+mulsign:
+if( sign )
+ *(c+(NE-1)) |= 0x8000;
+else
+ *(c+(NE-1)) &= ~0x8000;
+}
+
+
+
+
+/*
+; Convert IEEE double precision to e type
+; double d;
+; unsigned short x[N+2];
+; e53toe( &d, x );
+*/
+void e53toe( pe, y )
+unsigned short *pe, *y;
+{
+#ifdef DEC
+
+dectoe( pe, y ); /* see etodec.c */
+
+#else
+
+register unsigned short r;
+register unsigned short *p, *e;
+unsigned short yy[NI];
+int denorm, k;
+
+e = pe;
+denorm = 0; /* flag if denormalized number */
+ecleaz(yy);
+#ifdef IBMPC
+e += 3;
+#endif
+r = *e;
+yy[0] = 0;
+if( r & 0x8000 )
+ yy[0] = 0xffff;
+yy[M] = (r & 0x0f) | 0x10;
+r &= ~0x800f; /* strip sign and 4 significand bits */
+#ifdef INFINITY
+if( r == 0x7ff0 )
+ {
+#ifdef NANS
+#ifdef IBMPC
+ if( ((pe[3] & 0xf) != 0) || (pe[2] != 0)
+ || (pe[1] != 0) || (pe[0] != 0) )
+ {
+ enan( y, NBITS );
+ return;
+ }
+#else
+ if( ((pe[0] & 0xf) != 0) || (pe[1] != 0)
+ || (pe[2] != 0) || (pe[3] != 0) )
+ {
+ enan( y, NBITS );
+ return;
+ }
+#endif
+#endif /* NANS */
+ eclear( y );
+ einfin( y );
+ if( yy[0] )
+ eneg(y);
+ return;
+ }
+#endif
+r >>= 4;
+/* If zero exponent, then the significand is denormalized.
+ * So, take back the understood high significand bit. */
+if( r == 0 )
+ {
+ denorm = 1;
+ yy[M] &= ~0x10;
+ }
+r += EXONE - 01777;
+yy[E] = r;
+p = &yy[M+1];
+#ifdef IBMPC
+*p++ = *(--e);
+*p++ = *(--e);
+*p++ = *(--e);
+#endif
+#ifdef MIEEE
+++e;
+*p++ = *e++;
+*p++ = *e++;
+*p++ = *e++;
+#endif
+(void )eshift( yy, -5 );
+if( denorm )
+ { /* if zero exponent, then normalize the significand */
+ if( (k = enormlz(yy)) > NBITS )
+ ecleazs(yy);
+ else
+ yy[E] -= (unsigned short )(k-1);
+ }
+emovo( yy, y );
+#endif /* not DEC */
+}
+
+void e64toe( pe, y )
+unsigned short *pe, *y;
+{
+unsigned short yy[NI];
+unsigned short *p, *q, *e;
+int i;
+
+e = pe;
+p = yy;
+for( i=0; i<NE-5; i++ )
+ *p++ = 0;
+#ifdef IBMPC
+for( i=0; i<5; i++ )
+ *p++ = *e++;
+#endif
+#ifdef DEC
+for( i=0; i<5; i++ )
+ *p++ = *e++;
+#endif
+#ifdef MIEEE
+p = &yy[0] + (NE-1);
+*p-- = *e++;
+++e;
+for( i=0; i<4; i++ )
+ *p-- = *e++;
+#endif
+
+#ifdef IBMPC
+/* For Intel long double, shift denormal significand up 1
+ -- but only if the top significand bit is zero. */
+if((yy[NE-1] & 0x7fff) == 0 && (yy[NE-2] & 0x8000) == 0)
+ {
+ unsigned short temp[NI+1];
+ emovi(yy, temp);
+ eshup1(temp);
+ emovo(temp,y);
+ return;
+ }
+#endif
+#ifdef INFINITY
+/* Point to the exponent field. */
+p = &yy[NE-1];
+if( *p == 0x7fff )
+ {
+#ifdef NANS
+#ifdef IBMPC
+ for( i=0; i<4; i++ )
+ {
+ if((i != 3 && pe[i] != 0)
+ /* Check for Intel long double infinity pattern. */
+ || (i == 3 && pe[i] != 0x8000))
+ {
+ enan( y, NBITS );
+ return;
+ }
+ }
+#else
+ for( i=1; i<=4; i++ )
+ {
+ if( pe[i] != 0 )
+ {
+ enan( y, NBITS );
+ return;
+ }
+ }
+#endif
+#endif /* NANS */
+ eclear( y );
+ einfin( y );
+ if( *p & 0x8000 )
+ eneg(y);
+ return;
+ }
+#endif
+p = yy;
+q = y;
+for( i=0; i<NE; i++ )
+ *q++ = *p++;
+}
+
+void e113toe(pe,y)
+unsigned short *pe, *y;
+{
+register unsigned short r;
+unsigned short *e, *p;
+unsigned short yy[NI];
+int i;
+
+e = pe;
+ecleaz(yy);
+#ifdef IBMPC
+e += 7;
+#endif
+r = *e;
+yy[0] = 0;
+if( r & 0x8000 )
+ yy[0] = 0xffff;
+r &= 0x7fff;
+#ifdef INFINITY
+if( r == 0x7fff )
+ {
+#ifdef NANS
+#ifdef IBMPC
+ for( i=0; i<7; i++ )
+ {
+ if( pe[i] != 0 )
+ {
+ enan( y, NBITS );
+ return;
+ }
+ }
+#else
+ for( i=1; i<8; i++ )
+ {
+ if( pe[i] != 0 )
+ {
+ enan( y, NBITS );
+ return;
+ }
+ }
+#endif
+#endif /* NANS */
+ eclear( y );
+ einfin( y );
+ if( *e & 0x8000 )
+ eneg(y);
+ return;
+ }
+#endif /* INFINITY */
+yy[E] = r;
+p = &yy[M + 1];
+#ifdef IBMPC
+for( i=0; i<7; i++ )
+ *p++ = *(--e);
+#endif
+#ifdef MIEEE
+++e;
+for( i=0; i<7; i++ )
+ *p++ = *e++;
+#endif
+/* If denormal, remove the implied bit; else shift down 1. */
+if( r == 0 )
+ {
+ yy[M] = 0;
+ }
+else
+ {
+ yy[M] = 1;
+ eshift( yy, -1 );
+ }
+emovo(yy,y);
+}
+
+
+/*
+; Convert IEEE single precision to e type
+; float d;
+; unsigned short x[N+2];
+; dtox( &d, x );
+*/
+void e24toe( pe, y )
+unsigned short *pe, *y;
+{
+register unsigned short r;
+register unsigned short *p, *e;
+unsigned short yy[NI];
+int denorm, k;
+
+e = pe;
+denorm = 0; /* flag if denormalized number */
+ecleaz(yy);
+#ifdef IBMPC
+e += 1;
+#endif
+#ifdef DEC
+e += 1;
+#endif
+r = *e;
+yy[0] = 0;
+if( r & 0x8000 )
+ yy[0] = 0xffff;
+yy[M] = (r & 0x7f) | 0200;
+r &= ~0x807f; /* strip sign and 7 significand bits */
+#ifdef INFINITY
+if( r == 0x7f80 )
+ {
+#ifdef NANS
+#ifdef MIEEE
+ if( ((pe[0] & 0x7f) != 0) || (pe[1] != 0) )
+ {
+ enan( y, NBITS );
+ return;
+ }
+#else
+ if( ((pe[1] & 0x7f) != 0) || (pe[0] != 0) )
+ {
+ enan( y, NBITS );
+ return;
+ }
+#endif
+#endif /* NANS */
+ eclear( y );
+ einfin( y );
+ if( yy[0] )
+ eneg(y);
+ return;
+ }
+#endif
+r >>= 7;
+/* If zero exponent, then the significand is denormalized.
+ * So, take back the understood high significand bit. */
+if( r == 0 )
+ {
+ denorm = 1;
+ yy[M] &= ~0200;
+ }
+r += EXONE - 0177;
+yy[E] = r;
+p = &yy[M+1];
+#ifdef IBMPC
+*p++ = *(--e);
+#endif
+#ifdef DEC
+*p++ = *(--e);
+#endif
+#ifdef MIEEE
+++e;
+*p++ = *e++;
+#endif
+(void )eshift( yy, -8 );
+if( denorm )
+ { /* if zero exponent, then normalize the significand */
+ if( (k = enormlz(yy)) > NBITS )
+ ecleazs(yy);
+ else
+ yy[E] -= (unsigned short )(k-1);
+ }
+emovo( yy, y );
+}
+
+void etoe113(x,e)
+unsigned short *x, *e;
+{
+unsigned short xi[NI];
+long exp;
+int rndsav;
+
+#ifdef NANS
+if( eisnan(x) )
+ {
+ enan( e, 113 );
+ return;
+ }
+#endif
+emovi( x, xi );
+exp = (long )xi[E];
+#ifdef INFINITY
+if( eisinf(x) )
+ goto nonorm;
+#endif
+/* round off to nearest or even */
+rndsav = rndprc;
+rndprc = 113;
+emdnorm( xi, 0, 0, exp, 64 );
+rndprc = rndsav;
+nonorm:
+toe113 (xi, e);
+}
+
+/* move out internal format to ieee long double */
+static void toe113(a,b)
+unsigned short *a, *b;
+{
+register unsigned short *p, *q;
+unsigned short i;
+
+#ifdef NANS
+if( eiisnan(a) )
+ {
+ enan( b, 113 );
+ return;
+ }
+#endif
+p = a;
+#ifdef MIEEE
+q = b;
+#else
+q = b + 7; /* point to output exponent */
+#endif
+
+/* If not denormal, delete the implied bit. */
+if( a[E] != 0 )
+ {
+ eshup1 (a);
+ }
+/* combine sign and exponent */
+i = *p++;
+#ifdef MIEEE
+if( i )
+ *q++ = *p++ | 0x8000;
+else
+ *q++ = *p++;
+#else
+if( i )
+ *q-- = *p++ | 0x8000;
+else
+ *q-- = *p++;
+#endif
+/* skip over guard word */
+++p;
+/* move the significand */
+#ifdef MIEEE
+for (i = 0; i < 7; i++)
+ *q++ = *p++;
+#else
+for (i = 0; i < 7; i++)
+ *q-- = *p++;
+#endif
+}
+
+
+void etoe64( x, e )
+unsigned short *x, *e;
+{
+unsigned short xi[NI];
+long exp;
+int rndsav;
+
+#ifdef NANS
+if( eisnan(x) )
+ {
+ enan( e, 64 );
+ return;
+ }
+#endif
+emovi( x, xi );
+exp = (long )xi[E]; /* adjust exponent for offset */
+#ifdef INFINITY
+if( eisinf(x) )
+ goto nonorm;
+#endif
+/* round off to nearest or even */
+rndsav = rndprc;
+rndprc = 64;
+emdnorm( xi, 0, 0, exp, 64 );
+rndprc = rndsav;
+nonorm:
+toe64( xi, e );
+}
+
+/* move out internal format to ieee long double */
+static void toe64( a, b )
+unsigned short *a, *b;
+{
+register unsigned short *p, *q;
+unsigned short i;
+
+#ifdef NANS
+if( eiisnan(a) )
+ {
+ enan( b, 64 );
+ return;
+ }
+#endif
+#ifdef IBMPC
+/* Shift Intel denormal significand down 1. */
+if( a[E] == 0 )
+ eshdn1(a);
+#endif
+p = a;
+#ifdef MIEEE
+q = b;
+#else
+q = b + 4; /* point to output exponent */
+#if 1
+/* NOTE: if data type is 96 bits wide, clear the last word here. */
+*(q+1)= 0;
+#endif
+#endif
+
+/* combine sign and exponent */
+i = *p++;
+#ifdef MIEEE
+if( i )
+ *q++ = *p++ | 0x8000;
+else
+ *q++ = *p++;
+*q++ = 0;
+#else
+if( i )
+ *q-- = *p++ | 0x8000;
+else
+ *q-- = *p++;
+#endif
+/* skip over guard word */
+++p;
+/* move the significand */
+#ifdef MIEEE
+for( i=0; i<4; i++ )
+ *q++ = *p++;
+#else
+#ifdef INFINITY
+if (eiisinf (a))
+ {
+ /* Intel long double infinity. */
+ *q-- = 0x8000;
+ *q-- = 0;
+ *q-- = 0;
+ *q = 0;
+ return;
+ }
+#endif
+for( i=0; i<4; i++ )
+ *q-- = *p++;
+#endif
+}
+
+
+/*
+; e type to IEEE double precision
+; double d;
+; unsigned short x[NE];
+; etoe53( x, &d );
+*/
+
+#ifdef DEC
+
+void etoe53( x, e )
+unsigned short *x, *e;
+{
+etodec( x, e ); /* see etodec.c */
+}
+
+static void toe53( x, y )
+unsigned short *x, *y;
+{
+todec( x, y );
+}
+
+#else
+
+void etoe53( x, e )
+unsigned short *x, *e;
+{
+unsigned short xi[NI];
+long exp;
+int rndsav;
+
+#ifdef NANS
+if( eisnan(x) )
+ {
+ enan( e, 53 );
+ return;
+ }
+#endif
+emovi( x, xi );
+exp = (long )xi[E] - (EXONE - 0x3ff); /* adjust exponent for offsets */
+#ifdef INFINITY
+if( eisinf(x) )
+ goto nonorm;
+#endif
+/* round off to nearest or even */
+rndsav = rndprc;
+rndprc = 53;
+emdnorm( xi, 0, 0, exp, 64 );
+rndprc = rndsav;
+nonorm:
+toe53( xi, e );
+}
+
+
+static void toe53( x, y )
+unsigned short *x, *y;
+{
+unsigned short i;
+unsigned short *p;
+
+
+#ifdef NANS
+if( eiisnan(x) )
+ {
+ enan( y, 53 );
+ return;
+ }
+#endif
+p = &x[0];
+#ifdef IBMPC
+y += 3;
+#endif
+*y = 0; /* output high order */
+if( *p++ )
+ *y = 0x8000; /* output sign bit */
+
+i = *p++;
+if( i >= (unsigned int )2047 )
+ { /* Saturate at largest number less than infinity. */
+#ifdef INFINITY
+ *y |= 0x7ff0;
+#ifdef IBMPC
+ *(--y) = 0;
+ *(--y) = 0;
+ *(--y) = 0;
+#endif
+#ifdef MIEEE
+ ++y;
+ *y++ = 0;
+ *y++ = 0;
+ *y++ = 0;
+#endif
+#else
+ *y |= (unsigned short )0x7fef;
+#ifdef IBMPC
+ *(--y) = 0xffff;
+ *(--y) = 0xffff;
+ *(--y) = 0xffff;
+#endif
+#ifdef MIEEE
+ ++y;
+ *y++ = 0xffff;
+ *y++ = 0xffff;
+ *y++ = 0xffff;
+#endif
+#endif
+ return;
+ }
+if( i == 0 )
+ {
+ (void )eshift( x, 4 );
+ }
+else
+ {
+ i <<= 4;
+ (void )eshift( x, 5 );
+ }
+i |= *p++ & (unsigned short )0x0f; /* *p = xi[M] */
+*y |= (unsigned short )i; /* high order output already has sign bit set */
+#ifdef IBMPC
+*(--y) = *p++;
+*(--y) = *p++;
+*(--y) = *p;
+#endif
+#ifdef MIEEE
+++y;
+*y++ = *p++;
+*y++ = *p++;
+*y++ = *p++;
+#endif
+}
+
+#endif /* not DEC */
+
+
+
+/*
+; e type to IEEE single precision
+; float d;
+; unsigned short x[N+2];
+; xtod( x, &d );
+*/
+void etoe24( x, e )
+unsigned short *x, *e;
+{
+long exp;
+unsigned short xi[NI];
+int rndsav;
+
+#ifdef NANS
+if( eisnan(x) )
+ {
+ enan( e, 24 );
+ return;
+ }
+#endif
+emovi( x, xi );
+exp = (long )xi[E] - (EXONE - 0177); /* adjust exponent for offsets */
+#ifdef INFINITY
+if( eisinf(x) )
+ goto nonorm;
+#endif
+/* round off to nearest or even */
+rndsav = rndprc;
+rndprc = 24;
+emdnorm( xi, 0, 0, exp, 64 );
+rndprc = rndsav;
+nonorm:
+toe24( xi, e );
+}
+
+static void toe24( x, y )
+unsigned short *x, *y;
+{
+unsigned short i;
+unsigned short *p;
+
+#ifdef NANS
+if( eiisnan(x) )
+ {
+ enan( y, 24 );
+ return;
+ }
+#endif
+p = &x[0];
+#ifdef IBMPC
+y += 1;
+#endif
+#ifdef DEC
+y += 1;
+#endif
+*y = 0; /* output high order */
+if( *p++ )
+ *y = 0x8000; /* output sign bit */
+
+i = *p++;
+if( i >= 255 )
+ { /* Saturate at largest number less than infinity. */
+#ifdef INFINITY
+ *y |= (unsigned short )0x7f80;
+#ifdef IBMPC
+ *(--y) = 0;
+#endif
+#ifdef DEC
+ *(--y) = 0;
+#endif
+#ifdef MIEEE
+ ++y;
+ *y = 0;
+#endif
+#else
+ *y |= (unsigned short )0x7f7f;
+#ifdef IBMPC
+ *(--y) = 0xffff;
+#endif
+#ifdef DEC
+ *(--y) = 0xffff;
+#endif
+#ifdef MIEEE
+ ++y;
+ *y = 0xffff;
+#endif
+#endif
+ return;
+ }
+if( i == 0 )
+ {
+ (void )eshift( x, 7 );
+ }
+else
+ {
+ i <<= 7;
+ (void )eshift( x, 8 );
+ }
+i |= *p++ & (unsigned short )0x7f; /* *p = xi[M] */
+*y |= i; /* high order output already has sign bit set */
+#ifdef IBMPC
+*(--y) = *p;
+#endif
+#ifdef DEC
+*(--y) = *p;
+#endif
+#ifdef MIEEE
+++y;
+*y = *p;
+#endif
+}
+
+
+/* Compare two e type numbers.
+ *
+ * unsigned short a[NE], b[NE];
+ * ecmp( a, b );
+ *
+ * returns +1 if a > b
+ * 0 if a == b
+ * -1 if a < b
+ * -2 if either a or b is a NaN.
+ */
+int ecmp( a, b )
+unsigned short *a, *b;
+{
+unsigned short ai[NI], bi[NI];
+register unsigned short *p, *q;
+register int i;
+int msign;
+
+#ifdef NANS
+if (eisnan (a) || eisnan (b))
+ return( -2 );
+#endif
+emovi( a, ai );
+p = ai;
+emovi( b, bi );
+q = bi;
+
+if( *p != *q )
+ { /* the signs are different */
+/* -0 equals + 0 */
+ for( i=1; i<NI-1; i++ )
+ {
+ if( ai[i] != 0 )
+ goto nzro;
+ if( bi[i] != 0 )
+ goto nzro;
+ }
+ return(0);
+nzro:
+ if( *p == 0 )
+ return( 1 );
+ else
+ return( -1 );
+ }
+/* both are the same sign */
+if( *p == 0 )
+ msign = 1;
+else
+ msign = -1;
+i = NI-1;
+do
+ {
+ if( *p++ != *q++ )
+ {
+ goto diff;
+ }
+ }
+while( --i > 0 );
+
+return(0); /* equality */
+
+
+
+diff:
+
+if( *(--p) > *(--q) )
+ return( msign ); /* p is bigger */
+else
+ return( -msign ); /* p is littler */
+}
+
+
+
+
+/* Find nearest integer to x = floor( x + 0.5 )
+ *
+ * unsigned short x[NE], y[NE]
+ * eround( x, y );
+ */
+void eround( x, y )
+unsigned short *x, *y;
+{
+
+eadd( ehalf, x, y );
+efloor( y, y );
+}
+
+
+
+
+/*
+; convert long (32-bit) integer to e type
+;
+; long l;
+; unsigned short x[NE];
+; ltoe( &l, x );
+; note &l is the memory address of l
+*/
+void ltoe( lp, y )
+long *lp; /* lp is the memory address of a long integer */
+unsigned short *y; /* y is the address of a short */
+{
+unsigned short yi[NI];
+unsigned long ll;
+int k;
+
+ecleaz( yi );
+if( *lp < 0 )
+ {
+ ll = (unsigned long )( -(*lp) ); /* make it positive */
+ yi[0] = 0xffff; /* put correct sign in the e type number */
+ }
+else
+ {
+ ll = (unsigned long )( *lp );
+ }
+/* move the long integer to yi significand area */
+if( sizeof(long) == 8 )
+ {
+ yi[M] = (unsigned short) (ll >> (LONGBITS - 16));
+ yi[M + 1] = (unsigned short) (ll >> (LONGBITS - 32));
+ yi[M + 2] = (unsigned short) (ll >> 16);
+ yi[M + 3] = (unsigned short) ll;
+ yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
+ }
+else
+ {
+ yi[M] = (unsigned short )(ll >> 16);
+ yi[M+1] = (unsigned short )ll;
+ yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
+ }
+if( (k = enormlz( yi )) > NBITS ) /* normalize the significand */
+ ecleaz( yi ); /* it was zero */
+else
+ yi[E] -= (unsigned short )k; /* subtract shift count from exponent */
+emovo( yi, y ); /* output the answer */
+}
+
+/*
+; convert unsigned long (32-bit) integer to e type
+;
+; unsigned long l;
+; unsigned short x[NE];
+; ltox( &l, x );
+; note &l is the memory address of l
+*/
+void ultoe( lp, y )
+unsigned long *lp; /* lp is the memory address of a long integer */
+unsigned short *y; /* y is the address of a short */
+{
+unsigned short yi[NI];
+unsigned long ll;
+int k;
+
+ecleaz( yi );
+ll = *lp;
+
+/* move the long integer to ayi significand area */
+if( sizeof(long) == 8 )
+ {
+ yi[M] = (unsigned short) (ll >> (LONGBITS - 16));
+ yi[M + 1] = (unsigned short) (ll >> (LONGBITS - 32));
+ yi[M + 2] = (unsigned short) (ll >> 16);
+ yi[M + 3] = (unsigned short) ll;
+ yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
+ }
+else
+ {
+ yi[M] = (unsigned short )(ll >> 16);
+ yi[M+1] = (unsigned short )ll;
+ yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
+ }
+if( (k = enormlz( yi )) > NBITS ) /* normalize the significand */
+ ecleaz( yi ); /* it was zero */
+else
+ yi[E] -= (unsigned short )k; /* subtract shift count from exponent */
+emovo( yi, y ); /* output the answer */
+}
+
+
+/*
+; Find long integer and fractional parts
+
+; long i;
+; unsigned short x[NE], frac[NE];
+; xifrac( x, &i, frac );
+
+ The integer output has the sign of the input. The fraction is
+ the positive fractional part of abs(x).
+*/
+void eifrac( x, i, frac )
+unsigned short *x;
+long *i;
+unsigned short *frac;
+{
+unsigned short xi[NI];
+int j, k;
+unsigned long ll;
+
+emovi( x, xi );
+k = (int )xi[E] - (EXONE - 1);
+if( k <= 0 )
+ {
+/* if exponent <= 0, integer = 0 and real output is fraction */
+ *i = 0L;
+ emovo( xi, frac );
+ return;
+ }
+if( k > (8 * sizeof(long) - 1) )
+ {
+/*
+; long integer overflow: output large integer
+; and correct fraction
+*/
+ j = 8 * sizeof(long) - 1;
+ if( xi[0] )
+ *i = (long) ((unsigned long) 1) << j;
+ else
+ *i = (long) (((unsigned long) (~(0L))) >> 1);
+ (void )eshift( xi, k );
+ }
+if( k > 16 )
+ {
+/*
+ Shift more than 16 bits: shift up k-16 mod 16
+ then shift by 16's.
+*/
+ j = k - ((k >> 4) << 4);
+ eshift (xi, j);
+ ll = xi[M];
+ k -= j;
+ do
+ {
+ eshup6 (xi);
+ ll = (ll << 16) | xi[M];
+ }
+ while ((k -= 16) > 0);
+ *i = ll;
+ if (xi[0])
+ *i = -(*i);
+ }
+else
+ {
+/* shift not more than 16 bits */
+ eshift( xi, k );
+ *i = (long )xi[M] & 0xffff;
+ if( xi[0] )
+ *i = -(*i);
+ }
+xi[0] = 0;
+xi[E] = EXONE - 1;
+xi[M] = 0;
+if( (k = enormlz( xi )) > NBITS )
+ ecleaz( xi );
+else
+ xi[E] -= (unsigned short )k;
+
+emovo( xi, frac );
+}
+
+
+/*
+; Find unsigned long integer and fractional parts
+
+; unsigned long i;
+; unsigned short x[NE], frac[NE];
+; xifrac( x, &i, frac );
+
+ A negative e type input yields integer output = 0
+ but correct fraction.
+*/
+void euifrac( x, i, frac )
+unsigned short *x;
+unsigned long *i;
+unsigned short *frac;
+{
+unsigned short xi[NI];
+int j, k;
+unsigned long ll;
+
+emovi( x, xi );
+k = (int )xi[E] - (EXONE - 1);
+if( k <= 0 )
+ {
+/* if exponent <= 0, integer = 0 and argument is fraction */
+ *i = 0L;
+ emovo( xi, frac );
+ return;
+ }
+if( k > (8 * sizeof(long)) )
+ {
+/*
+; long integer overflow: output large integer
+; and correct fraction
+*/
+ *i = ~(0L);
+ (void )eshift( xi, k );
+ }
+else if( k > 16 )
+ {
+/*
+ Shift more than 16 bits: shift up k-16 mod 16
+ then shift up by 16's.
+*/
+ j = k - ((k >> 4) << 4);
+ eshift (xi, j);
+ ll = xi[M];
+ k -= j;
+ do
+ {
+ eshup6 (xi);
+ ll = (ll << 16) | xi[M];
+ }
+ while ((k -= 16) > 0);
+ *i = ll;
+ }
+else
+ {
+/* shift not more than 16 bits */
+ eshift( xi, k );
+ *i = (long )xi[M] & 0xffff;
+ }
+
+if( xi[0] ) /* A negative value yields unsigned integer 0. */
+ *i = 0L;
+
+xi[0] = 0;
+xi[E] = EXONE - 1;
+xi[M] = 0;
+if( (k = enormlz( xi )) > NBITS )
+ ecleaz( xi );
+else
+ xi[E] -= (unsigned short )k;
+
+emovo( xi, frac );
+}
+
+
+
+/*
+; Shift significand
+;
+; Shifts significand area up or down by the number of bits
+; given by the variable sc.
+*/
+int eshift( x, sc )
+unsigned short *x;
+int sc;
+{
+unsigned short lost;
+unsigned short *p;
+
+if( sc == 0 )
+ return( 0 );
+
+lost = 0;
+p = x + NI-1;
+
+if( sc < 0 )
+ {
+ sc = -sc;
+ while( sc >= 16 )
+ {
+ lost |= *p; /* remember lost bits */
+ eshdn6(x);
+ sc -= 16;
+ }
+
+ while( sc >= 8 )
+ {
+ lost |= *p & 0xff;
+ eshdn8(x);
+ sc -= 8;
+ }
+
+ while( sc > 0 )
+ {
+ lost |= *p & 1;
+ eshdn1(x);
+ sc -= 1;
+ }
+ }
+else
+ {
+ while( sc >= 16 )
+ {
+ eshup6(x);
+ sc -= 16;
+ }
+
+ while( sc >= 8 )
+ {
+ eshup8(x);
+ sc -= 8;
+ }
+
+ while( sc > 0 )
+ {
+ eshup1(x);
+ sc -= 1;
+ }
+ }
+if( lost )
+ lost = 1;
+return( (int )lost );
+}
+
+
+
+/*
+; normalize
+;
+; Shift normalizes the significand area pointed to by argument
+; shift count (up = positive) is returned.
+*/
+int enormlz(x)
+unsigned short x[];
+{
+register unsigned short *p;
+int sc;
+
+sc = 0;
+p = &x[M];
+if( *p != 0 )
+ goto normdn;
+++p;
+if( *p & 0x8000 )
+ return( 0 ); /* already normalized */
+while( *p == 0 )
+ {
+ eshup6(x);
+ sc += 16;
+/* With guard word, there are NBITS+16 bits available.
+ * return true if all are zero.
+ */
+ if( sc > NBITS )
+ return( sc );
+ }
+/* see if high byte is zero */
+while( (*p & 0xff00) == 0 )
+ {
+ eshup8(x);
+ sc += 8;
+ }
+/* now shift 1 bit at a time */
+while( (*p & 0x8000) == 0)
+ {
+ eshup1(x);
+ sc += 1;
+ if( sc > (NBITS+16) )
+ {
+ mtherr( "enormlz", UNDERFLOW );
+ return( sc );
+ }
+ }
+return( sc );
+
+/* Normalize by shifting down out of the high guard word
+ of the significand */
+normdn:
+
+if( *p & 0xff00 )
+ {
+ eshdn8(x);
+ sc -= 8;
+ }
+while( *p != 0 )
+ {
+ eshdn1(x);
+ sc -= 1;
+
+ if( sc < -NBITS )
+ {
+ mtherr( "enormlz", OVERFLOW );
+ return( sc );
+ }
+ }
+return( sc );
+}
+
+
+
+
+/* Convert e type number to decimal format ASCII string.
+ * The constants are for 64 bit precision.
+ */
+
+#define NTEN 12
+#define MAXP 4096
+
+#if NE == 10
+static unsigned short etens[NTEN + 1][NE] =
+{
+ {0x6576, 0x4a92, 0x804a, 0x153f,
+ 0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
+ {0x6a32, 0xce52, 0x329a, 0x28ce,
+ 0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
+ {0x526c, 0x50ce, 0xf18b, 0x3d28,
+ 0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
+ {0x9c66, 0x58f8, 0xbc50, 0x5c54,
+ 0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
+ {0x851e, 0xeab7, 0x98fe, 0x901b,
+ 0xddbb, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
+ {0x0235, 0x0137, 0x36b1, 0x336c,
+ 0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
+ {0x50f8, 0x25fb, 0xc76b, 0x6b71,
+ 0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
+ {0x0000, 0x0000, 0x0000, 0x0000,
+ 0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
+};
+
+static unsigned short emtens[NTEN + 1][NE] =
+{
+ {0x2030, 0xcffc, 0xa1c3, 0x8123,
+ 0x2de3, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
+ {0x8264, 0xd2cb, 0xf2ea, 0x12d4,
+ 0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
+ {0xf53f, 0xf698, 0x6bd3, 0x0158,
+ 0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
+ {0xe731, 0x04d4, 0xe3f2, 0xd332,
+ 0x7132, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
+ {0xa23e, 0x5308, 0xfefb, 0x1155,
+ 0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
+ {0xe26d, 0xdbde, 0xd05d, 0xb3f6,
+ 0xac7c, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
+ {0x2a20, 0x6224, 0x47b3, 0x98d7,
+ 0x3f23, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
+ {0x0b5b, 0x4af2, 0xa581, 0x18ed,
+ 0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
+ {0xbf71, 0xa9b3, 0x7989, 0xbe68,
+ 0x4c2e, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
+ {0x3d4d, 0x7c3d, 0x36ba, 0x0d2b,
+ 0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
+ {0xc155, 0xa4a8, 0x404e, 0x6113,
+ 0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
+ {0xd70a, 0x70a3, 0x0a3d, 0xa3d7,
+ 0x3d70, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
+ {0xcccd, 0xcccc, 0xcccc, 0xcccc,
+ 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
+};
+#else
+static unsigned short etens[NTEN+1][NE] = {
+{0xc94c,0x979a,0x8a20,0x5202,0xc460,0x7525,},/* 10**4096 */
+{0xa74d,0x5de4,0xc53d,0x3b5d,0x9e8b,0x5a92,},/* 10**2048 */
+{0x650d,0x0c17,0x8175,0x7586,0xc976,0x4d48,},
+{0xcc65,0x91c6,0xa60e,0xa0ae,0xe319,0x46a3,},
+{0xddbc,0xde8d,0x9df9,0xebfb,0xaa7e,0x4351,},
+{0xc66f,0x8cdf,0x80e9,0x47c9,0x93ba,0x41a8,},
+{0x3cbf,0xa6d5,0xffcf,0x1f49,0xc278,0x40d3,},
+{0xf020,0xb59d,0x2b70,0xada8,0x9dc5,0x4069,},
+{0x0000,0x0000,0x0400,0xc9bf,0x8e1b,0x4034,},
+{0x0000,0x0000,0x0000,0x2000,0xbebc,0x4019,},
+{0x0000,0x0000,0x0000,0x0000,0x9c40,0x400c,},
+{0x0000,0x0000,0x0000,0x0000,0xc800,0x4005,},
+{0x0000,0x0000,0x0000,0x0000,0xa000,0x4002,}, /* 10**1 */
+};
+
+static unsigned short emtens[NTEN+1][NE] = {
+{0x2de4,0x9fde,0xd2ce,0x04c8,0xa6dd,0x0ad8,}, /* 10**-4096 */
+{0x4925,0x2de4,0x3436,0x534f,0xceae,0x256b,}, /* 10**-2048 */
+{0x87a6,0xc0bd,0xda57,0x82a5,0xa2a6,0x32b5,},
+{0x7133,0xd21c,0xdb23,0xee32,0x9049,0x395a,},
+{0xfa91,0x1939,0x637a,0x4325,0xc031,0x3cac,},
+{0xac7d,0xe4a0,0x64bc,0x467c,0xddd0,0x3e55,},
+{0x3f24,0xe9a5,0xa539,0xea27,0xa87f,0x3f2a,},
+{0x67de,0x94ba,0x4539,0x1ead,0xcfb1,0x3f94,},
+{0x4c2f,0xe15b,0xc44d,0x94be,0xe695,0x3fc9,},
+{0xfdc2,0xcefc,0x8461,0x7711,0xabcc,0x3fe4,},
+{0xd3c3,0x652b,0xe219,0x1758,0xd1b7,0x3ff1,},
+{0x3d71,0xd70a,0x70a3,0x0a3d,0xa3d7,0x3ff8,},
+{0xcccd,0xcccc,0xcccc,0xcccc,0xcccc,0x3ffb,}, /* 10**-1 */
+};
+#endif
+
+void e24toasc( x, string, ndigs )
+unsigned short x[];
+char *string;
+int ndigs;
+{
+unsigned short w[NI];
+
+e24toe( x, w );
+etoasc( w, string, ndigs );
+}
+
+
+void e53toasc( x, string, ndigs )
+unsigned short x[];
+char *string;
+int ndigs;
+{
+unsigned short w[NI];
+
+e53toe( x, w );
+etoasc( w, string, ndigs );
+}
+
+
+void e64toasc( x, string, ndigs )
+unsigned short x[];
+char *string;
+int ndigs;
+{
+unsigned short w[NI];
+
+e64toe( x, w );
+etoasc( w, string, ndigs );
+}
+
+void e113toasc (x, string, ndigs)
+unsigned short x[];
+char *string;
+int ndigs;
+{
+unsigned short w[NI];
+
+e113toe (x, w);
+etoasc (w, string, ndigs);
+}
+
+
+void etoasc( x, string, ndigs )
+unsigned short x[];
+char *string;
+int ndigs;
+{
+long digit;
+unsigned short y[NI], t[NI], u[NI], w[NI];
+unsigned short *p, *r, *ten;
+unsigned short sign;
+int i, j, k, expon, rndsav;
+char *s, *ss;
+unsigned short m;
+
+rndsav = rndprc;
+#ifdef NANS
+if( eisnan(x) )
+ {
+ sprintf( string, " NaN " );
+ goto bxit;
+ }
+#endif
+rndprc = NBITS; /* set to full precision */
+emov( x, y ); /* retain external format */
+if( y[NE-1] & 0x8000 )
+ {
+ sign = 0xffff;
+ y[NE-1] &= 0x7fff;
+ }
+else
+ {
+ sign = 0;
+ }
+expon = 0;
+ten = &etens[NTEN][0];
+emov( eone, t );
+/* Test for zero exponent */
+if( y[NE-1] == 0 )
+ {
+ for( k=0; k<NE-1; k++ )
+ {
+ if( y[k] != 0 )
+ goto tnzro; /* denormalized number */
+ }
+ goto isone; /* legal all zeros */
+ }
+tnzro:
+
+/* Test for infinity.
+ */
+if( y[NE-1] == 0x7fff )
+ {
+ if( sign )
+ sprintf( string, " -Infinity " );
+ else
+ sprintf( string, " Infinity " );
+ goto bxit;
+ }
+
+/* Test for exponent nonzero but significand denormalized.
+ * This is an error condition.
+ */
+if( (y[NE-1] != 0) && ((y[NE-2] & 0x8000) == 0) )
+ {
+ mtherr( "etoasc", DOMAIN );
+ sprintf( string, "NaN" );
+ goto bxit;
+ }
+
+/* Compare to 1.0 */
+i = ecmp( eone, y );
+if( i == 0 )
+ goto isone;
+
+if( i < 0 )
+ { /* Number is greater than 1 */
+/* Convert significand to an integer and strip trailing decimal zeros. */
+ emov( y, u );
+ u[NE-1] = EXONE + NBITS - 1;
+
+ p = &etens[NTEN-4][0];
+ m = 16;
+do
+ {
+ ediv( p, u, t );
+ efloor( t, w );
+ for( j=0; j<NE-1; j++ )
+ {
+ if( t[j] != w[j] )
+ goto noint;
+ }
+ emov( t, u );
+ expon += (int )m;
+noint:
+ p += NE;
+ m >>= 1;
+ }
+while( m != 0 );
+
+/* Rescale from integer significand */
+ u[NE-1] += y[NE-1] - (unsigned int )(EXONE + NBITS - 1);
+ emov( u, y );
+/* Find power of 10 */
+ emov( eone, t );
+ m = MAXP;
+ p = &etens[0][0];
+ while( ecmp( ten, u ) <= 0 )
+ {
+ if( ecmp( p, u ) <= 0 )
+ {
+ ediv( p, u, u );
+ emul( p, t, t );
+ expon += (int )m;
+ }
+ m >>= 1;
+ if( m == 0 )
+ break;
+ p += NE;
+ }
+ }
+else
+ { /* Number is less than 1.0 */
+/* Pad significand with trailing decimal zeros. */
+ if( y[NE-1] == 0 )
+ {
+ while( (y[NE-2] & 0x8000) == 0 )
+ {
+ emul( ten, y, y );
+ expon -= 1;
+ }
+ }
+ else
+ {
+ emovi( y, w );
+ for( i=0; i<NDEC+1; i++ )
+ {
+ if( (w[NI-1] & 0x7) != 0 )
+ break;
+/* multiply by 10 */
+ emovz( w, u );
+ eshdn1( u );
+ eshdn1( u );
+ eaddm( w, u );
+ u[1] += 3;
+ while( u[2] != 0 )
+ {
+ eshdn1(u);
+ u[1] += 1;
+ }
+ if( u[NI-1] != 0 )
+ break;
+ if( eone[NE-1] <= u[1] )
+ break;
+ emovz( u, w );
+ expon -= 1;
+ }
+ emovo( w, y );
+ }
+ k = -MAXP;
+ p = &emtens[0][0];
+ r = &etens[0][0];
+ emov( y, w );
+ emov( eone, t );
+ while( ecmp( eone, w ) > 0 )
+ {
+ if( ecmp( p, w ) >= 0 )
+ {
+ emul( r, w, w );
+ emul( r, t, t );
+ expon += k;
+ }
+ k /= 2;
+ if( k == 0 )
+ break;
+ p += NE;
+ r += NE;
+ }
+ ediv( t, eone, t );
+ }
+isone:
+/* Find the first (leading) digit. */
+emovi( t, w );
+emovz( w, t );
+emovi( y, w );
+emovz( w, y );
+eiremain( t, y );
+digit = equot[NI-1];
+while( (digit == 0) && (ecmp(y,ezero) != 0) )
+ {
+ eshup1( y );
+ emovz( y, u );
+ eshup1( u );
+ eshup1( u );
+ eaddm( u, y );
+ eiremain( t, y );
+ digit = equot[NI-1];
+ expon -= 1;
+ }
+s = string;
+if( sign )
+ *s++ = '-';
+else
+ *s++ = ' ';
+/* Examine number of digits requested by caller. */
+if( ndigs < 0 )
+ ndigs = 0;
+if( ndigs > NDEC )
+ ndigs = NDEC;
+if( digit == 10 )
+ {
+ *s++ = '1';
+ *s++ = '.';
+ if( ndigs > 0 )
+ {
+ *s++ = '0';
+ ndigs -= 1;
+ }
+ expon += 1;
+ }
+else
+ {
+ *s++ = (char )digit + '0';
+ *s++ = '.';
+ }
+/* Generate digits after the decimal point. */
+for( k=0; k<=ndigs; k++ )
+ {
+/* multiply current number by 10, without normalizing */
+ eshup1( y );
+ emovz( y, u );
+ eshup1( u );
+ eshup1( u );
+ eaddm( u, y );
+ eiremain( t, y );
+ *s++ = (char )equot[NI-1] + '0';
+ }
+digit = equot[NI-1];
+--s;
+ss = s;
+/* round off the ASCII string */
+if( digit > 4 )
+ {
+/* Test for critical rounding case in ASCII output. */
+ if( digit == 5 )
+ {
+ emovo( y, t );
+ if( ecmp(t,ezero) != 0 )
+ goto roun; /* round to nearest */
+ if( (*(s-1) & 1) == 0 )
+ goto doexp; /* round to even */
+ }
+/* Round up and propagate carry-outs */
+roun:
+ --s;
+ k = *s & 0x7f;
+/* Carry out to most significant digit? */
+ if( k == '.' )
+ {
+ --s;
+ k = *s;
+ k += 1;
+ *s = (char )k;
+/* Most significant digit carries to 10? */
+ if( k > '9' )
+ {
+ expon += 1;
+ *s = '1';
+ }
+ goto doexp;
+ }
+/* Round up and carry out from less significant digits */
+ k += 1;
+ *s = (char )k;
+ if( k > '9' )
+ {
+ *s = '0';
+ goto roun;
+ }
+ }
+doexp:
+/*
+if( expon >= 0 )
+ sprintf( ss, "e+%d", expon );
+else
+ sprintf( ss, "e%d", expon );
+*/
+ sprintf( ss, "E%d", expon );
+bxit:
+rndprc = rndsav;
+}
+
+
+
+
+/*
+; ASCTOQ
+; ASCTOQ.MAC LATEST REV: 11 JAN 84
+; SLM, 3 JAN 78
+;
+; Convert ASCII string to quadruple precision floating point
+;
+; Numeric input is free field decimal number
+; with max of 15 digits with or without
+; decimal point entered as ASCII from teletype.
+; Entering E after the number followed by a second
+; number causes the second number to be interpreted
+; as a power of 10 to be multiplied by the first number
+; (i.e., "scientific" notation).
+;
+; Usage:
+; asctoq( string, q );
+*/
+
+/* ASCII to single */
+void asctoe24( s, y )
+char *s;
+unsigned short *y;
+{
+asctoeg( s, y, 24 );
+}
+
+
+/* ASCII to double */
+void asctoe53( s, y )
+char *s;
+unsigned short *y;
+{
+#ifdef DEC
+asctoeg( s, y, 56 );
+#else
+asctoeg( s, y, 53 );
+#endif
+}
+
+
+/* ASCII to long double */
+void asctoe64( s, y )
+char *s;
+unsigned short *y;
+{
+asctoeg( s, y, 64 );
+}
+
+/* ASCII to 128-bit long double */
+void asctoe113 (s, y)
+char *s;
+unsigned short *y;
+{
+asctoeg( s, y, 113 );
+}
+
+/* ASCII to super double */
+void asctoe( s, y )
+char *s;
+unsigned short *y;
+{
+asctoeg( s, y, NBITS );
+}
+
+/* Space to make a copy of the input string: */
+static char lstr[82] = {0};
+
+void asctoeg( ss, y, oprec )
+char *ss;
+unsigned short *y;
+int oprec;
+{
+unsigned short yy[NI], xt[NI], tt[NI];
+int esign, decflg, sgnflg, nexp, exp, prec, lost;
+int k, trail, c, rndsav;
+long lexp;
+unsigned short nsign, *p;
+char *sp, *s;
+
+/* Copy the input string. */
+s = ss;
+while( *s == ' ' ) /* skip leading spaces */
+ ++s;
+sp = lstr;
+for( k=0; k<79; k++ )
+ {
+ if( (*sp++ = *s++) == '\0' )
+ break;
+ }
+*sp = '\0';
+s = lstr;
+
+rndsav = rndprc;
+rndprc = NBITS; /* Set to full precision */
+lost = 0;
+nsign = 0;
+decflg = 0;
+sgnflg = 0;
+nexp = 0;
+exp = 0;
+prec = 0;
+ecleaz( yy );
+trail = 0;
+
+nxtcom:
+k = *s - '0';
+if( (k >= 0) && (k <= 9) )
+ {
+/* Ignore leading zeros */
+ if( (prec == 0) && (decflg == 0) && (k == 0) )
+ goto donchr;
+/* Identify and strip trailing zeros after the decimal point. */
+ if( (trail == 0) && (decflg != 0) )
+ {
+ sp = s;
+ while( (*sp >= '0') && (*sp <= '9') )
+ ++sp;
+/* Check for syntax error */
+ c = *sp & 0x7f;
+ if( (c != 'e') && (c != 'E') && (c != '\0')
+ && (c != '\n') && (c != '\r') && (c != ' ')
+ && (c != ',') )
+ goto error;
+ --sp;
+ while( *sp == '0' )
+ *sp-- = 'z';
+ trail = 1;
+ if( *s == 'z' )
+ goto donchr;
+ }
+/* If enough digits were given to more than fill up the yy register,
+ * continuing until overflow into the high guard word yy[2]
+ * guarantees that there will be a roundoff bit at the top
+ * of the low guard word after normalization.
+ */
+ if( yy[2] == 0 )
+ {
+ if( decflg )
+ nexp += 1; /* count digits after decimal point */
+ eshup1( yy ); /* multiply current number by 10 */
+ emovz( yy, xt );
+ eshup1( xt );
+ eshup1( xt );
+ eaddm( xt, yy );
+ ecleaz( xt );
+ xt[NI-2] = (unsigned short )k;
+ eaddm( xt, yy );
+ }
+ else
+ {
+ /* Mark any lost non-zero digit. */
+ lost |= k;
+ /* Count lost digits before the decimal point. */
+ if (decflg == 0)
+ nexp -= 1;
+ }
+ prec += 1;
+ goto donchr;
+ }
+
+switch( *s )
+ {
+ case 'z':
+ break;
+ case 'E':
+ case 'e':
+ goto expnt;
+ case '.': /* decimal point */
+ if( decflg )
+ goto error;
+ ++decflg;
+ break;
+ case '-':
+ nsign = 0xffff;
+ if( sgnflg )
+ goto error;
+ ++sgnflg;
+ break;
+ case '+':
+ if( sgnflg )
+ goto error;
+ ++sgnflg;
+ break;
+ case ',':
+ case ' ':
+ case '\0':
+ case '\n':
+ case '\r':
+ goto daldone;
+ case 'i':
+ case 'I':
+ goto infinite;
+ default:
+ error:
+#ifdef NANS
+ enan( yy, NI*16 );
+#else
+ mtherr( "asctoe", DOMAIN );
+ ecleaz(yy);
+#endif
+ goto aexit;
+ }
+donchr:
+++s;
+goto nxtcom;
+
+/* Exponent interpretation */
+expnt:
+
+esign = 1;
+exp = 0;
+++s;
+/* check for + or - */
+if( *s == '-' )
+ {
+ esign = -1;
+ ++s;
+ }
+if( *s == '+' )
+ ++s;
+while( (*s >= '0') && (*s <= '9') )
+ {
+ exp *= 10;
+ exp += *s++ - '0';
+ if (exp > 4977)
+ {
+ if (esign < 0)
+ goto zero;
+ else
+ goto infinite;
+ }
+ }
+if( esign < 0 )
+ exp = -exp;
+if( exp > 4932 )
+ {
+infinite:
+ ecleaz(yy);
+ yy[E] = 0x7fff; /* infinity */
+ goto aexit;
+ }
+if( exp < -4977 )
+ {
+zero:
+ ecleaz(yy);
+ goto aexit;
+ }
+
+daldone:
+nexp = exp - nexp;
+/* Pad trailing zeros to minimize power of 10, per IEEE spec. */
+while( (nexp > 0) && (yy[2] == 0) )
+ {
+ emovz( yy, xt );
+ eshup1( xt );
+ eshup1( xt );
+ eaddm( yy, xt );
+ eshup1( xt );
+ if( xt[2] != 0 )
+ break;
+ nexp -= 1;
+ emovz( xt, yy );
+ }
+if( (k = enormlz(yy)) > NBITS )
+ {
+ ecleaz(yy);
+ goto aexit;
+ }
+lexp = (EXONE - 1 + NBITS) - k;
+emdnorm( yy, lost, 0, lexp, 64 );
+/* convert to external format */
+
+
+/* Multiply by 10**nexp. If precision is 64 bits,
+ * the maximum relative error incurred in forming 10**n
+ * for 0 <= n <= 324 is 8.2e-20, at 10**180.
+ * For 0 <= n <= 999, the peak relative error is 1.4e-19 at 10**947.
+ * For 0 >= n >= -999, it is -1.55e-19 at 10**-435.
+ */
+lexp = yy[E];
+if( nexp == 0 )
+ {
+ k = 0;
+ goto expdon;
+ }
+esign = 1;
+if( nexp < 0 )
+ {
+ nexp = -nexp;
+ esign = -1;
+ if( nexp > 4096 )
+ { /* Punt. Can't handle this without 2 divides. */
+ emovi( etens[0], tt );
+ lexp -= tt[E];
+ k = edivm( tt, yy );
+ lexp += EXONE;
+ nexp -= 4096;
+ }
+ }
+p = &etens[NTEN][0];
+emov( eone, xt );
+exp = 1;
+do
+ {
+ if( exp & nexp )
+ emul( p, xt, xt );
+ p -= NE;
+ exp = exp + exp;
+ }
+while( exp <= MAXP );
+
+emovi( xt, tt );
+if( esign < 0 )
+ {
+ lexp -= tt[E];
+ k = edivm( tt, yy );
+ lexp += EXONE;
+ }
+else
+ {
+ lexp += tt[E];
+ k = emulm( tt, yy );
+ lexp -= EXONE - 1;
+ }
+
+expdon:
+
+/* Round and convert directly to the destination type */
+if( oprec == 53 )
+ lexp -= EXONE - 0x3ff;
+else if( oprec == 24 )
+ lexp -= EXONE - 0177;
+#ifdef DEC
+else if( oprec == 56 )
+ lexp -= EXONE - 0201;
+#endif
+rndprc = oprec;
+emdnorm( yy, k, 0, lexp, 64 );
+
+aexit:
+
+rndprc = rndsav;
+yy[0] = nsign;
+switch( oprec )
+ {
+#ifdef DEC
+ case 56:
+ todec( yy, y ); /* see etodec.c */
+ break;
+#endif
+ case 53:
+ toe53( yy, y );
+ break;
+ case 24:
+ toe24( yy, y );
+ break;
+ case 64:
+ toe64( yy, y );
+ break;
+ case 113:
+ toe113( yy, y );
+ break;
+ case NBITS:
+ emovo( yy, y );
+ break;
+ }
+}
+
+
+
+/* y = largest integer not greater than x
+ * (truncated toward minus infinity)
+ *
+ * unsigned short x[NE], y[NE]
+ *
+ * efloor( x, y );
+ */
+static unsigned short bmask[] = {
+0xffff,
+0xfffe,
+0xfffc,
+0xfff8,
+0xfff0,
+0xffe0,
+0xffc0,
+0xff80,
+0xff00,
+0xfe00,
+0xfc00,
+0xf800,
+0xf000,
+0xe000,
+0xc000,
+0x8000,
+0x0000,
+};
+
+void efloor( x, y )
+unsigned short x[], y[];
+{
+register unsigned short *p;
+int e, expon, i;
+unsigned short f[NE];
+
+emov( x, f ); /* leave in external format */
+expon = (int )f[NE-1];
+e = (expon & 0x7fff) - (EXONE - 1);
+if( e <= 0 )
+ {
+ eclear(y);
+ goto isitneg;
+ }
+/* number of bits to clear out */
+e = NBITS - e;
+emov( f, y );
+if( e <= 0 )
+ return;
+
+p = &y[0];
+while( e >= 16 )
+ {
+ *p++ = 0;
+ e -= 16;
+ }
+/* clear the remaining bits */
+*p &= bmask[e];
+/* truncate negatives toward minus infinity */
+isitneg:
+
+if( (unsigned short )expon & (unsigned short )0x8000 )
+ {
+ for( i=0; i<NE-1; i++ )
+ {
+ if( f[i] != y[i] )
+ {
+ esub( eone, y, y );
+ break;
+ }
+ }
+ }
+}
+
+
+/* unsigned short x[], s[];
+ * long *exp;
+ *
+ * efrexp( x, exp, s );
+ *
+ * Returns s and exp such that s * 2**exp = x and .5 <= s < 1.
+ * For example, 1.1 = 0.55 * 2**1
+ * Handles denormalized numbers properly using long integer exp.
+ */
+void efrexp( x, exp, s )
+unsigned short x[];
+long *exp;
+unsigned short s[];
+{
+unsigned short xi[NI];
+long li;
+
+emovi( x, xi );
+li = (long )((short )xi[1]);
+
+if( li == 0 )
+ {
+ li -= enormlz( xi );
+ }
+xi[1] = 0x3ffe;
+emovo( xi, s );
+*exp = li - 0x3ffe;
+}
+
+
+
+/* unsigned short x[], y[];
+ * long pwr2;
+ *
+ * eldexp( x, pwr2, y );
+ *
+ * Returns y = x * 2**pwr2.
+ */
+void eldexp( x, pwr2, y )
+unsigned short x[];
+long pwr2;
+unsigned short y[];
+{
+unsigned short xi[NI];
+long li;
+int i;
+
+emovi( x, xi );
+li = xi[1];
+li += pwr2;
+i = 0;
+emdnorm( xi, i, i, li, 64 );
+emovo( xi, y );
+}
+
+
+/* c = remainder after dividing b by a
+ * Least significant integer quotient bits left in equot[].
+ */
+void eremain( a, b, c )
+unsigned short a[], b[], c[];
+{
+unsigned short den[NI], num[NI];
+
+#ifdef NANS
+if( eisinf(b) || (ecmp(a,ezero) == 0) || eisnan(a) || eisnan(b))
+ {
+ enan( c, NBITS );
+ return;
+ }
+#endif
+if( ecmp(a,ezero) == 0 )
+ {
+ mtherr( "eremain", SING );
+ eclear( c );
+ return;
+ }
+emovi( a, den );
+emovi( b, num );
+eiremain( den, num );
+/* Sign of remainder = sign of quotient */
+if( a[0] == b[0] )
+ num[0] = 0;
+else
+ num[0] = 0xffff;
+emovo( num, c );
+}
+
+
+void eiremain( den, num )
+unsigned short den[], num[];
+{
+long ld, ln;
+unsigned short j;
+
+ld = den[E];
+ld -= enormlz( den );
+ln = num[E];
+ln -= enormlz( num );
+ecleaz( equot );
+while( ln >= ld )
+ {
+ if( ecmpm(den,num) <= 0 )
+ {
+ esubm(den, num);
+ j = 1;
+ }
+ else
+ {
+ j = 0;
+ }
+ eshup1(equot);
+ equot[NI-1] |= j;
+ eshup1(num);
+ ln -= 1;
+ }
+emdnorm( num, 0, 0, ln, 0 );
+}
+
+/* NaN bit patterns
+ */
+#ifdef MIEEE
+unsigned short nan113[8] = {
+ 0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
+unsigned short nan64[6] = {0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
+unsigned short nan53[4] = {0x7fff, 0xffff, 0xffff, 0xffff};
+unsigned short nan24[2] = {0x7fff, 0xffff};
+#endif
+
+#ifdef IBMPC
+unsigned short nan113[8] = {0, 0, 0, 0, 0, 0, 0xc000, 0xffff};
+unsigned short nan64[6] = {0, 0, 0, 0xc000, 0xffff, 0};
+unsigned short nan53[4] = {0, 0, 0, 0xfff8};
+unsigned short nan24[2] = {0, 0xffc0};
+#endif
+
+
+void enan (nan, size)
+unsigned short *nan;
+int size;
+{
+int i, n;
+unsigned short *p;
+
+switch( size )
+ {
+#ifndef DEC
+ case 113:
+ n = 8;
+ p = nan113;
+ break;
+
+ case 64:
+ n = 6;
+ p = nan64;
+ break;
+
+ case 53:
+ n = 4;
+ p = nan53;
+ break;
+
+ case 24:
+ n = 2;
+ p = nan24;
+ break;
+
+ case NBITS:
+ for( i=0; i<NE-2; i++ )
+ *nan++ = 0;
+ *nan++ = 0xc000;
+ *nan++ = 0x7fff;
+ return;
+
+ case NI*16:
+ *nan++ = 0;
+ *nan++ = 0x7fff;
+ *nan++ = 0;
+ *nan++ = 0xc000;
+ for( i=4; i<NI; i++ )
+ *nan++ = 0;
+ return;
+#endif
+ default:
+ mtherr( "enan", DOMAIN );
+ return;
+ }
+for (i=0; i < n; i++)
+ *nan++ = *p++;
+}
+
+
+
+/* Longhand square root. */
+
+static int esqinited = 0;
+static unsigned short sqrndbit[NI];
+
+void esqrt( x, y )
+unsigned short *x, *y;
+{
+unsigned short temp[NI], num[NI], sq[NI], xx[NI];
+int i, j, k, n, nlups;
+long m, exp;
+
+if( esqinited == 0 )
+ {
+ ecleaz( sqrndbit );
+ sqrndbit[NI-2] = 1;
+ esqinited = 1;
+ }
+/* Check for arg <= 0 */
+i = ecmp( x, ezero );
+if( i <= 0 )
+ {
+#ifdef NANS
+ if (i == -2)
+ {
+ enan (y, NBITS);
+ return;
+ }
+#endif
+ eclear(y);
+ if( i < 0 )
+ mtherr( "esqrt", DOMAIN );
+ return;
+ }
+
+#ifdef INFINITY
+if( eisinf(x) )
+ {
+ eclear(y);
+ einfin(y);
+ return;
+ }
+#endif
+/* Bring in the arg and renormalize if it is denormal. */
+emovi( x, xx );
+m = (long )xx[1]; /* local long word exponent */
+if( m == 0 )
+ m -= enormlz( xx );
+
+/* Divide exponent by 2 */
+m -= 0x3ffe;
+exp = (unsigned short )( (m / 2) + 0x3ffe );
+
+/* Adjust if exponent odd */
+if( (m & 1) != 0 )
+ {
+ if( m > 0 )
+ exp += 1;
+ eshdn1( xx );
+ }
+
+ecleaz( sq );
+ecleaz( num );
+n = 8; /* get 8 bits of result per inner loop */
+nlups = rndprc;
+j = 0;
+
+while( nlups > 0 )
+ {
+/* bring in next word of arg */
+ if( j < NE )
+ num[NI-1] = xx[j+3];
+/* Do additional bit on last outer loop, for roundoff. */
+ if( nlups <= 8 )
+ n = nlups + 1;
+ for( i=0; i<n; i++ )
+ {
+/* Next 2 bits of arg */
+ eshup1( num );
+ eshup1( num );
+/* Shift up answer */
+ eshup1( sq );
+/* Make trial divisor */
+ for( k=0; k<NI; k++ )
+ temp[k] = sq[k];
+ eshup1( temp );
+ eaddm( sqrndbit, temp );
+/* Subtract and insert answer bit if it goes in */
+ if( ecmpm( temp, num ) <= 0 )
+ {
+ esubm( temp, num );
+ sq[NI-2] |= 1;
+ }
+ }
+ nlups -= n;
+ j += 1;
+ }
+
+/* Adjust for extra, roundoff loop done. */
+exp += (NBITS - 1) - rndprc;
+
+/* Sticky bit = 1 if the remainder is nonzero. */
+k = 0;
+for( i=3; i<NI; i++ )
+ k |= (int )num[i];
+
+/* Renormalize and round off. */
+emdnorm( sq, k, 0, exp, 64 );
+emovo( sq, y );
+}
diff --git a/libm/ldouble/igamil.c b/libm/ldouble/igamil.c
new file mode 100644
index 000000000..1abe503e9
--- /dev/null
+++ b/libm/ldouble/igamil.c
@@ -0,0 +1,193 @@
+/* igamil()
+ *
+ * Inverse of complemented imcomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igamil();
+ *
+ * x = igamil( a, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * igamc( a, x ) = y.
+ *
+ * Starting with the approximate value
+ *
+ * 3
+ * x = a t
+ *
+ * where
+ *
+ * t = 1 - d - ndtri(y) sqrt(d)
+ *
+ * and
+ *
+ * d = 1/9a,
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of igamc(a,x) - y = 0.
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested for a ranging from 0.5 to 30 and x from 0 to 0.5.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,0.5 3400 8.8e-16 1.3e-16
+ * IEEE 0,0.5 10000 1.1e-14 1.0e-15
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern long double MACHEPL, MAXNUML, MAXLOGL, MINLOGL;
+#ifdef ANSIPROT
+extern long double ndtril ( long double );
+extern long double expl ( long double );
+extern long double fabsl ( long double );
+extern long double logl ( long double );
+extern long double sqrtl ( long double );
+extern long double lgaml ( long double );
+extern long double igamcl ( long double, long double );
+#else
+long double ndtril(), expl(), fabsl(), logl(), sqrtl(), lgaml();
+long double igamcl();
+#endif
+
+long double igamil( a, y0 )
+long double a, y0;
+{
+long double x0, x1, x, yl, yh, y, d, lgm, dithresh;
+int i, dir;
+
+/* bound the solution */
+x0 = MAXNUML;
+yl = 0.0L;
+x1 = 0.0L;
+yh = 1.0L;
+dithresh = 4.0 * MACHEPL;
+
+/* approximation to inverse function */
+d = 1.0L/(9.0L*a);
+y = ( 1.0L - d - ndtril(y0) * sqrtl(d) );
+x = a * y * y * y;
+
+lgm = lgaml(a);
+
+for( i=0; i<10; i++ )
+ {
+ if( x > x0 || x < x1 )
+ goto ihalve;
+ y = igamcl(a,x);
+ if( y < yl || y > yh )
+ goto ihalve;
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ }
+ else
+ {
+ x1 = x;
+ yh = y;
+ }
+/* compute the derivative of the function at this point */
+ d = (a - 1.0L) * logl(x0) - x0 - lgm;
+ if( d < -MAXLOGL )
+ goto ihalve;
+ d = -expl(d);
+/* compute the step to the next approximation of x */
+ d = (y - y0)/d;
+ x = x - d;
+ if( i < 3 )
+ continue;
+ if( fabsl(d/x) < dithresh )
+ goto done;
+ }
+
+/* Resort to interval halving if Newton iteration did not converge. */
+ihalve:
+
+d = 0.0625L;
+if( x0 == MAXNUML )
+ {
+ if( x <= 0.0L )
+ x = 1.0L;
+ while( x0 == MAXNUML )
+ {
+ x = (1.0L + d) * x;
+ y = igamcl( a, x );
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ break;
+ }
+ d = d + d;
+ }
+ }
+d = 0.5L;
+dir = 0;
+
+for( i=0; i<400; i++ )
+ {
+ x = x1 + d * (x0 - x1);
+ y = igamcl( a, x );
+ lgm = (x0 - x1)/(x1 + x0);
+ if( fabsl(lgm) < dithresh )
+ break;
+ lgm = (y - y0)/y0;
+ if( fabsl(lgm) < dithresh )
+ break;
+ if( x <= 0.0L )
+ break;
+ if( y > y0 )
+ {
+ x1 = x;
+ yh = y;
+ if( dir < 0 )
+ {
+ dir = 0;
+ d = 0.5L;
+ }
+ else if( dir > 1 )
+ d = 0.5L * d + 0.5L;
+ else
+ d = (y0 - yl)/(yh - yl);
+ dir += 1;
+ }
+ else
+ {
+ x0 = x;
+ yl = y;
+ if( dir > 0 )
+ {
+ dir = 0;
+ d = 0.5L;
+ }
+ else if( dir < -1 )
+ d = 0.5L * d;
+ else
+ d = (y0 - yl)/(yh - yl);
+ dir -= 1;
+ }
+ }
+if( x == 0.0L )
+ mtherr( "igamil", UNDERFLOW );
+
+done:
+return( x );
+}
diff --git a/libm/ldouble/igaml.c b/libm/ldouble/igaml.c
new file mode 100644
index 000000000..0e59c5404
--- /dev/null
+++ b/libm/ldouble/igaml.c
@@ -0,0 +1,220 @@
+/* igaml.c
+ *
+ * Incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igaml();
+ *
+ * y = igaml( a, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The function is defined by
+ *
+ * x
+ * -
+ * 1 | | -t a-1
+ * igam(a,x) = ----- | e t dt.
+ * - | |
+ * | (a) -
+ * 0
+ *
+ *
+ * In this implementation both arguments must be positive.
+ * The integral is evaluated by either a power series or
+ * continued fraction expansion, depending on the relative
+ * values of a and x.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 4000 4.4e-15 6.3e-16
+ * IEEE 0,30 10000 3.6e-14 5.1e-15
+ *
+ */
+ /* igamcl()
+ *
+ * Complemented incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, x, y, igamcl();
+ *
+ * y = igamcl( a, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The function is defined by
+ *
+ *
+ * igamc(a,x) = 1 - igam(a,x)
+ *
+ * inf.
+ * -
+ * 1 | | -t a-1
+ * = ----- | e t dt.
+ * - | |
+ * | (a) -
+ * x
+ *
+ *
+ * In this implementation both arguments must be positive.
+ * The integral is evaluated by either a power series or
+ * continued fraction expansion, depending on the relative
+ * values of a and x.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2000 2.7e-15 4.0e-16
+ * IEEE 0,30 60000 1.4e-12 6.3e-15
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1985, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double lgaml ( long double );
+extern long double expl ( long double );
+extern long double logl ( long double );
+extern long double fabsl ( long double );
+extern long double gammal ( long double );
+long double igaml ( long double, long double );
+long double igamcl ( long double, long double );
+#else
+long double lgaml(), expl(), logl(), fabsl(), igaml(), gammal();
+long double igamcl();
+#endif
+
+#define BIG 9.223372036854775808e18L
+#define MAXGAML 1755.455L
+extern long double MACHEPL, MINLOGL;
+
+long double igamcl( a, x )
+long double a, x;
+{
+long double ans, c, yc, ax, y, z, r, t;
+long double pk, pkm1, pkm2, qk, qkm1, qkm2;
+
+if( (x <= 0.0L) || ( a <= 0.0L) )
+ return( 1.0L );
+
+if( (x < 1.0L) || (x < a) )
+ return( 1.0L - igaml(a,x) );
+
+ax = a * logl(x) - x - lgaml(a);
+if( ax < MINLOGL )
+ {
+ mtherr( "igamcl", UNDERFLOW );
+ return( 0.0L );
+ }
+ax = expl(ax);
+
+/* continued fraction */
+y = 1.0L - a;
+z = x + y + 1.0L;
+c = 0.0L;
+pkm2 = 1.0L;
+qkm2 = x;
+pkm1 = x + 1.0L;
+qkm1 = z * x;
+ans = pkm1/qkm1;
+
+do
+ {
+ c += 1.0L;
+ y += 1.0L;
+ z += 2.0L;
+ yc = y * c;
+ pk = pkm1 * z - pkm2 * yc;
+ qk = qkm1 * z - qkm2 * yc;
+ if( qk != 0.0L )
+ {
+ r = pk/qk;
+ t = fabsl( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0L;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+ if( fabsl(pk) > BIG )
+ {
+ pkm2 /= BIG;
+ pkm1 /= BIG;
+ qkm2 /= BIG;
+ qkm1 /= BIG;
+ }
+ }
+while( t > MACHEPL );
+
+return( ans * ax );
+}
+
+
+
+/* left tail of incomplete gamma function:
+ *
+ * inf. k
+ * a -x - x
+ * x e > ----------
+ * - -
+ * k=0 | (a+k+1)
+ *
+ */
+
+long double igaml( a, x )
+long double a, x;
+{
+long double ans, ax, c, r;
+
+if( (x <= 0.0L) || ( a <= 0.0L) )
+ return( 0.0L );
+
+if( (x > 1.0L) && (x > a ) )
+ return( 1.0L - igamcl(a,x) );
+
+ax = a * logl(x) - x - lgaml(a);
+if( ax < MINLOGL )
+ {
+ mtherr( "igaml", UNDERFLOW );
+ return( 0.0L );
+ }
+ax = expl(ax);
+
+/* power series */
+r = a;
+c = 1.0L;
+ans = 1.0L;
+
+do
+ {
+ r += 1.0L;
+ c *= x/r;
+ ans += c;
+ }
+while( c/ans > MACHEPL );
+
+return( ans * ax/a );
+}
diff --git a/libm/ldouble/incbetl.c b/libm/ldouble/incbetl.c
new file mode 100644
index 000000000..fc85ead4c
--- /dev/null
+++ b/libm/ldouble/incbetl.c
@@ -0,0 +1,406 @@
+/* incbetl.c
+ *
+ * Incomplete beta integral
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, incbetl();
+ *
+ * y = incbetl( a, b, x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns incomplete beta integral of the arguments, evaluated
+ * from zero to x. The function is defined as
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * ----------- | t (1-t) dt.
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ * The domain of definition is 0 <= x <= 1. In this
+ * implementation a and b are restricted to positive values.
+ * The integral from x to 1 may be obtained by the symmetry
+ * relation
+ *
+ * 1 - incbet( a, b, x ) = incbet( b, a, 1-x ).
+ *
+ * The integral is evaluated by a continued fraction expansion
+ * or, when b*x is small, by a power series.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) with x between 0 and 1.
+ * arithmetic domain # trials peak rms
+ * IEEE 0,5 20000 4.5e-18 2.4e-19
+ * IEEE 0,100 100000 3.9e-17 1.0e-17
+ * Half-integer a, b:
+ * IEEE .5,10000 100000 3.9e-14 4.4e-15
+ * Outputs smaller than the IEEE gradual underflow threshold
+ * were excluded from these statistics.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * incbetl domain x<0, x>1 0.0
+ */
+
+
+/*
+Cephes Math Library, Release 2.3: January, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#define MAXGAML 1755.455L
+static long double big = 9.223372036854775808e18L;
+static long double biginv = 1.084202172485504434007e-19L;
+extern long double MACHEPL, MINLOGL, MAXLOGL;
+
+#ifdef ANSIPROT
+extern long double gammal ( long double );
+extern long double lgaml ( long double );
+extern long double expl ( long double );
+extern long double logl ( long double );
+extern long double fabsl ( long double );
+extern long double powl ( long double, long double );
+static long double incbcfl( long double, long double, long double );
+static long double incbdl( long double, long double, long double );
+static long double pseriesl( long double, long double, long double );
+#else
+long double gammal(), lgaml(), expl(), logl(), fabsl(), powl();
+static long double incbcfl(), incbdl(), pseriesl();
+#endif
+
+long double incbetl( aa, bb, xx )
+long double aa, bb, xx;
+{
+long double a, b, t, x, w, xc, y;
+int flag;
+
+if( aa <= 0.0L || bb <= 0.0L )
+ goto domerr;
+
+if( (xx <= 0.0L) || ( xx >= 1.0L) )
+ {
+ if( xx == 0.0L )
+ return( 0.0L );
+ if( xx == 1.0L )
+ return( 1.0L );
+domerr:
+ mtherr( "incbetl", DOMAIN );
+ return( 0.0L );
+ }
+
+flag = 0;
+if( (bb * xx) <= 1.0L && xx <= 0.95L)
+ {
+ t = pseriesl(aa, bb, xx);
+ goto done;
+ }
+
+w = 1.0L - xx;
+
+/* Reverse a and b if x is greater than the mean. */
+if( xx > (aa/(aa+bb)) )
+ {
+ flag = 1;
+ a = bb;
+ b = aa;
+ xc = xx;
+ x = w;
+ }
+else
+ {
+ a = aa;
+ b = bb;
+ xc = w;
+ x = xx;
+ }
+
+if( flag == 1 && (b * x) <= 1.0L && x <= 0.95L)
+ {
+ t = pseriesl(a, b, x);
+ goto done;
+ }
+
+/* Choose expansion for optimal convergence */
+y = x * (a+b-2.0L) - (a-1.0L);
+if( y < 0.0L )
+ w = incbcfl( a, b, x );
+else
+ w = incbdl( a, b, x ) / xc;
+
+/* Multiply w by the factor
+ a b _ _ _
+ x (1-x) | (a+b) / ( a | (a) | (b) ) . */
+
+y = a * logl(x);
+t = b * logl(xc);
+if( (a+b) < MAXGAML && fabsl(y) < MAXLOGL && fabsl(t) < MAXLOGL )
+ {
+ t = powl(xc,b);
+ t *= powl(x,a);
+ t /= a;
+ t *= w;
+ t *= gammal(a+b) / (gammal(a) * gammal(b));
+ goto done;
+ }
+else
+ {
+ /* Resort to logarithms. */
+ y += t + lgaml(a+b) - lgaml(a) - lgaml(b);
+ y += logl(w/a);
+ if( y < MINLOGL )
+ t = 0.0L;
+ else
+ t = expl(y);
+ }
+
+done:
+
+if( flag == 1 )
+ {
+ if( t <= MACHEPL )
+ t = 1.0L - MACHEPL;
+ else
+ t = 1.0L - t;
+ }
+return( t );
+}
+
+/* Continued fraction expansion #1
+ * for incomplete beta integral
+ */
+
+static long double incbcfl( a, b, x )
+long double a, b, x;
+{
+long double xk, pk, pkm1, pkm2, qk, qkm1, qkm2;
+long double k1, k2, k3, k4, k5, k6, k7, k8;
+long double r, t, ans, thresh;
+int n;
+
+k1 = a;
+k2 = a + b;
+k3 = a;
+k4 = a + 1.0L;
+k5 = 1.0L;
+k6 = b - 1.0L;
+k7 = k4;
+k8 = a + 2.0L;
+
+pkm2 = 0.0L;
+qkm2 = 1.0L;
+pkm1 = 1.0L;
+qkm1 = 1.0L;
+ans = 1.0L;
+r = 1.0L;
+n = 0;
+thresh = 3.0L * MACHEPL;
+do
+ {
+
+ xk = -( x * k1 * k2 )/( k3 * k4 );
+ pk = pkm1 + pkm2 * xk;
+ qk = qkm1 + qkm2 * xk;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+
+ xk = ( x * k5 * k6 )/( k7 * k8 );
+ pk = pkm1 + pkm2 * xk;
+ qk = qkm1 + qkm2 * xk;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+
+ if( qk != 0.0L )
+ r = pk/qk;
+ if( r != 0.0L )
+ {
+ t = fabsl( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0L;
+
+ if( t < thresh )
+ goto cdone;
+
+ k1 += 1.0L;
+ k2 += 1.0L;
+ k3 += 2.0L;
+ k4 += 2.0L;
+ k5 += 1.0L;
+ k6 -= 1.0L;
+ k7 += 2.0L;
+ k8 += 2.0L;
+
+ if( (fabsl(qk) + fabsl(pk)) > big )
+ {
+ pkm2 *= biginv;
+ pkm1 *= biginv;
+ qkm2 *= biginv;
+ qkm1 *= biginv;
+ }
+ if( (fabsl(qk) < biginv) || (fabsl(pk) < biginv) )
+ {
+ pkm2 *= big;
+ pkm1 *= big;
+ qkm2 *= big;
+ qkm1 *= big;
+ }
+ }
+while( ++n < 400 );
+mtherr( "incbetl", PLOSS );
+
+cdone:
+return(ans);
+}
+
+
+/* Continued fraction expansion #2
+ * for incomplete beta integral
+ */
+
+static long double incbdl( a, b, x )
+long double a, b, x;
+{
+long double xk, pk, pkm1, pkm2, qk, qkm1, qkm2;
+long double k1, k2, k3, k4, k5, k6, k7, k8;
+long double r, t, ans, z, thresh;
+int n;
+
+k1 = a;
+k2 = b - 1.0L;
+k3 = a;
+k4 = a + 1.0L;
+k5 = 1.0L;
+k6 = a + b;
+k7 = a + 1.0L;
+k8 = a + 2.0L;
+
+pkm2 = 0.0L;
+qkm2 = 1.0L;
+pkm1 = 1.0L;
+qkm1 = 1.0L;
+z = x / (1.0L-x);
+ans = 1.0L;
+r = 1.0L;
+n = 0;
+thresh = 3.0L * MACHEPL;
+do
+ {
+
+ xk = -( z * k1 * k2 )/( k3 * k4 );
+ pk = pkm1 + pkm2 * xk;
+ qk = qkm1 + qkm2 * xk;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+
+ xk = ( z * k5 * k6 )/( k7 * k8 );
+ pk = pkm1 + pkm2 * xk;
+ qk = qkm1 + qkm2 * xk;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+
+ if( qk != 0.0L )
+ r = pk/qk;
+ if( r != 0.0L )
+ {
+ t = fabsl( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0L;
+
+ if( t < thresh )
+ goto cdone;
+
+ k1 += 1.0L;
+ k2 -= 1.0L;
+ k3 += 2.0L;
+ k4 += 2.0L;
+ k5 += 1.0L;
+ k6 += 1.0L;
+ k7 += 2.0L;
+ k8 += 2.0L;
+
+ if( (fabsl(qk) + fabsl(pk)) > big )
+ {
+ pkm2 *= biginv;
+ pkm1 *= biginv;
+ qkm2 *= biginv;
+ qkm1 *= biginv;
+ }
+ if( (fabsl(qk) < biginv) || (fabsl(pk) < biginv) )
+ {
+ pkm2 *= big;
+ pkm1 *= big;
+ qkm2 *= big;
+ qkm1 *= big;
+ }
+ }
+while( ++n < 400 );
+mtherr( "incbetl", PLOSS );
+
+cdone:
+return(ans);
+}
+
+/* Power series for incomplete gamma integral.
+ Use when b*x is small. */
+
+static long double pseriesl( a, b, x )
+long double a, b, x;
+{
+long double s, t, u, v, n, t1, z, ai;
+
+ai = 1.0L / a;
+u = (1.0L - b) * x;
+v = u / (a + 1.0L);
+t1 = v;
+t = u;
+n = 2.0L;
+s = 0.0L;
+z = MACHEPL * ai;
+while( fabsl(v) > z )
+ {
+ u = (n - b) * x / n;
+ t *= u;
+ v = t / (a + n);
+ s += v;
+ n += 1.0L;
+ }
+s += t1;
+s += ai;
+
+u = a * logl(x);
+if( (a+b) < MAXGAML && fabsl(u) < MAXLOGL )
+ {
+ t = gammal(a+b)/(gammal(a)*gammal(b));
+ s = s * t * powl(x,a);
+ }
+else
+ {
+ t = lgaml(a+b) - lgaml(a) - lgaml(b) + u + logl(s);
+ if( t < MINLOGL )
+ s = 0.0L;
+ else
+ s = expl(t);
+ }
+return(s);
+}
diff --git a/libm/ldouble/incbil.c b/libm/ldouble/incbil.c
new file mode 100644
index 000000000..b7610706b
--- /dev/null
+++ b/libm/ldouble/incbil.c
@@ -0,0 +1,305 @@
+/* incbil()
+ *
+ * Inverse of imcomplete beta integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double a, b, x, y, incbil();
+ *
+ * x = incbil( a, b, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * incbet( a, b, x ) = y.
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of incbet(a,b,x) - y = 0.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * x a,b
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 .5,10000 10000 1.1e-14 1.4e-16
+ */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern long double MACHEPL, MAXNUML, MAXLOGL, MINLOGL;
+#ifdef ANSIPROT
+extern long double incbetl ( long double, long double, long double );
+extern long double expl ( long double );
+extern long double fabsl ( long double );
+extern long double logl ( long double );
+extern long double sqrtl ( long double );
+extern long double lgaml ( long double );
+extern long double ndtril ( long double );
+#else
+long double incbetl(), expl(), fabsl(), logl(), sqrtl(), lgaml();
+long double ndtril();
+#endif
+
+long double incbil( aa, bb, yy0 )
+long double aa, bb, yy0;
+{
+long double a, b, y0, d, y, x, x0, x1, lgm, yp, di, dithresh, yl, yh, xt;
+int i, rflg, dir, nflg;
+
+
+if( yy0 <= 0.0L )
+ return(0.0L);
+if( yy0 >= 1.0L )
+ return(1.0L);
+x0 = 0.0L;
+yl = 0.0L;
+x1 = 1.0L;
+yh = 1.0L;
+if( aa <= 1.0L || bb <= 1.0L )
+ {
+ dithresh = 1.0e-7L;
+ rflg = 0;
+ a = aa;
+ b = bb;
+ y0 = yy0;
+ x = a/(a+b);
+ y = incbetl( a, b, x );
+ nflg = 0;
+ goto ihalve;
+ }
+else
+ {
+ nflg = 0;
+ dithresh = 1.0e-4L;
+ }
+
+/* approximation to inverse function */
+
+yp = -ndtril( yy0 );
+
+if( yy0 > 0.5L )
+ {
+ rflg = 1;
+ a = bb;
+ b = aa;
+ y0 = 1.0L - yy0;
+ yp = -yp;
+ }
+else
+ {
+ rflg = 0;
+ a = aa;
+ b = bb;
+ y0 = yy0;
+ }
+
+lgm = (yp * yp - 3.0L)/6.0L;
+x = 2.0L/( 1.0L/(2.0L * a-1.0L) + 1.0L/(2.0L * b - 1.0L) );
+d = yp * sqrtl( x + lgm ) / x
+ - ( 1.0L/(2.0L * b - 1.0L) - 1.0L/(2.0L * a - 1.0L) )
+ * (lgm + (5.0L/6.0L) - 2.0L/(3.0L * x));
+d = 2.0L * d;
+if( d < MINLOGL )
+ {
+ x = 1.0L;
+ goto under;
+ }
+x = a/( a + b * expl(d) );
+y = incbetl( a, b, x );
+yp = (y - y0)/y0;
+if( fabsl(yp) < 0.2 )
+ goto newt;
+
+/* Resort to interval halving if not close enough. */
+ihalve:
+
+dir = 0;
+di = 0.5L;
+for( i=0; i<400; i++ )
+ {
+ if( i != 0 )
+ {
+ x = x0 + di * (x1 - x0);
+ if( x == 1.0L )
+ x = 1.0L - MACHEPL;
+ if( x == 0.0L )
+ {
+ di = 0.5;
+ x = x0 + di * (x1 - x0);
+ if( x == 0.0 )
+ goto under;
+ }
+ y = incbetl( a, b, x );
+ yp = (x1 - x0)/(x1 + x0);
+ if( fabsl(yp) < dithresh )
+ goto newt;
+ yp = (y-y0)/y0;
+ if( fabsl(yp) < dithresh )
+ goto newt;
+ }
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ if( dir < 0 )
+ {
+ dir = 0;
+ di = 0.5L;
+ }
+ else if( dir > 3 )
+ di = 1.0L - (1.0L - di) * (1.0L - di);
+ else if( dir > 1 )
+ di = 0.5L * di + 0.5L;
+ else
+ di = (y0 - y)/(yh - yl);
+ dir += 1;
+ if( x0 > 0.95L )
+ {
+ if( rflg == 1 )
+ {
+ rflg = 0;
+ a = aa;
+ b = bb;
+ y0 = yy0;
+ }
+ else
+ {
+ rflg = 1;
+ a = bb;
+ b = aa;
+ y0 = 1.0 - yy0;
+ }
+ x = 1.0L - x;
+ y = incbetl( a, b, x );
+ x0 = 0.0;
+ yl = 0.0;
+ x1 = 1.0;
+ yh = 1.0;
+ goto ihalve;
+ }
+ }
+ else
+ {
+ x1 = x;
+ if( rflg == 1 && x1 < MACHEPL )
+ {
+ x = 0.0L;
+ goto done;
+ }
+ yh = y;
+ if( dir > 0 )
+ {
+ dir = 0;
+ di = 0.5L;
+ }
+ else if( dir < -3 )
+ di = di * di;
+ else if( dir < -1 )
+ di = 0.5L * di;
+ else
+ di = (y - y0)/(yh - yl);
+ dir -= 1;
+ }
+ }
+mtherr( "incbil", PLOSS );
+if( x0 >= 1.0L )
+ {
+ x = 1.0L - MACHEPL;
+ goto done;
+ }
+if( x <= 0.0L )
+ {
+under:
+ mtherr( "incbil", UNDERFLOW );
+ x = 0.0L;
+ goto done;
+ }
+
+newt:
+
+if( nflg )
+ goto done;
+nflg = 1;
+lgm = lgaml(a+b) - lgaml(a) - lgaml(b);
+
+for( i=0; i<15; i++ )
+ {
+ /* Compute the function at this point. */
+ if( i != 0 )
+ y = incbetl(a,b,x);
+ if( y < yl )
+ {
+ x = x0;
+ y = yl;
+ }
+ else if( y > yh )
+ {
+ x = x1;
+ y = yh;
+ }
+ else if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ }
+ else
+ {
+ x1 = x;
+ yh = y;
+ }
+ if( x == 1.0L || x == 0.0L )
+ break;
+ /* Compute the derivative of the function at this point. */
+ d = (a - 1.0L) * logl(x) + (b - 1.0L) * logl(1.0L - x) + lgm;
+ if( d < MINLOGL )
+ goto done;
+ if( d > MAXLOGL )
+ break;
+ d = expl(d);
+ /* Compute the step to the next approximation of x. */
+ d = (y - y0)/d;
+ xt = x - d;
+ if( xt <= x0 )
+ {
+ y = (x - x0) / (x1 - x0);
+ xt = x0 + 0.5L * y * (x - x0);
+ if( xt <= 0.0L )
+ break;
+ }
+ if( xt >= x1 )
+ {
+ y = (x1 - x) / (x1 - x0);
+ xt = x1 - 0.5L * y * (x1 - x);
+ if( xt >= 1.0L )
+ break;
+ }
+ x = xt;
+ if( fabsl(d/x) < (128.0L * MACHEPL) )
+ goto done;
+ }
+/* Did not converge. */
+dithresh = 256.0L * MACHEPL;
+goto ihalve;
+
+done:
+if( rflg )
+ {
+ if( x <= MACHEPL )
+ x = 1.0L - MACHEPL;
+ else
+ x = 1.0L - x;
+ }
+return( x );
+}
diff --git a/libm/ldouble/isnanl.c b/libm/ldouble/isnanl.c
new file mode 100644
index 000000000..44158ecc7
--- /dev/null
+++ b/libm/ldouble/isnanl.c
@@ -0,0 +1,186 @@
+/* isnanl()
+ * isfinitel()
+ * signbitl()
+ *
+ * Floating point IEEE special number tests
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int signbitl(), isnanl(), isfinitel();
+ * long double x, y;
+ *
+ * n = signbitl(x);
+ * n = isnanl(x);
+ * n = isfinitel(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * These functions are part of the standard C run time library
+ * for some but not all C compilers. The ones supplied are
+ * written in C for IEEE arithmetic. They should
+ * be used only if your compiler library does not already have
+ * them.
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.7: June, 1998
+Copyright 1992, 1998 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+/* This is defined in mconf.h. */
+/* #define DENORMAL 1 */
+
+#ifdef UNK
+/* Change UNK into something else. */
+#undef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+
+/* Return 1 if the sign bit of x is 1, else 0. */
+
+int signbitl(x)
+long double x;
+{
+union
+ {
+ long double d;
+ short s[6];
+ int i[3];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ return( u.s[4] < 0 );
+#endif
+#ifdef MIEEE
+ return( u.i[0] < 0 );
+#endif
+ }
+else
+ {
+#ifdef IBMPC
+ return( u.s[4] < 0 );
+#endif
+#ifdef MIEEE
+ return( u.s[0] < 0 );
+#endif
+ }
+}
+
+
+/* Return 1 if x is a number that is Not a Number, else return 0. */
+
+int isnanl(x)
+long double x;
+{
+#ifdef NANS
+union
+ {
+ long double d;
+ unsigned short s[6];
+ unsigned int i[3];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ if( ((u.s[4] & 0x7fff) == 0x7fff)
+ && (((u.i[1] & 0x7fffffff)!= 0) || (u.i[0] != 0)))
+ return 1;
+#endif
+#ifdef MIEEE
+ if( ((u.i[0] & 0x7fff0000) == 0x7fff0000)
+ && (((u.i[1] & 0x7fffffff) != 0) || (u.i[2] != 0)))
+ return 1;
+#endif
+ return(0);
+ }
+else
+ { /* size int not 4 */
+#ifdef IBMPC
+ if( (u.s[4] & 0x7fff) == 0x7fff)
+ {
+ if((u.s[3] & 0x7fff) | u.s[2] | u.s[1] | u.s[0])
+ return(1);
+ }
+#endif
+#ifdef MIEEE
+ if( (u.s[0] & 0x7fff) == 0x7fff)
+ {
+ if((u.s[2] & 0x7fff) | u.s[3] | u.s[4] | u.s[5])
+ return(1);
+ }
+#endif
+ return(0);
+ } /* size int not 4 */
+
+#else
+/* No NANS. */
+return(0);
+#endif
+}
+
+
+/* Return 1 if x is not infinite and is not a NaN. */
+
+int isfinitel(x)
+long double x;
+{
+#ifdef INFINITIES
+union
+ {
+ long double d;
+ unsigned short s[6];
+ unsigned int i[3];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ if( (u.s[4] & 0x7fff) != 0x7fff)
+ return 1;
+#endif
+#ifdef MIEEE
+ if( (u.i[0] & 0x7fff0000) != 0x7fff0000)
+ return 1;
+#endif
+ return(0);
+ }
+else
+ {
+#ifdef IBMPC
+ if( (u.s[4] & 0x7fff) != 0x7fff)
+ return 1;
+#endif
+#ifdef MIEEE
+ if( (u.s[0] & 0x7fff) != 0x7fff)
+ return 1;
+#endif
+ return(0);
+ }
+#else
+/* No INFINITY. */
+return(1);
+#endif
+}
diff --git a/libm/ldouble/j0l.c b/libm/ldouble/j0l.c
new file mode 100644
index 000000000..a30a65a4f
--- /dev/null
+++ b/libm/ldouble/j0l.c
@@ -0,0 +1,541 @@
+/* j0l.c
+ *
+ * Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, j0l();
+ *
+ * y = j0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of first kind, order zero of the argument.
+ *
+ * The domain is divided into the intervals [0, 9] and
+ * (9, infinity). In the first interval the rational approximation
+ * is (x^2 - r^2) (x^2 - s^2) (x^2 - t^2) P7(x^2) / Q8(x^2),
+ * where r, s, t are the first three zeros of the function.
+ * In the second interval the expansion is in terms of the
+ * modulus M0(x) = sqrt(J0(x)^2 + Y0(x)^2) and phase P0(x)
+ * = atan(Y0(x)/J0(x)). M0 is approximated by sqrt(1/x)P7(1/x)/Q7(1/x).
+ * The approximation to J0 is M0 * cos(x - pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)).
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 100000 2.8e-19 7.4e-20
+ *
+ *
+ */
+ /* y0l.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0l();
+ *
+ * y = y0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5>, [5,9> and
+ * [9, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute y0(x) = R(x) + 2/pi * log(x) * j0(x).
+ *
+ * In the second interval, the approximation is
+ * (x - p)(x - q)(x - r)(x - s)P7(x)/Q7(x)
+ * where p, q, r, s are zeros of y0(x).
+ *
+ * The third interval uses the same approximations to modulus
+ * and phase as j0(x), whence y0(x) = modulus * sin(phase).
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 100000 3.4e-19 7.6e-20
+ *
+ */
+
+/* Copyright 1994 by Stephen L. Moshier (moshier@world.std.com). */
+
+#include <math.h>
+
+/*
+j0(x) = (x^2-JZ1)(x^2-JZ2)(x^2-JZ3)P(x**2)/Q(x**2)
+0 <= x <= 9
+Relative error
+n=7, d=8
+Peak error = 8.49e-22
+Relative error spread = 2.2e-3
+*/
+#if UNK
+static long double j0n[8] = {
+ 1.296848754518641770562E0L,
+-3.239201943301299801018E3L,
+ 3.490002040733471400107E6L,
+-2.076797068740966813173E9L,
+ 7.283696461857171054941E11L,
+-1.487926133645291056388E14L,
+ 1.620335009643150402368E16L,
+-7.173386747526788067407E17L,
+};
+static long double j0d[8] = {
+/* 1.000000000000000000000E0L,*/
+ 2.281959869176887763845E3L,
+ 2.910386840401647706984E6L,
+ 2.608400226578100610991E9L,
+ 1.752689035792859338860E12L,
+ 8.879132373286001289461E14L,
+ 3.265560832845194013669E17L,
+ 7.881340554308432241892E19L,
+ 9.466475654163919450528E21L,
+};
+#endif
+#if IBMPC
+static short j0n[] = {
+0xf759,0x4208,0x23d6,0xa5ff,0x3fff, XPD
+0xa9a8,0xe62b,0x3b28,0xca73,0xc00a, XPD
+0xfe10,0xb608,0x4829,0xd503,0x4014, XPD
+0x008c,0x7b60,0xd119,0xf792,0xc01d, XPD
+0x943a,0x69b7,0x36ca,0xa996,0x4026, XPD
+0x1b0b,0x6331,0x7add,0x8753,0xc02e, XPD
+0x4018,0xad26,0x71ba,0xe643,0x4034, XPD
+0xb96c,0xc486,0xfb95,0x9f47,0xc03a, XPD
+};
+static short j0d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xbdfe,0xc832,0x5b9f,0x8e9f,0x400a, XPD
+0xe1a0,0x923f,0xcb5c,0xb1a2,0x4014, XPD
+0x66d2,0x93fe,0x0762,0x9b79,0x401e, XPD
+0xfed1,0x086d,0x3425,0xcc0a,0x4027, XPD
+0x0841,0x8cb6,0x5a46,0xc9e3,0x4030, XPD
+0x3d2c,0xed55,0x20e1,0x9105,0x4039, XPD
+0xfdce,0xa4ca,0x2ed8,0x88b8,0x4041, XPD
+0x00ac,0xfb2b,0x6f62,0x804b,0x4048, XPD
+};
+#endif
+#if MIEEE
+static long j0n[24] = {
+0x3fff0000,0xa5ff23d6,0x4208f759,
+0xc00a0000,0xca733b28,0xe62ba9a8,
+0x40140000,0xd5034829,0xb608fe10,
+0xc01d0000,0xf792d119,0x7b60008c,
+0x40260000,0xa99636ca,0x69b7943a,
+0xc02e0000,0x87537add,0x63311b0b,
+0x40340000,0xe64371ba,0xad264018,
+0xc03a0000,0x9f47fb95,0xc486b96c,
+};
+static long j0d[24] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x400a0000,0x8e9f5b9f,0xc832bdfe,
+0x40140000,0xb1a2cb5c,0x923fe1a0,
+0x401e0000,0x9b790762,0x93fe66d2,
+0x40270000,0xcc0a3425,0x086dfed1,
+0x40300000,0xc9e35a46,0x8cb60841,
+0x40390000,0x910520e1,0xed553d2c,
+0x40410000,0x88b82ed8,0xa4cafdce,
+0x40480000,0x804b6f62,0xfb2b00ac,
+};
+#endif
+/*
+sqrt(j0^2(1/x^2) + y0^2(1/x^2)) = z P(z**2)/Q(z**2)
+z(x) = 1/sqrt(x)
+Relative error
+n=7, d=7
+Peak error = 1.80e-20
+Relative error spread = 5.1e-2
+*/
+#if UNK
+static long double modulusn[8] = {
+ 3.947542376069224461532E-1L,
+ 6.864682945702134624126E0L,
+ 1.021369773577974343844E1L,
+ 7.626141421290849630523E0L,
+ 2.842537511425216145635E0L,
+ 7.162842530423205720962E-1L,
+ 9.036664453160200052296E-2L,
+ 8.461833426898867839659E-3L,
+};
+static long double modulusd[7] = {
+/* 1.000000000000000000000E0L,*/
+ 9.117176038171821115904E0L,
+ 1.301235226061478261481E1L,
+ 9.613002539386213788182E0L,
+ 3.569671060989910901903E0L,
+ 8.983920141407590632423E-1L,
+ 1.132577931332212304986E-1L,
+ 1.060533546154121770442E-2L,
+};
+#endif
+#if IBMPC
+static short modulusn[] = {
+0x8559,0xf552,0x3a38,0xca1d,0x3ffd, XPD
+0x38a3,0xa663,0x7b91,0xdbab,0x4001, XPD
+0xb343,0x2673,0x4e51,0xa36b,0x4002, XPD
+0x5e4b,0xe3af,0x59bb,0xf409,0x4001, XPD
+0xb1cd,0x4e5e,0x2274,0xb5ec,0x4000, XPD
+0xcfe9,0x74e0,0x67a1,0xb75e,0x3ffe, XPD
+0x6b78,0x4cc6,0x25b7,0xb912,0x3ffb, XPD
+0xcb2b,0x4b73,0x8075,0x8aa3,0x3ff8, XPD
+};
+static short modulusd[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x4498,0x3d2a,0xf3fb,0x91df,0x4002, XPD
+0x5e3d,0xb5f4,0x9848,0xd032,0x4002, XPD
+0xb837,0x3075,0xdbc0,0x99ce,0x4002, XPD
+0x775a,0x1b79,0x7d9c,0xe475,0x4000, XPD
+0x7e3f,0xb8dd,0x04df,0xe5fd,0x3ffe, XPD
+0xed5a,0x31cd,0xb3ac,0xe7f3,0x3ffb, XPD
+0x8a83,0x1b80,0x003e,0xadc2,0x3ff8, XPD
+};
+#endif
+#if MIEEE
+static long modulusn[24] = {
+0x3ffd0000,0xca1d3a38,0xf5528559,
+0x40010000,0xdbab7b91,0xa66338a3,
+0x40020000,0xa36b4e51,0x2673b343,
+0x40010000,0xf40959bb,0xe3af5e4b,
+0x40000000,0xb5ec2274,0x4e5eb1cd,
+0x3ffe0000,0xb75e67a1,0x74e0cfe9,
+0x3ffb0000,0xb91225b7,0x4cc66b78,
+0x3ff80000,0x8aa38075,0x4b73cb2b,
+};
+static long modulusd[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40020000,0x91dff3fb,0x3d2a4498,
+0x40020000,0xd0329848,0xb5f45e3d,
+0x40020000,0x99cedbc0,0x3075b837,
+0x40000000,0xe4757d9c,0x1b79775a,
+0x3ffe0000,0xe5fd04df,0xb8dd7e3f,
+0x3ffb0000,0xe7f3b3ac,0x31cded5a,
+0x3ff80000,0xadc2003e,0x1b808a83,
+};
+#endif
+/*
+atan(y0(x)/j0(x)) = x - pi/4 + x P(x**2)/Q(x**2)
+Absolute error
+n=5, d=6
+Peak error = 2.80e-21
+Relative error spread = 5.5e-1
+*/
+#if UNK
+static long double phasen[6] = {
+-7.356766355393571519038E-1L,
+-5.001635199922493694706E-1L,
+-7.737323518141516881715E-2L,
+-3.998893155826990642730E-3L,
+-7.496317036829964150970E-5L,
+-4.290885090773112963542E-7L,
+};
+static long double phased[6] = {
+/* 1.000000000000000000000E0L,*/
+ 7.377856408614376072745E0L,
+ 4.285043297797736118069E0L,
+ 6.348446472935245102890E-1L,
+ 3.229866782185025048457E-2L,
+ 6.014932317342190404134E-4L,
+ 3.432708072618490390095E-6L,
+};
+#endif
+#if IBMPC
+static short phasen[] = {
+0x5106,0x12a6,0x4dd2,0xbc55,0xbffe, XPD
+0x1e30,0x04da,0xb769,0x800a,0xbffe, XPD
+0x8d8a,0x84e7,0xdbd5,0x9e75,0xbffb, XPD
+0xe514,0x8866,0x25a9,0x8309,0xbff7, XPD
+0xdc17,0x325e,0x8baf,0x9d35,0xbff1, XPD
+0x4c2f,0x2dd8,0x79c3,0xe65d,0xbfe9, XPD
+};
+static short phased[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xf3e9,0xb2a5,0x6652,0xec17,0x4001, XPD
+0x4b69,0x3f87,0x131f,0x891f,0x4001, XPD
+0x6f25,0x2a95,0x2dc6,0xa285,0x3ffe, XPD
+0x37bf,0xfcc8,0x9b9f,0x844b,0x3ffa, XPD
+0xac5c,0x4806,0x8709,0x9dad,0x3ff4, XPD
+0x4c8c,0x2dd8,0x79c3,0xe65d,0x3fec, XPD
+};
+#endif
+#if MIEEE
+static long phasen[18] = {
+0xbffe0000,0xbc554dd2,0x12a65106,
+0xbffe0000,0x800ab769,0x04da1e30,
+0xbffb0000,0x9e75dbd5,0x84e78d8a,
+0xbff70000,0x830925a9,0x8866e514,
+0xbff10000,0x9d358baf,0x325edc17,
+0xbfe90000,0xe65d79c3,0x2dd84c2f,
+};
+static long phased[18] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40010000,0xec176652,0xb2a5f3e9,
+0x40010000,0x891f131f,0x3f874b69,
+0x3ffe0000,0xa2852dc6,0x2a956f25,
+0x3ffa0000,0x844b9b9f,0xfcc837bf,
+0x3ff40000,0x9dad8709,0x4806ac5c,
+0x3fec0000,0xe65d79c3,0x2dd84c8c,
+};
+#endif
+#define JZ1 5.783185962946784521176L
+#define JZ2 30.47126234366208639908L
+#define JZ3 7.488700679069518344489e1L
+
+#define PIO4L 0.78539816339744830961566L
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double fabsl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double cosl ( long double );
+extern long double sinl ( long double );
+extern long double logl ( long double );
+long double j0l ( long double );
+#else
+long double sqrtl(), fabsl(), polevll(), p1evll(), cosl(), sinl(), logl();
+long double j0l();
+#endif
+
+long double j0l(x)
+long double x;
+{
+long double xx, y, z, modulus, phase;
+
+xx = x * x;
+if( xx < 81.0L )
+ {
+ y = (xx - JZ1) * (xx - JZ2) * (xx -JZ3);
+ y *= polevll( xx, j0n, 7 ) / p1evll( xx, j0d, 8 );
+ return y;
+ }
+
+y = fabsl(x);
+xx = 1.0/xx;
+phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 );
+
+z = 1.0/y;
+modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 7 );
+
+y = modulus * cosl( y - PIO4L + z*phase) / sqrtl(y);
+return y;
+}
+
+
+/*
+y0(x) = 2/pi * log(x) * j0(x) + P(z**2)/Q(z**2)
+0 <= x <= 5
+Absolute error
+n=7, d=7
+Peak error = 8.55e-22
+Relative error spread = 2.7e-1
+*/
+#if UNK
+static long double y0n[8] = {
+ 1.556909814120445353691E4L,
+-1.464324149797947303151E7L,
+ 5.427926320587133391307E9L,
+-9.808510181632626683952E11L,
+ 8.747842804834934784972E13L,
+-3.461898868011666236539E15L,
+ 4.421767595991969611983E16L,
+-1.847183690384811186958E16L,
+};
+static long double y0d[7] = {
+/* 1.000000000000000000000E0L,*/
+ 1.040792201755841697889E3L,
+ 6.256391154086099882302E5L,
+ 2.686702051957904669677E8L,
+ 8.630939306572281881328E10L,
+ 2.027480766502742538763E13L,
+ 3.167750475899536301562E15L,
+ 2.502813268068711844040E17L,
+};
+#endif
+#if IBMPC
+static short y0n[] = {
+0x126c,0x20be,0x647f,0xf344,0x400c, XPD
+0x2ec0,0x7b95,0x297f,0xdf70,0xc016, XPD
+0x2fdd,0x4b27,0xca98,0xa1c3,0x401f, XPD
+0x3e3c,0xb343,0x46c9,0xe45f,0xc026, XPD
+0xb219,0x37ba,0x5142,0x9f1f,0x402d, XPD
+0x23c9,0x6b29,0x4244,0xc4c9,0xc032, XPD
+0x501f,0x6264,0xbdf4,0x9d17,0x4036, XPD
+0x5fbd,0x0171,0x135a,0x8340,0xc035, XPD
+};
+static short y0d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x9057,0x7f25,0x59b7,0x8219,0x4009, XPD
+0xd938,0xb6b2,0x71d8,0x98be,0x4012, XPD
+0x97a4,0x90fa,0xa7e9,0x801c,0x401b, XPD
+0x553b,0x4dc8,0x8695,0xa0c3,0x4023, XPD
+0x6732,0x8c1b,0xc5ab,0x9384,0x402b, XPD
+0x04d3,0xa629,0xd61d,0xb410,0x4032, XPD
+0x241a,0x8f2b,0x629a,0xde4b,0x4038, XPD
+};
+#endif
+#if MIEEE
+static long y0n[24] = {
+0x400c0000,0xf344647f,0x20be126c,
+0xc0160000,0xdf70297f,0x7b952ec0,
+0x401f0000,0xa1c3ca98,0x4b272fdd,
+0xc0260000,0xe45f46c9,0xb3433e3c,
+0x402d0000,0x9f1f5142,0x37bab219,
+0xc0320000,0xc4c94244,0x6b2923c9,
+0x40360000,0x9d17bdf4,0x6264501f,
+0xc0350000,0x8340135a,0x01715fbd,
+};
+static long y0d[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40090000,0x821959b7,0x7f259057,
+0x40120000,0x98be71d8,0xb6b2d938,
+0x401b0000,0x801ca7e9,0x90fa97a4,
+0x40230000,0xa0c38695,0x4dc8553b,
+0x402b0000,0x9384c5ab,0x8c1b6732,
+0x40320000,0xb410d61d,0xa62904d3,
+0x40380000,0xde4b629a,0x8f2b241a,
+};
+#endif
+/*
+y0(x) = (x-Y0Z1)(x-Y0Z2)(x-Y0Z3)(x-Y0Z4)P(x)/Q(x)
+4.5 <= x <= 9
+Absolute error
+n=9, d=9
+Peak error = 2.35e-20
+Relative error spread = 7.8e-13
+*/
+#if UNK
+static long double y059n[10] = {
+ 2.368715538373384869796E-2L,
+-1.472923738545276751402E0L,
+ 2.525993724177105060507E1L,
+ 7.727403527387097461580E1L,
+-4.578271827238477598563E3L,
+ 7.051411242092171161986E3L,
+ 1.951120419910720443331E5L,
+ 6.515211089266670755622E5L,
+-1.164760792144532266855E5L,
+-5.566567444353735925323E5L,
+};
+static long double y059d[9] = {
+/* 1.000000000000000000000E0L,*/
+-6.235501989189125881723E1L,
+ 2.224790285641017194158E3L,
+-5.103881883748705381186E4L,
+ 8.772616606054526158657E5L,
+-1.096162986826467060921E7L,
+ 1.083335477747278958468E8L,
+-7.045635226159434678833E8L,
+ 3.518324187204647941098E9L,
+ 1.173085288957116938494E9L,
+};
+#endif
+#if IBMPC
+static short y059n[] = {
+0x992f,0xab45,0x90b6,0xc20b,0x3ff9, XPD
+0x1207,0x46ea,0xc3db,0xbc88,0xbfff, XPD
+0x5504,0x035a,0x59fa,0xca14,0x4003, XPD
+0xd5a3,0xf673,0x4e59,0x9a8c,0x4005, XPD
+0x62e0,0xc25b,0x2cb3,0x8f12,0xc00b, XPD
+0xe8fa,0x4b44,0x4a39,0xdc5b,0x400b, XPD
+0x49e2,0xfb52,0x02af,0xbe8a,0x4010, XPD
+0x8c07,0x29e3,0x11be,0x9f10,0x4012, XPD
+0xfd54,0xb2fe,0x0a23,0xe37e,0xc00f, XPD
+0xf90c,0x3510,0x0be9,0x87e7,0xc012, XPD
+};
+static short y059d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xdebf,0xa468,0x8a55,0xf96b,0xc004, XPD
+0xad09,0x8e6a,0xa502,0x8b0c,0x400a, XPD
+0xa28c,0x5563,0xd19f,0xc75e,0xc00e, XPD
+0xe8b6,0xd705,0xda91,0xd62c,0x4012, XPD
+0xec8a,0x4697,0xddde,0xa742,0xc016, XPD
+0x27ff,0xca92,0x3d78,0xcea1,0x4019, XPD
+0xe26b,0x76b9,0x250a,0xa7fb,0xc01c, XPD
+0xceb6,0x3463,0x5ddb,0xd1b5,0x401e, XPD
+0x3b3b,0xea0b,0xb8d1,0x8bd7,0x401d, XPD
+};
+#endif
+#if MIEEE
+static long y059n[30] = {
+0x3ff90000,0xc20b90b6,0xab45992f,
+0xbfff0000,0xbc88c3db,0x46ea1207,
+0x40030000,0xca1459fa,0x035a5504,
+0x40050000,0x9a8c4e59,0xf673d5a3,
+0xc00b0000,0x8f122cb3,0xc25b62e0,
+0x400b0000,0xdc5b4a39,0x4b44e8fa,
+0x40100000,0xbe8a02af,0xfb5249e2,
+0x40120000,0x9f1011be,0x29e38c07,
+0xc00f0000,0xe37e0a23,0xb2fefd54,
+0xc0120000,0x87e70be9,0x3510f90c,
+};
+static long y059d[27] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0040000,0xf96b8a55,0xa468debf,
+0x400a0000,0x8b0ca502,0x8e6aad09,
+0xc00e0000,0xc75ed19f,0x5563a28c,
+0x40120000,0xd62cda91,0xd705e8b6,
+0xc0160000,0xa742ddde,0x4697ec8a,
+0x40190000,0xcea13d78,0xca9227ff,
+0xc01c0000,0xa7fb250a,0x76b9e26b,
+0x401e0000,0xd1b55ddb,0x3463ceb6,
+0x401d0000,0x8bd7b8d1,0xea0b3b3b,
+};
+#endif
+#define TWOOPI 6.36619772367581343075535E-1L
+#define Y0Z1 3.957678419314857868376e0L
+#define Y0Z2 7.086051060301772697624e0L
+#define Y0Z3 1.022234504349641701900e1L
+#define Y0Z4 1.336109747387276347827e1L
+/* #define MAXNUML 1.189731495357231765021e4932L */
+extern long double MAXNUML;
+
+long double y0l(x)
+long double x;
+{
+long double xx, y, z, modulus, phase;
+
+if( x < 0.0 )
+ {
+ return (-MAXNUML);
+ }
+xx = x * x;
+if( xx < 81.0L )
+ {
+ if( xx < 20.25L )
+ {
+ y = TWOOPI * logl(x) * j0l(x);
+ y += polevll( xx, y0n, 7 ) / p1evll( xx, y0d, 7 );
+ }
+ else
+ {
+ y = (x - Y0Z1)*(x - Y0Z2)*(x - Y0Z3)*(x - Y0Z4);
+ y *= polevll( x, y059n, 9 ) / p1evll( x, y059d, 9 );
+ }
+ return y;
+ }
+
+y = fabsl(x);
+xx = 1.0/xx;
+phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 );
+
+z = 1.0/y;
+modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 7 );
+
+y = modulus * sinl( y - PIO4L + z*phase) / sqrtl(y);
+return y;
+}
diff --git a/libm/ldouble/j1l.c b/libm/ldouble/j1l.c
new file mode 100644
index 000000000..83428473e
--- /dev/null
+++ b/libm/ldouble/j1l.c
@@ -0,0 +1,551 @@
+/* j1l.c
+ *
+ * Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, j1l();
+ *
+ * y = j1l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order one of the argument.
+ *
+ * The domain is divided into the intervals [0, 9] and
+ * (9, infinity). In the first interval the rational approximation
+ * is (x^2 - r^2) (x^2 - s^2) (x^2 - t^2) x P8(x^2) / Q8(x^2),
+ * where r, s, t are the first three zeros of the function.
+ * In the second interval the expansion is in terms of the
+ * modulus M1(x) = sqrt(J1(x)^2 + Y1(x)^2) and phase P1(x)
+ * = atan(Y1(x)/J1(x)). M1 is approximated by sqrt(1/x)P7(1/x)/Q8(1/x).
+ * The approximation to j1 is M1 * cos(x - 3 pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)).
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 40000 1.8e-19 5.0e-20
+ *
+ *
+ */
+ /* y1l.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y1l();
+ *
+ * y = y1l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 4.5>, [4.5,9> and
+ * [9, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute y0(x) = R(x) + 2/pi * log(x) * j0(x).
+ *
+ * In the second interval, the approximation is
+ * (x - p)(x - q)(x - r)(x - s)P9(x)/Q10(x)
+ * where p, q, r, s are zeros of y1(x).
+ *
+ * The third interval uses the same approximations to modulus
+ * and phase as j1(x), whence y1(x) = modulus * sin(phase).
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * IEEE 0, 30 36000 2.7e-19 5.3e-20
+ *
+ */
+
+/* Copyright 1994 by Stephen L. Moshier (moshier@world.std.com). */
+
+#include <math.h>
+
+/*
+j1(x) = (x^2-r0^2)(x^2-r1^2)(x^2-r2^2) x P(x**2)/Q(x**2)
+0 <= x <= 9
+Relative error
+n=8, d=8
+Peak error = 2e-21
+*/
+#if UNK
+static long double j1n[9] = {
+-2.63469779622127762897E-4L,
+ 9.31329762279632791262E-1L,
+-1.46280142797793933909E3L,
+ 1.32000129539331214495E6L,
+-7.41183271195454042842E8L,
+ 2.626500686552841932403E11L,
+-5.68263073022183470933E13L,
+ 6.80006297997263446982E15L,
+-3.41470097444474566748E17L,
+};
+static long double j1d[8] = {
+/* 1.00000000000000000000E0L,*/
+ 2.95267951972943745733E3L,
+ 4.78723926343829674773E6L,
+ 5.37544732957807543920E9L,
+ 4.46866213886267829490E12L,
+ 2.76959756375961607085E15L,
+ 1.23367806884831151194E18L,
+ 3.57325874689695599524E20L,
+ 5.10779045516141578461E22L,
+};
+#endif
+#if IBMPC
+static short j1n[] = {
+0xf72f,0x18cc,0x50b2,0x8a22,0xbff3, XPD
+0x6dc3,0xc850,0xa096,0xee6b,0x3ffe, XPD
+0x29f3,0x496b,0xa54c,0xb6d9,0xc009, XPD
+0x38f5,0xf72b,0x0a5c,0xa122,0x4013, XPD
+0x1ac8,0xc825,0x3c9c,0xb0b6,0xc01c, XPD
+0x038e,0xbd23,0xa7fa,0xf49c,0x4024, XPD
+0x636c,0x4d29,0x9f71,0xcebb,0xc02c, XPD
+0xd3c2,0xf8f0,0xf852,0xc144,0x4033, XPD
+0xd8d8,0x7311,0xa7d2,0x97a4,0xc039, XPD
+};
+static short j1d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xbaf9,0x146e,0xdf50,0xb88a,0x400a, XPD
+0x6a17,0xe162,0x4e86,0x9218,0x4015, XPD
+0x6041,0xc9fe,0x6890,0xa033,0x401f, XPD
+0xb498,0xfdd5,0x209e,0x820e,0x4029, XPD
+0x0122,0x56c0,0xf2ef,0x9d6e,0x4032, XPD
+0xe6c0,0xa725,0x3d56,0x88f7,0x403b, XPD
+0x665d,0xb178,0x242e,0x9af7,0x4043, XPD
+0xdd67,0xf5b3,0x0522,0xad0f,0x404a, XPD
+};
+#endif
+#if MIEEE
+static long j1n[27] = {
+0xbff30000,0x8a2250b2,0x18ccf72f,
+0x3ffe0000,0xee6ba096,0xc8506dc3,
+0xc0090000,0xb6d9a54c,0x496b29f3,
+0x40130000,0xa1220a5c,0xf72b38f5,
+0xc01c0000,0xb0b63c9c,0xc8251ac8,
+0x40240000,0xf49ca7fa,0xbd23038e,
+0xc02c0000,0xcebb9f71,0x4d29636c,
+0x40330000,0xc144f852,0xf8f0d3c2,
+0xc0390000,0x97a4a7d2,0x7311d8d8,
+};
+static long j1d[24] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x400a0000,0xb88adf50,0x146ebaf9,
+0x40150000,0x92184e86,0xe1626a17,
+0x401f0000,0xa0336890,0xc9fe6041,
+0x40290000,0x820e209e,0xfdd5b498,
+0x40320000,0x9d6ef2ef,0x56c00122,
+0x403b0000,0x88f73d56,0xa725e6c0,
+0x40430000,0x9af7242e,0xb178665d,
+0x404a0000,0xad0f0522,0xf5b3dd67,
+};
+#endif
+/*
+sqrt(j0^2(1/x^2) + y0^2(1/x^2)) = z P(z**2)/Q(z**2)
+z(x) = 1/sqrt(x)
+Relative error
+n=7, d=8
+Peak error = 1.35e=20
+Relative error spread = 9.9e0
+*/
+#if UNK
+static long double modulusn[8] = {
+-5.041742205078442098874E0L,
+ 3.918474430130242177355E-1L,
+ 2.527521168680500659056E0L,
+ 7.172146812845906480743E0L,
+ 2.859499532295180940060E0L,
+ 1.014671139779858141347E0L,
+ 1.255798064266130869132E-1L,
+ 1.596507617085714650238E-2L,
+};
+static long double modulusd[8] = {
+/* 1.000000000000000000000E0L,*/
+-6.233092094568239317498E0L,
+-9.214128701852838347002E-1L,
+ 2.531772200570435289832E0L,
+ 8.755081357265851765640E0L,
+ 3.554340386955608261463E0L,
+ 1.267949948774331531237E0L,
+ 1.573909467558180942219E-1L,
+ 2.000925566825407466160E-2L,
+};
+#endif
+#if IBMPC
+static short modulusn[] = {
+0x3d53,0xb598,0xf3bf,0xa155,0xc001, XPD
+0x3111,0x863a,0x3a61,0xc8a0,0x3ffd, XPD
+0x7d55,0xdb8c,0xe825,0xa1c2,0x4000, XPD
+0xe5e2,0x6914,0x3a08,0xe582,0x4001, XPD
+0x71e6,0x88a5,0x0a53,0xb702,0x4000, XPD
+0x2cb0,0xc657,0xbe70,0x81e0,0x3fff, XPD
+0x6de4,0x8fae,0xfe26,0x8097,0x3ffc, XPD
+0xa905,0x05fb,0x3101,0x82c9,0x3ff9, XPD
+};
+static short modulusd[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x2603,0x640e,0x7d8d,0xc775,0xc001, XPD
+0x77b5,0x8f2d,0xb6bf,0xebe1,0xbffe, XPD
+0x6420,0x97ce,0x8e44,0xa208,0x4000, XPD
+0x0260,0x746b,0xd030,0x8c14,0x4002, XPD
+0x77b6,0x34e2,0x501a,0xe37a,0x4000, XPD
+0x37ce,0x79ae,0x2f15,0xa24c,0x3fff, XPD
+0xfc82,0x02c7,0x17a4,0xa12b,0x3ffc, XPD
+0x1237,0xcc6c,0x7356,0xa3ea,0x3ff9, XPD
+};
+#endif
+#if MIEEE
+static long modulusn[24] = {
+0xc0010000,0xa155f3bf,0xb5983d53,
+0x3ffd0000,0xc8a03a61,0x863a3111,
+0x40000000,0xa1c2e825,0xdb8c7d55,
+0x40010000,0xe5823a08,0x6914e5e2,
+0x40000000,0xb7020a53,0x88a571e6,
+0x3fff0000,0x81e0be70,0xc6572cb0,
+0x3ffc0000,0x8097fe26,0x8fae6de4,
+0x3ff90000,0x82c93101,0x05fba905,
+};
+static long modulusd[24] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0010000,0xc7757d8d,0x640e2603,
+0xbffe0000,0xebe1b6bf,0x8f2d77b5,
+0x40000000,0xa2088e44,0x97ce6420,
+0x40020000,0x8c14d030,0x746b0260,
+0x40000000,0xe37a501a,0x34e277b6,
+0x3fff0000,0xa24c2f15,0x79ae37ce,
+0x3ffc0000,0xa12b17a4,0x02c7fc82,
+0x3ff90000,0xa3ea7356,0xcc6c1237,
+};
+#endif
+/*
+atan(y1(x)/j1(x)) = x - 3pi/4 + z P(z**2)/Q(z**2)
+z(x) = 1/x
+Absolute error
+n=5, d=6
+Peak error = 4.83e-21
+Relative error spread = 1.9e0
+*/
+#if UNK
+static long double phasen[6] = {
+ 2.010456367705144783933E0L,
+ 1.587378144541918176658E0L,
+ 2.682837461073751055565E-1L,
+ 1.472572645054468815027E-2L,
+ 2.884976126715926258586E-4L,
+ 1.708502235134706284899E-6L,
+};
+static long double phased[6] = {
+/* 1.000000000000000000000E0L,*/
+ 6.809332495854873089362E0L,
+ 4.518597941618813112665E0L,
+ 7.320149039410806471101E-1L,
+ 3.960155028960712309814E-2L,
+ 7.713202197319040439861E-4L,
+ 4.556005960359216767984E-6L,
+};
+#endif
+#if IBMPC
+static short phasen[] = {
+0xebc0,0x5506,0x512f,0x80ab,0x4000, XPD
+0x6050,0x98aa,0x3500,0xcb2f,0x3fff, XPD
+0xe907,0x28b9,0x7cb7,0x895c,0x3ffd, XPD
+0xa830,0xf4a3,0x2c60,0xf144,0x3ff8, XPD
+0xf74f,0xbe87,0x7e7d,0x9741,0x3ff3, XPD
+0x540c,0xc1d5,0xb096,0xe54f,0x3feb, XPD
+};
+static short phased[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xefe3,0x292c,0x0d43,0xd9e6,0x4001, XPD
+0xb1f2,0xe0d2,0x5ab5,0x9098,0x4001, XPD
+0xc39e,0x9c8c,0x5428,0xbb65,0x3ffe, XPD
+0x98f8,0xd610,0x3c35,0xa235,0x3ffa, XPD
+0xa853,0x55fb,0x6c79,0xca32,0x3ff4, XPD
+0x8d72,0x2be3,0xcb0f,0x98df,0x3fed, XPD
+};
+#endif
+#if MIEEE
+static long phasen[18] = {
+0x40000000,0x80ab512f,0x5506ebc0,
+0x3fff0000,0xcb2f3500,0x98aa6050,
+0x3ffd0000,0x895c7cb7,0x28b9e907,
+0x3ff80000,0xf1442c60,0xf4a3a830,
+0x3ff30000,0x97417e7d,0xbe87f74f,
+0x3feb0000,0xe54fb096,0xc1d5540c,
+};
+static long phased[18] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40010000,0xd9e60d43,0x292cefe3,
+0x40010000,0x90985ab5,0xe0d2b1f2,
+0x3ffe0000,0xbb655428,0x9c8cc39e,
+0x3ffa0000,0xa2353c35,0xd61098f8,
+0x3ff40000,0xca326c79,0x55fba853,
+0x3fed0000,0x98dfcb0f,0x2be38d72,
+};
+#endif
+#define JZ1 1.46819706421238932572e1L
+#define JZ2 4.92184563216946036703e1L
+#define JZ3 1.03499453895136580332e2L
+
+#define THPIO4L 2.35619449019234492885L
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double fabsl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double cosl ( long double );
+extern long double sinl ( long double );
+extern long double logl ( long double );
+long double j1l (long double );
+#else
+long double sqrtl(), fabsl(), polevll(), p1evll(), cosl(), sinl(), logl();
+long double j1l();
+#endif
+
+long double j1l(x)
+long double x;
+{
+long double xx, y, z, modulus, phase;
+
+xx = x * x;
+if( xx < 81.0L )
+ {
+ y = (xx - JZ1) * (xx - JZ2) * (xx - JZ3);
+ y *= x * polevll( xx, j1n, 8 ) / p1evll( xx, j1d, 8 );
+ return y;
+ }
+
+y = fabsl(x);
+xx = 1.0/xx;
+phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 );
+
+z = 1.0/y;
+modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 8 );
+
+y = modulus * cosl( y - THPIO4L + z*phase) / sqrtl(y);
+if( x < 0 )
+ y = -y;
+return y;
+}
+
+/*
+y1(x) = 2/pi * (log(x) * j1(x) - 1/x) + R(x^2) z P(z**2)/Q(z**2)
+0 <= x <= 4.5
+z(x) = x
+Absolute error
+n=6, d=7
+Peak error = 7.25e-22
+Relative error spread = 4.5e-2
+*/
+#if UNK
+static long double y1n[7] = {
+-1.288901054372751879531E5L,
+ 9.914315981558815369372E7L,
+-2.906793378120403577274E10L,
+ 3.954354656937677136266E12L,
+-2.445982226888344140154E14L,
+ 5.685362960165615942886E15L,
+-2.158855258453711703120E16L,
+};
+static long double y1d[7] = {
+/* 1.000000000000000000000E0L,*/
+ 8.926354644853231136073E2L,
+ 4.679841933793707979659E5L,
+ 1.775133253792677466651E8L,
+ 5.089532584184822833416E10L,
+ 1.076474894829072923244E13L,
+ 1.525917240904692387994E15L,
+ 1.101136026928555260168E17L,
+};
+#endif
+#if IBMPC
+static short y1n[] = {
+0x5b16,0xf7f8,0x0d7e,0xfbbd,0xc00f, XPD
+0x53e4,0x194c,0xbefa,0xbd19,0x4019, XPD
+0x7607,0xa687,0xaf0a,0xd892,0xc021, XPD
+0x5633,0xaa6b,0x79e5,0xe62c,0x4028, XPD
+0x69fd,0x1242,0xf62d,0xde75,0xc02e, XPD
+0x7f8b,0x4757,0x75bd,0xa196,0x4033, XPD
+0x3a10,0x0848,0x5930,0x9965,0xc035, XPD
+};
+static short y1d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xdd1a,0x3b8e,0xab73,0xdf28,0x4008, XPD
+0x298c,0x29ef,0x0630,0xe482,0x4011, XPD
+0x0e86,0x117b,0x36d6,0xa94a,0x401a, XPD
+0x57e0,0x1d92,0x90a9,0xbd99,0x4022, XPD
+0xaaf0,0x342b,0xd098,0x9ca5,0x402a, XPD
+0x8c6a,0x397e,0x0963,0xad7a,0x4031, XPD
+0x7302,0xb91b,0xde7e,0xc399,0x4037, XPD
+};
+#endif
+#if MIEEE
+static long y1n[21] = {
+0xc00f0000,0xfbbd0d7e,0xf7f85b16,
+0x40190000,0xbd19befa,0x194c53e4,
+0xc0210000,0xd892af0a,0xa6877607,
+0x40280000,0xe62c79e5,0xaa6b5633,
+0xc02e0000,0xde75f62d,0x124269fd,
+0x40330000,0xa19675bd,0x47577f8b,
+0xc0350000,0x99655930,0x08483a10,
+};
+static long y1d[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40080000,0xdf28ab73,0x3b8edd1a,
+0x40110000,0xe4820630,0x29ef298c,
+0x401a0000,0xa94a36d6,0x117b0e86,
+0x40220000,0xbd9990a9,0x1d9257e0,
+0x402a0000,0x9ca5d098,0x342baaf0,
+0x40310000,0xad7a0963,0x397e8c6a,
+0x40370000,0xc399de7e,0xb91b7302,
+};
+#endif
+/*
+y1(x) = (x-YZ1)(x-YZ2)(x-YZ3)(x-YZ4)R(x) P(z)/Q(z)
+z(x) = x
+4.5 <= x <= 9
+Absolute error
+n=9, d=10
+Peak error = 3.27e-22
+Relative error spread = 4.5e-2
+*/
+#if UNK
+static long double y159n[10] = {
+-6.806634906054210550896E-1L,
+ 4.306669585790359450532E1L,
+-9.230477746767243316014E2L,
+ 6.171186628598134035237E3L,
+ 2.096869860275353982829E4L,
+-1.238961670382216747944E5L,
+-1.781314136808997406109E6L,
+-1.803400156074242435454E6L,
+-1.155761550219364178627E6L,
+ 3.112221202330688509818E5L,
+};
+static long double y159d[10] = {
+/* 1.000000000000000000000E0L,*/
+-6.181482377814679766978E1L,
+ 2.238187927382180589099E3L,
+-5.225317824142187494326E4L,
+ 9.217235006983512475118E5L,
+-1.183757638771741974521E7L,
+ 1.208072488974110742912E8L,
+-8.193431077523942651173E8L,
+ 4.282669747880013349981E9L,
+-1.171523459555524458808E9L,
+ 1.078445545755236785692E8L,
+};
+#endif
+#if IBMPC
+static short y159n[] = {
+0xb5e5,0xbb42,0xf667,0xae3f,0xbffe, XPD
+0xfdf1,0x41e5,0x4beb,0xac44,0x4004, XPD
+0xe917,0x8486,0x0ebd,0xe6c3,0xc008, XPD
+0xdf40,0x226b,0x7e37,0xc0d9,0x400b, XPD
+0xb2bf,0x4296,0x65af,0xa3d1,0x400d, XPD
+0xa33b,0x8229,0x1561,0xf1fc,0xc00f, XPD
+0xcd43,0x2f50,0x1118,0xd972,0xc013, XPD
+0x3811,0xa3da,0x413f,0xdc24,0xc013, XPD
+0xf62f,0xd968,0x8c66,0x8d15,0xc013, XPD
+0x539b,0xf305,0xc3d8,0x97f6,0x4011, XPD
+};
+static short y159d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x1a6c,0x1c93,0x612a,0xf742,0xc004, XPD
+0xd0fe,0x2487,0x01c0,0x8be3,0x400a, XPD
+0xbed4,0x3ad5,0x2da1,0xcc1d,0xc00e, XPD
+0x3c4f,0xdc46,0xb802,0xe107,0x4012, XPD
+0xe5e5,0x4172,0x8863,0xb4a0,0xc016, XPD
+0x6de5,0xb797,0xea1c,0xe66b,0x4019, XPD
+0xa46a,0x0273,0xbc0f,0xc358,0xc01c, XPD
+0x8e0e,0xe148,0x5ab3,0xff44,0x401e, XPD
+0xb3ad,0x1c6d,0x0f07,0x8ba8,0xc01d, XPD
+0xa231,0x6ab0,0x7952,0xcdb2,0x4019, XPD
+};
+#endif
+#if MIEEE
+static long y159n[30] = {
+0xbffe0000,0xae3ff667,0xbb42b5e5,
+0x40040000,0xac444beb,0x41e5fdf1,
+0xc0080000,0xe6c30ebd,0x8486e917,
+0x400b0000,0xc0d97e37,0x226bdf40,
+0x400d0000,0xa3d165af,0x4296b2bf,
+0xc00f0000,0xf1fc1561,0x8229a33b,
+0xc0130000,0xd9721118,0x2f50cd43,
+0xc0130000,0xdc24413f,0xa3da3811,
+0xc0130000,0x8d158c66,0xd968f62f,
+0x40110000,0x97f6c3d8,0xf305539b,
+};
+static long y159d[30] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0040000,0xf742612a,0x1c931a6c,
+0x400a0000,0x8be301c0,0x2487d0fe,
+0xc00e0000,0xcc1d2da1,0x3ad5bed4,
+0x40120000,0xe107b802,0xdc463c4f,
+0xc0160000,0xb4a08863,0x4172e5e5,
+0x40190000,0xe66bea1c,0xb7976de5,
+0xc01c0000,0xc358bc0f,0x0273a46a,
+0x401e0000,0xff445ab3,0xe1488e0e,
+0xc01d0000,0x8ba80f07,0x1c6db3ad,
+0x40190000,0xcdb27952,0x6ab0a231,
+};
+#endif
+
+extern long double MAXNUML;
+/* #define MAXNUML 1.18973149535723176502e4932L */
+#define TWOOPI 6.36619772367581343075535e-1L
+#define THPIO4 2.35619449019234492885L
+#define Y1Z1 2.19714132603101703515e0L
+#define Y1Z2 5.42968104079413513277e0L
+#define Y1Z3 8.59600586833116892643e0L
+#define Y1Z4 1.17491548308398812434e1L
+
+long double y1l(x)
+long double x;
+{
+long double xx, y, z, modulus, phase;
+
+if( x < 0.0 )
+ {
+ return (-MAXNUML);
+ }
+z = 1.0/x;
+xx = x * x;
+if( xx < 81.0L )
+ {
+ if( xx < 20.25L )
+ {
+ y = TWOOPI * (logl(x) * j1l(x) - z);
+ y += x * polevll( xx, y1n, 6 ) / p1evll( xx, y1d, 7 );
+ }
+ else
+ {
+ y = (x - Y1Z1)*(x - Y1Z2)*(x - Y1Z3)*(x - Y1Z4);
+ y *= polevll( x, y159n, 9 ) / p1evll( x, y159d, 10 );
+ }
+ return y;
+ }
+
+xx = 1.0/xx;
+phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 );
+
+modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 8 );
+
+z = modulus * sinl( x - THPIO4L + z*phase) / sqrtl(x);
+return z;
+}
diff --git a/libm/ldouble/jnl.c b/libm/ldouble/jnl.c
new file mode 100644
index 000000000..1b24c50c7
--- /dev/null
+++ b/libm/ldouble/jnl.c
@@ -0,0 +1,130 @@
+/* jnl.c
+ *
+ * Bessel function of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * long double x, y, jnl();
+ *
+ * y = jnl( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The ratio of jn(x) to j0(x) is computed by backward
+ * recurrence. First the ratio jn/jn-1 is found by a
+ * continued fraction expansion. Then the recurrence
+ * relating successive orders is applied until j0 or j1 is
+ * reached.
+ *
+ * If n = 0 or 1 the routine for j0 or j1 is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * IEEE -30, 30 5000 3.3e-19 4.7e-20
+ *
+ *
+ * Not suitable for large n or x.
+ *
+ */
+
+/* jn.c
+Cephes Math Library Release 2.0: April, 1987
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+#include <math.h>
+
+extern long double MACHEPL;
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double j0l ( long double );
+extern long double j1l ( long double );
+#else
+long double fabsl(), j0l(), j1l();
+#endif
+
+long double jnl( n, x )
+int n;
+long double x;
+{
+long double pkm2, pkm1, pk, xk, r, ans;
+int k, sign;
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+if( x < 0.0L )
+ {
+ if( n & 1 )
+ sign = -sign;
+ x = -x;
+ }
+
+
+if( n == 0 )
+ return( sign * j0l(x) );
+if( n == 1 )
+ return( sign * j1l(x) );
+if( n == 2 )
+ return( sign * (2.0L * j1l(x) / x - j0l(x)) );
+
+if( x < MACHEPL )
+ return( 0.0L );
+
+/* continued fraction */
+k = 53;
+pk = 2 * (n + k);
+ans = pk;
+xk = x * x;
+
+do
+ {
+ pk -= 2.0L;
+ ans = pk - (xk/ans);
+ }
+while( --k > 0 );
+ans = x/ans;
+
+/* backward recurrence */
+
+pk = 1.0L;
+pkm1 = 1.0L/ans;
+k = n-1;
+r = 2 * k;
+
+do
+ {
+ pkm2 = (pkm1 * r - pk * x) / x;
+ pk = pkm1;
+ pkm1 = pkm2;
+ r -= 2.0L;
+ }
+while( --k > 0 );
+
+if( fabsl(pk) > fabsl(pkm1) )
+ ans = j1l(x)/pk;
+else
+ ans = j0l(x)/pkm1;
+return( sign * ans );
+}
diff --git a/libm/ldouble/lcalc.c b/libm/ldouble/lcalc.c
new file mode 100644
index 000000000..87250952f
--- /dev/null
+++ b/libm/ldouble/lcalc.c
@@ -0,0 +1,1484 @@
+/* calc.c */
+/* Keyboard command interpreter */
+/* by Stephen L. Moshier */
+
+/* Include functions for IEEE special values */
+#define NANS 1
+
+/* length of command line: */
+#define LINLEN 128
+
+#define XON 0x11
+#define XOFF 0x13
+
+#define SALONE 1
+#define DECPDP 0
+#define INTLOGIN 0
+#define INTHELP 1
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+/* Initialize squirrel printf: */
+#define INIPRINTF 0
+
+#if DECPDP
+#define TRUE 1
+#endif
+
+#include <stdio.h>
+#include <string.h>
+static char idterp[] = {
+"\n\nSteve Moshier's command interpreter V1.3\n"};
+#define ISLOWER(c) ((c >= 'a') && (c <= 'z'))
+#define ISUPPER(c) ((c >= 'A') && (c <= 'Z'))
+#define ISALPHA(c) (ISLOWER(c) || ISUPPER(c))
+#define ISDIGIT(c) ((c >= '0') && (c <= '9'))
+#define ISATF(c) (((c >= 'a')&&(c <= 'f')) || ((c >= 'A')&&(c <= 'F')))
+#define ISXDIGIT(c) (ISDIGIT(c) || ISATF(c))
+#define ISOCTAL(c) ((c >= '0') && (c < '8'))
+#define ISALNUM(c) (ISALPHA(c) || (ISDIGIT(c))
+FILE *fopen();
+
+#include "lcalc.h"
+#include "ehead.h"
+
+/* space for working precision numbers */
+static long double vs[22];
+
+/* the symbol table of temporary variables: */
+
+#define NTEMP 4
+struct varent temp[NTEMP] = {
+{"T", OPR | TEMP, &vs[14]},
+{"T", OPR | TEMP, &vs[15]},
+{"T", OPR | TEMP, &vs[16]},
+{"\0", OPR | TEMP, &vs[17]}
+};
+
+/* the symbol table of operators */
+/* EOL is interpreted on null, newline, or ; */
+struct symbol oprtbl[] = {
+{"BOL", OPR | BOL, 0},
+{"EOL", OPR | EOL, 0},
+{"-", OPR | UMINUS, 8},
+/*"~", OPR | COMP, 8,*/
+{",", OPR | EOE, 1},
+{"=", OPR | EQU, 2},
+/*"|", OPR | LOR, 3,*/
+/*"^", OPR | LXOR, 4,*/
+/*"&", OPR | LAND, 5,*/
+{"+", OPR | PLUS, 6},
+{"-", OPR | MINUS, 6},
+{"*", OPR | MULT, 7},
+{"/", OPR | DIV, 7},
+/*"%", OPR | MOD, 7,*/
+{"(", OPR | LPAREN, 11},
+{")", OPR | RPAREN, 11},
+{"\0", ILLEG, 0}
+};
+
+#define NOPR 8
+
+/* the symbol table of indirect variables: */
+extern long double PIL;
+struct varent indtbl[] = {
+{"t", VAR | IND, &vs[21]},
+{"u", VAR | IND, &vs[20]},
+{"v", VAR | IND, &vs[19]},
+{"w", VAR | IND, &vs[18]},
+{"x", VAR | IND, &vs[10]},
+{"y", VAR | IND, &vs[11]},
+{"z", VAR | IND, &vs[12]},
+{"pi", VAR | IND, &PIL},
+{"\0", ILLEG, 0}
+};
+
+/* the symbol table of constants: */
+
+#define NCONST 10
+struct varent contbl[NCONST] = {
+{"C",CONST,&vs[0]},
+{"C",CONST,&vs[1]},
+{"C",CONST,&vs[2]},
+{"C",CONST,&vs[3]},
+{"C",CONST,&vs[4]},
+{"C",CONST,&vs[5]},
+{"C",CONST,&vs[6]},
+{"C",CONST,&vs[7]},
+{"C",CONST,&vs[8]},
+{"\0",CONST,&vs[9]}
+};
+
+/* the symbol table of string variables: */
+
+static char strngs[160] = {0};
+
+#define NSTRNG 5
+struct strent strtbl[NSTRNG] = {
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{"\0",ILLEG,0},
+};
+
+
+/* Help messages */
+#if INTHELP
+static char *intmsg[] = {
+"?",
+"Unkown symbol",
+"Expression ends in illegal operator",
+"Precede ( by operator",
+")( is illegal",
+"Unmatched )",
+"Missing )",
+"Illegal left hand side",
+"Missing symbol",
+"Must assign to a variable",
+"Divide by zero",
+"Missing symbol",
+"Missing operator",
+"Precede quantity by operator",
+"Quantity preceded by )",
+"Function syntax",
+"Too many function args",
+"No more temps",
+"Arg list"
+};
+#endif
+
+/* the symbol table of functions: */
+#if SALONE
+long double hex(), cmdh(), cmdhlp();
+long double cmddm(), cmdtm(), cmdem();
+long double take(), mxit(), exit(), bits(), csys();
+long double cmddig(), prhlst(), abmac();
+long double ifrac(), xcmpl();
+long double floorl(), logl(), powl(), sqrtl(), tanhl(), expl();
+long double ellpel(), ellpkl(), incbetl(), incbil();
+long double stdtrl(), stdtril(), zstdtrl(), zstdtril();
+long double sinl(), cosl(), tanl(), asinl(), acosl(), atanl(), atan2l();
+long double tanhl(), atanhl();
+#ifdef NANS
+int isnanl(), isfinitel(), signbitl();
+long double zisnan(), zisfinite(), zsignbit();
+#endif
+
+struct funent funtbl[] = {
+{"h", OPR | FUNC, cmdh},
+{"help", OPR | FUNC, cmdhlp},
+{"hex", OPR | FUNC, hex},
+/*"view", OPR | FUNC, view,*/
+{"exp", OPR | FUNC, expl},
+{"floor", OPR | FUNC, floorl},
+{"log", OPR | FUNC, logl},
+{"pow", OPR | FUNC, powl},
+{"sqrt", OPR | FUNC, sqrtl},
+{"tanh", OPR | FUNC, tanhl},
+{"sin", OPR | FUNC, sinl},
+{"cos", OPR | FUNC, cosl},
+{"tan", OPR | FUNC, tanl},
+{"asin", OPR | FUNC, asinl},
+{"acos", OPR | FUNC, acosl},
+{"atan", OPR | FUNC, atanl},
+{"atantwo", OPR | FUNC, atan2l},
+{"tanh", OPR | FUNC, tanhl},
+{"atanh", OPR | FUNC, atanhl},
+{"ellpe", OPR | FUNC, ellpel},
+{"ellpk", OPR | FUNC, ellpkl},
+{"incbet", OPR | FUNC, incbetl},
+{"incbi", OPR | FUNC, incbil},
+{"stdtr", OPR | FUNC, zstdtrl},
+{"stdtri", OPR | FUNC, zstdtril},
+{"ifrac", OPR | FUNC, ifrac},
+{"cmp", OPR | FUNC, xcmpl},
+#ifdef NANS
+{"isnan", OPR | FUNC, zisnan},
+{"isfinite", OPR | FUNC, zisfinite},
+{"signbit", OPR | FUNC, zsignbit},
+#endif
+{"bits", OPR | FUNC, bits},
+{"digits", OPR | FUNC, cmddig},
+{"dm", OPR | FUNC, cmddm},
+{"tm", OPR | FUNC, cmdtm},
+{"em", OPR | FUNC, cmdem},
+{"take", OPR | FUNC | COMMAN, take},
+{"system", OPR | FUNC | COMMAN, csys},
+{"exit", OPR | FUNC, mxit},
+/*
+"remain", OPR | FUNC, eremain,
+*/
+{"\0", OPR | FUNC, 0}
+};
+
+/* the symbol table of key words */
+struct funent keytbl[] = {
+{"\0", ILLEG, 0}
+};
+#endif
+
+void zgets(), init();
+
+/* Number of decimals to display */
+#define DEFDIS 70
+static int ndigits = DEFDIS;
+
+/* Menu stack */
+struct funent *menstk[5] = {&funtbl[0], NULL, NULL, NULL, NULL};
+int menptr = 0;
+
+/* Take file stack */
+FILE *takstk[10] = {0};
+int takptr = -1;
+
+/* size of the expression scan list: */
+#define NSCAN 20
+
+/* previous token, saved for syntax checking: */
+struct symbol *lastok = 0;
+
+/* variables used by parser: */
+static char str[128] = {0};
+int uposs = 0; /* possible unary operator */
+static long double qnc;
+char lc[40] = { '\n' }; /* ASCII string of token symbol */
+static char line[LINLEN] = { '\n','\0' }; /* input command line */
+static char maclin[LINLEN] = { '\n','\0' }; /* macro command */
+char *interl = line; /* pointer into line */
+extern char *interl;
+static int maccnt = 0; /* number of times to execute macro command */
+static int comptr = 0; /* comma stack pointer */
+static long double comstk[5]; /* comma argument stack */
+static int narptr = 0; /* pointer to number of args */
+static int narstk[5] = {0}; /* stack of number of function args */
+
+/* main() */
+
+/* Entire program starts here */
+
+int main()
+{
+
+/* the scan table: */
+
+/* array of pointers to symbols which have been parsed: */
+struct symbol *ascsym[NSCAN];
+
+/* current place in ascsym: */
+register struct symbol **as;
+
+/* array of attributes of operators parsed: */
+int ascopr[NSCAN];
+
+/* current place in ascopr: */
+register int *ao;
+
+#if LARGEMEM
+/* array of precedence levels of operators: */
+long asclev[NSCAN];
+/* current place in asclev: */
+long *al;
+long symval; /* value of symbol just parsed */
+#else
+int asclev[NSCAN];
+int *al;
+int symval;
+#endif
+
+long double acc; /* the accumulator, for arithmetic */
+int accflg; /* flags accumulator in use */
+long double val; /* value to be combined into accumulator */
+register struct symbol *psym; /* pointer to symbol just parsed */
+struct varent *pvar; /* pointer to an indirect variable symbol */
+struct funent *pfun; /* pointer to a function symbol */
+struct strent *pstr; /* pointer to a string symbol */
+int att; /* attributes of symbol just parsed */
+int i; /* counter */
+int offset; /* parenthesis level */
+int lhsflg; /* kluge to detect illegal assignments */
+struct symbol *parser(); /* parser returns pointer to symbol */
+int errcod; /* for syntax error printout */
+
+
+/* Perform general initialization */
+
+init();
+
+menstk[0] = &funtbl[0];
+menptr = 0;
+cmdhlp(); /* print out list of symbols */
+
+
+/* Return here to get next command line to execute */
+getcmd:
+
+/* initialize registers and mutable symbols */
+
+accflg = 0; /* Accumulator not in use */
+acc = 0.0L; /* Clear the accumulator */
+offset = 0; /* Parenthesis level zero */
+comptr = 0; /* Start of comma stack */
+narptr = -1; /* Start of function arg counter stack */
+
+psym = (struct symbol *)&contbl[0];
+for( i=0; i<NCONST; i++ )
+ {
+ psym->attrib = CONST; /* clearing the busy bit */
+ ++psym;
+ }
+psym = (struct symbol *)&temp[0];
+for( i=0; i<NTEMP; i++ )
+ {
+ psym->attrib = VAR | TEMP; /* clearing the busy bit */
+ ++psym;
+ }
+
+pstr = &strtbl[0];
+for( i=0; i<NSTRNG; i++ )
+ {
+ pstr->spel = &strngs[ 40*i ];
+ pstr->attrib = STRING | VAR;
+ pstr->string = &strngs[ 40*i ];
+ ++pstr;
+ }
+
+/* List of scanned symbols is empty: */
+as = &ascsym[0];
+*as = 0;
+--as;
+/* First item in scan list is Beginning of Line operator */
+ao = &ascopr[0];
+*ao = oprtbl[0].attrib & 0xf; /* BOL */
+/* value of first item: */
+al = &asclev[0];
+*al = oprtbl[0].sym;
+
+lhsflg = 0; /* illegal left hand side flag */
+psym = &oprtbl[0]; /* pointer to current token */
+
+/* get next token from input string */
+
+gettok:
+lastok = psym; /* last token = current token */
+psym = parser(); /* get a new current token */
+/*printf( "%s attrib %7o value %7o\n", psym->spel, psym->attrib & 0xffff,
+ psym->sym );*/
+
+/* Examine attributes of the symbol returned by the parser */
+att = psym->attrib;
+if( att == ILLEG )
+ {
+ errcod = 1;
+ goto synerr;
+ }
+
+/* Push functions onto scan list without analyzing further */
+if( att & FUNC )
+ {
+ /* A command is a function whose argument is
+ * a pointer to the rest of the input line.
+ * A second argument is also passed: the address
+ * of the last token parsed.
+ */
+ if( att & COMMAN )
+ {
+ pfun = (struct funent *)psym;
+ ( *(pfun->fun))( interl, lastok );
+ abmac(); /* scrub the input line */
+ goto getcmd; /* and ask for more input */
+ }
+ ++narptr; /* offset to number of args */
+ narstk[narptr] = 0;
+ i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+ if( ((i & OPR) == 0)
+ || (i == (OPR | RPAREN))
+ || (i == (OPR | FUNC)) )
+ {
+ errcod = 15;
+ goto synerr;
+ }
+
+ ++lhsflg;
+ ++as;
+ *as = psym;
+ ++ao;
+ *ao = FUNC;
+ ++al;
+ *al = offset + UMINUS;
+ goto gettok;
+ }
+
+/* deal with operators */
+if( att & OPR )
+ {
+ att &= 0xf;
+ /* expression cannot end with an operator other than
+ * (, ), BOL, or a function
+ */
+ if( (att == RPAREN) || (att == EOL) || (att == EOE))
+ {
+ i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+ if( (i & OPR)
+ && (i != (OPR | RPAREN))
+ && (i != (OPR | LPAREN))
+ && (i != (OPR | FUNC))
+ && (i != (OPR | BOL)) )
+ {
+ errcod = 2;
+ goto synerr;
+ }
+ }
+ ++lhsflg; /* any operator but ( and = is not a legal lhs */
+
+/* operator processing, continued */
+
+ switch( att )
+ {
+ case EOE:
+ lhsflg = 0;
+ break;
+ case LPAREN:
+ /* ( must be preceded by an operator of some sort. */
+ if( ((lastok->attrib & OPR) == 0) )
+ {
+ errcod = 3;
+ goto synerr;
+ }
+ /* also, a preceding ) is illegal */
+ if( (unsigned short )lastok->attrib == (OPR|RPAREN))
+ {
+ errcod = 4;
+ goto synerr;
+ }
+ /* Begin looking for illegal left hand sides: */
+ lhsflg = 0;
+ offset += RPAREN; /* new parenthesis level */
+ goto gettok;
+ case RPAREN:
+ offset -= RPAREN; /* parenthesis level */
+ if( offset < 0 )
+ {
+ errcod = 5; /* parenthesis error */
+ goto synerr;
+ }
+ goto gettok;
+ case EOL:
+ if( offset != 0 )
+ {
+ errcod = 6; /* parenthesis error */
+ goto synerr;
+ }
+ break;
+ case EQU:
+ if( --lhsflg ) /* was incremented before switch{} */
+ {
+ errcod = 7;
+ goto synerr;
+ }
+ case UMINUS:
+ case COMP:
+ goto pshopr; /* evaluate right to left */
+ default: ;
+ }
+
+
+/* evaluate expression whenever precedence is not increasing */
+
+symval = psym->sym + offset;
+
+while( symval <= *al )
+ {
+ /* if just starting, must fill accumulator with last
+ * thing on the line
+ */
+ if( (accflg == 0) && (as >= ascsym) && (((*as)->attrib & FUNC) == 0 ))
+ {
+ pvar = (struct varent *)*as;
+/*
+ if( pvar->attrib & STRING )
+ strcpy( (char *)&acc, (char *)pvar->value );
+ else
+*/
+ acc = *pvar->value;
+ --as;
+ accflg = 1;
+ }
+
+/* handle beginning of line type cases, where the symbol
+ * list ascsym[] may be empty.
+ */
+ switch( *ao )
+ {
+ case BOL:
+/* printf( "%.16e\n", (double )acc ); */
+#if NE == 6
+ e64toasc( &acc, str, 100 );
+#else
+ e113toasc( &acc, str, 100 );
+#endif
+ printf( "%s\n", str );
+ goto getcmd; /* all finished */
+ case UMINUS:
+ acc = -acc;
+ goto nochg;
+/*
+ case COMP:
+ acc = ~acc;
+ goto nochg;
+*/
+ default: ;
+ }
+/* Now it is illegal for symbol list to be empty,
+ * because we are going to need a symbol below.
+ */
+ if( as < &ascsym[0] )
+ {
+ errcod = 8;
+ goto synerr;
+ }
+/* get attributes and value of current symbol */
+ att = (*as)->attrib;
+ pvar = (struct varent *)*as;
+ if( att & FUNC )
+ val = 0.0L;
+ else
+ {
+/*
+ if( att & STRING )
+ strcpy( (char *)&val, (char *)pvar->value );
+ else
+*/
+ val = *pvar->value;
+ }
+
+/* Expression evaluation, continued. */
+
+ switch( *ao )
+ {
+ case FUNC:
+ pfun = (struct funent *)*as;
+ /* Call the function with appropriate number of args */
+ i = narstk[ narptr ];
+ --narptr;
+ switch(i)
+ {
+ case 0:
+ acc = ( *(pfun->fun) )(acc);
+ break;
+ case 1:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-1]);
+ break;
+ case 2:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-2],
+ comstk[comptr-1]);
+ break;
+ case 3:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-3],
+ comstk[comptr-2], comstk[comptr-1]);
+ break;
+ default:
+ errcod = 16;
+ goto synerr;
+ }
+ comptr -= i;
+ accflg = 1; /* in case at end of line */
+ break;
+ case EQU:
+ if( ( att & TEMP) || ((att & VAR) == 0) || (att & STRING) )
+ {
+ errcod = 9;
+ goto synerr; /* can only assign to a variable */
+ }
+ pvar = (struct varent *)*as;
+ *pvar->value = acc;
+ break;
+ case PLUS:
+ acc = acc + val; break;
+ case MINUS:
+ acc = val - acc; break;
+ case MULT:
+ acc = acc * val; break;
+ case DIV:
+ if( acc == 0.0L )
+ {
+/*
+divzer:
+*/
+ errcod = 10;
+ goto synerr;
+ }
+ acc = val / acc; break;
+/*
+ case MOD:
+ if( acc == 0 )
+ goto divzer;
+ acc = val % acc; break;
+ case LOR:
+ acc |= val; break;
+ case LXOR:
+ acc ^= val; break;
+ case LAND:
+ acc &= val; break;
+*/
+ case EOE:
+ if( narptr < 0 )
+ {
+ errcod = 18;
+ goto synerr;
+ }
+ narstk[narptr] += 1;
+ comstk[comptr++] = acc;
+/* printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/
+ acc = val;
+ break;
+ }
+
+
+/* expression evaluation, continued */
+
+/* Pop evaluated tokens from scan list: */
+ /* make temporary variable not busy */
+ if( att & TEMP )
+ (*as)->attrib &= ~BUSY;
+ if( as < &ascsym[0] ) /* can this happen? */
+ {
+ errcod = 11;
+ goto synerr;
+ }
+ --as;
+nochg:
+ --ao;
+ --al;
+ if( ao < &ascopr[0] ) /* can this happen? */
+ {
+ errcod = 12;
+ goto synerr;
+ }
+/* If precedence level will now increase, then */
+/* save accumulator in a temporary location */
+ if( symval > *al )
+ {
+ /* find a free temp location */
+ pvar = &temp[0];
+ for( i=0; i<NTEMP; i++ )
+ {
+ if( (pvar->attrib & BUSY) == 0)
+ goto temfnd;
+ ++pvar;
+ }
+ errcod = 17;
+ printf( "no more temps\n" );
+ pvar = &temp[0];
+ goto synerr;
+
+ temfnd:
+ pvar->attrib |= BUSY;
+ *pvar->value = acc;
+ /*printf( "temp %d\n", acc );*/
+ accflg = 0;
+ ++as; /* push the temp onto the scan list */
+ *as = (struct symbol *)pvar;
+ }
+ } /* End of evaluation loop */
+
+
+/* Push operator onto scan list when precedence increases */
+
+pshopr:
+ ++ao;
+ *ao = psym->attrib & 0xf;
+ ++al;
+ *al = psym->sym + offset;
+ goto gettok;
+ } /* end of OPR processing */
+
+
+/* Token was not an operator. Push symbol onto scan list. */
+if( (lastok->attrib & OPR) == 0 )
+ {
+ errcod = 13;
+ goto synerr; /* quantities must be preceded by an operator */
+ }
+if( (unsigned short )lastok->attrib == (OPR | RPAREN) ) /* ...but not by ) */
+ {
+ errcod = 14;
+ goto synerr;
+ }
+++as;
+*as = psym;
+goto gettok;
+
+synerr:
+
+#if INTHELP
+printf( "%s ", intmsg[errcod] );
+#endif
+printf( " error %d\n", errcod );
+abmac(); /* flush the command line */
+goto getcmd;
+} /* end of program */
+
+/* parser() */
+
+/* Get token from input string and identify it. */
+
+
+static char number[128];
+
+struct symbol *parser( )
+{
+register struct symbol *psym;
+register char *pline;
+struct varent *pvar;
+struct strent *pstr;
+char *cp, *plc, *pn;
+long lnc;
+int i;
+long double tem;
+
+/* reference for old Whitesmiths compiler: */
+/*
+ *extern FILE *stdout;
+ */
+
+pline = interl; /* get current location in command string */
+
+
+/* If at beginning of string, must ask for more input */
+if( pline == line )
+ {
+
+ if( maccnt > 0 )
+ {
+ --maccnt;
+ cp = maclin;
+ plc = pline;
+ while( (*plc++ = *cp++) != 0 )
+ ;
+ goto mstart;
+ }
+ if( takptr < 0 )
+ { /* no take file active: prompt keyboard input */
+ printf("* ");
+ }
+/* Various ways of typing in a command line. */
+
+/*
+ * Old Whitesmiths call to print "*" immediately
+ * use RT11 .GTLIN to get command string
+ * from command file or terminal
+ */
+
+/*
+ * fflush(stdout);
+ * gtlin(line);
+ */
+
+
+ zgets( line, TRUE ); /* keyboard input for other systems: */
+
+
+mstart:
+ uposs = 1; /* unary operators possible at start of line */
+ }
+
+ignore:
+/* Skip over spaces */
+while( *pline == ' ' )
+ ++pline;
+
+/* unary minus after operator */
+if( uposs && (*pline == '-') )
+ {
+ psym = &oprtbl[2]; /* UMINUS */
+ ++pline;
+ goto pdon3;
+ }
+ /* COMP */
+/*
+if( uposs && (*pline == '~') )
+ {
+ psym = &oprtbl[3];
+ ++pline;
+ goto pdon3;
+ }
+*/
+if( uposs && (*pline == '+') ) /* ignore leading plus sign */
+ {
+ ++pline;
+ goto ignore;
+ }
+
+/* end of null terminated input */
+if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+ {
+ pline = line;
+ goto endlin;
+ }
+if( *pline == ';' )
+ {
+ ++pline;
+endlin:
+ psym = &oprtbl[1]; /* EOL */
+ goto pdon2;
+ }
+
+
+/* parser() */
+
+
+/* Test for numeric input */
+if( (ISDIGIT(*pline)) || (*pline == '.') )
+ {
+ lnc = 0; /* initialize numeric input to zero */
+ qnc = 0.0L;
+ if( *pline == '0' )
+ { /* leading "0" may mean octal or hex radix */
+ ++pline;
+ if( *pline == '.' )
+ goto decimal; /* 0.ddd */
+ /* leading "0x" means hexadecimal radix */
+ if( (*pline == 'x') || (*pline == 'X') )
+ {
+ ++pline;
+ while( ISXDIGIT(*pline) )
+ {
+ i = *pline++ & 0xff;
+ if( i >= 'a' )
+ i -= 047;
+ if( i >= 'A' )
+ i -= 07;
+ i -= 060;
+ lnc = (lnc << 4) + i;
+ qnc = lnc;
+ }
+ goto numdon;
+ }
+ else
+ {
+ while( ISOCTAL( *pline ) )
+ {
+ i = ((*pline++) & 0xff) - 060;
+ lnc = (lnc << 3) + i;
+ qnc = lnc;
+ }
+ goto numdon;
+ }
+ }
+ else
+ {
+ /* no leading "0" means decimal radix */
+/******/
+decimal:
+ pn = number;
+ while( (ISDIGIT(*pline)) || (*pline == '.') )
+ *pn++ = *pline++;
+/* get possible exponent field */
+ if( (*pline == 'e') || (*pline == 'E') )
+ *pn++ = *pline++;
+ else
+ goto numcvt;
+ if( (*pline == '-') || (*pline == '+') )
+ *pn++ = *pline++;
+ while( ISDIGIT(*pline) )
+ *pn++ = *pline++;
+numcvt:
+ *pn++ = ' ';
+ *pn++ = 0;
+#if NE == 6
+ asctoe64( number, &qnc );
+#else
+ asctoe113( number, &qnc );
+#endif
+/* sscanf( number, "%le", &nc ); */
+ }
+/* output the number */
+numdon:
+ /* search the symbol table of constants */
+ pvar = &contbl[0];
+ for( i=0; i<NCONST; i++ )
+ {
+ if( (pvar->attrib & BUSY) == 0 )
+ goto confnd;
+ tem = *pvar->value;
+ if( tem == qnc )
+ {
+ psym = (struct symbol *)pvar;
+ goto pdon2;
+ }
+ ++pvar;
+ }
+ printf( "no room for constant\n" );
+ psym = (struct symbol *)&contbl[0];
+ goto pdon2;
+
+confnd:
+ pvar->spel= contbl[0].spel;
+ pvar->attrib = CONST | BUSY;
+ *pvar->value = qnc;
+ psym = (struct symbol *)pvar;
+ goto pdon2;
+ }
+
+/* check for operators */
+psym = &oprtbl[3];
+for( i=0; i<NOPR; i++ )
+ {
+ if( *pline == *(psym->spel) )
+ goto pdon1;
+ ++psym;
+ }
+
+/* if quoted, it is a string variable */
+if( *pline == '"' )
+ {
+ /* find an empty slot for the string */
+ pstr = strtbl; /* string table */
+ for( i=0; i<NSTRNG-1; i++ )
+ {
+ if( (pstr->attrib & BUSY) == 0 )
+ goto fndstr;
+ ++pstr;
+ }
+ printf( "No room for string\n" );
+ pstr->attrib |= ILLEG;
+ psym = (struct symbol *)pstr;
+ goto pdon0;
+
+fndstr:
+ pstr->attrib |= BUSY;
+ plc = pstr->string;
+ ++pline;
+ for( i=0; i<39; i++ )
+ {
+ *plc++ = *pline;
+ if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+ {
+illstr:
+ pstr = &strtbl[NSTRNG-1];
+ pstr->attrib |= ILLEG;
+ printf( "Missing string terminator\n" );
+ psym = (struct symbol *)pstr;
+ goto pdon0;
+ }
+ if( *pline++ == '"' )
+ goto finstr;
+ }
+
+ goto illstr; /* no terminator found */
+
+finstr:
+ --plc;
+ *plc = '\0';
+ psym = (struct symbol *)pstr;
+ goto pdon2;
+ }
+/* If none of the above, search function and symbol tables: */
+
+/* copy character string to array lc[] */
+plc = &lc[0];
+while( ISALPHA(*pline) )
+ {
+ /* convert to lower case characters */
+ if( ISUPPER( *pline ) )
+ *pline += 040;
+ *plc++ = *pline++;
+ }
+*plc = 0; /* Null terminate the output string */
+
+/* parser() */
+
+psym = (struct symbol *)menstk[menptr]; /* function table */
+plc = &lc[0];
+cp = psym->spel;
+do
+ {
+ if( strcmp( plc, cp ) == 0 )
+ goto pdon3; /* following unary minus is possible */
+ ++psym;
+ cp = psym->spel;
+ }
+while( *cp != '\0' );
+
+psym = (struct symbol *)&indtbl[0]; /* indirect symbol table */
+plc = &lc[0];
+cp = psym->spel;
+do
+ {
+ if( strcmp( plc, cp ) == 0 )
+ goto pdon2;
+ ++psym;
+ cp = psym->spel;
+ }
+while( *cp != '\0' );
+
+pdon0:
+pline = line; /* scrub line if illegal symbol */
+goto pdon2;
+
+pdon1:
+++pline;
+if( (psym->attrib & 0xf) == RPAREN )
+pdon2: uposs = 0;
+else
+pdon3: uposs = 1;
+
+interl = pline;
+return( psym );
+} /* end of parser */
+
+/* exit from current menu */
+
+long double cmdex()
+{
+
+if( menptr == 0 )
+ {
+ printf( "Main menu is active.\n" );
+ }
+else
+ --menptr;
+
+cmdh();
+return(0.0L);
+}
+
+
+/* gets() */
+
+void zgets( gline, echo )
+char *gline;
+int echo;
+{
+register char *pline;
+register int i;
+
+
+scrub:
+pline = gline;
+getsl:
+ if( (pline - gline) >= LINLEN )
+ {
+ printf( "\nLine too long\n *" );
+ goto scrub;
+ }
+ if( takptr < 0 )
+ { /* get character from keyboard */
+/*
+if DECPDP
+ gtlin( gline );
+ return(0);
+else
+*/
+ *pline = getchar();
+/*endif*/
+ }
+ else
+ { /* get a character from take file */
+ i = fgetc( takstk[takptr] );
+ if( i == -1 )
+ { /* end of take file */
+ if( takptr >= 0 )
+ { /* close file and bump take stack */
+ fclose( takstk[takptr] );
+ takptr -= 1;
+ }
+ if( takptr < 0 ) /* no more take files: */
+ printf( "*" ); /* prompt keyboard input */
+ goto scrub; /* start a new input line */
+ }
+ *pline = i;
+ }
+
+ *pline &= 0x7f;
+ /* xon or xoff characters need filtering out. */
+ if ( *pline == XON || *pline == XOFF )
+ goto getsl;
+
+ /* control U or control C */
+ if( (*pline == 025) || (*pline == 03) )
+ {
+ printf( "\n" );
+ goto scrub;
+ }
+
+ /* Backspace or rubout */
+ if( (*pline == 010) || (*pline == 0177) )
+ {
+ pline -= 1;
+ if( pline >= gline )
+ {
+ if ( echo )
+ printf( "\010\040\010" );
+ goto getsl;
+ }
+ else
+ goto scrub;
+ }
+ if ( echo )
+ printf( "%c", *pline );
+ if( (*pline != '\n') && (*pline != '\r') )
+ {
+ ++pline;
+ goto getsl;
+ }
+ *pline = 0;
+ if ( echo )
+ printf( "%c", '\n' ); /* \r already echoed */
+}
+
+
+/* help function */
+long double cmdhlp()
+{
+
+printf( "%s", idterp );
+printf( "\nFunctions:\n" );
+prhlst( &funtbl[0] );
+printf( "\nVariables:\n" );
+prhlst( &indtbl[0] );
+printf( "\nOperators:\n" );
+prhlst( &oprtbl[2] );
+printf("\n");
+return(0.0L);
+}
+
+
+long double cmdh()
+{
+
+prhlst( menstk[menptr] );
+printf( "\n" );
+return(0.0L);
+}
+
+/* print keyword spellings */
+
+long double prhlst(ps)
+register struct symbol *ps;
+{
+register int j, k;
+int m;
+
+j = 0;
+while( *(ps->spel) != '\0' )
+ {
+ k = strlen( ps->spel ) - 1;
+/* size of a tab field is 2**3 chars */
+ m = ((k >> 3) + 1) << 3;
+ j += m;
+ if( j > 72 )
+ {
+ printf( "\n" );
+ j = m;
+ }
+ printf( "%s\t", ps->spel );
+ ++ps;
+ }
+return(0.0L);
+}
+
+
+#if SALONE
+void init(){}
+#endif
+
+
+/* macro commands */
+
+/* define macro */
+long double cmddm()
+{
+
+zgets( maclin, TRUE );
+return(0.0L);
+}
+
+/* type (i.e., display) macro */
+long double cmdtm()
+{
+
+printf( "%s\n", maclin );
+return(0.0L);
+}
+
+/* execute macro # times */
+long double cmdem( arg )
+long double arg;
+{
+long double f;
+long n;
+long double floorl();
+
+f = floorl(arg);
+n = f;
+if( n <= 0 )
+ n = 1;
+maccnt = n;
+return(0.0L);
+}
+
+
+/* open a take file */
+
+long double take( fname )
+char *fname;
+{
+FILE *f;
+
+while( *fname == ' ' )
+ fname += 1;
+f = fopen( fname, "r" );
+
+if( f == 0 )
+ {
+ printf( "Can't open take file %s\n", fname );
+ takptr = -1; /* terminate all take file input */
+ return(0.0L);
+ }
+takptr += 1;
+takstk[ takptr ] = f;
+printf( "Running %s\n", fname );
+return(0.0L);
+}
+
+
+/* abort macro execution */
+long double abmac()
+{
+
+maccnt = 0;
+interl = line;
+return(0.0L);
+}
+
+
+/* display integer part in hex, octal, and decimal
+ */
+long double hex(qx)
+long double qx;
+{
+long double f;
+long z;
+long double floorl();
+
+f = floorl(qx);
+z = f;
+printf( "0%lo 0x%lx %ld.\n", z, z, z );
+return(qx);
+}
+
+#define NASC 16
+
+long double bits( x )
+long double x;
+{
+int i, j;
+unsigned short dd[4], ee[10];
+char strx[40];
+unsigned short *p;
+
+p = (unsigned short *) &x;
+for( i=0; i<NE; i++ )
+ ee[i] = *p++;
+
+j = 0;
+for( i=0; i<NE; i++ )
+ {
+ printf( "0x%04x,", ee[i] & 0xffff );
+ if( ++j > 7 )
+ {
+ j = 0;
+ printf( "\n" );
+ }
+ }
+printf( "\n" );
+
+/* double conversions
+ */
+*((double *)dd) = x;
+printf( "double: " );
+for( i=0; i<4; i++ )
+ printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+
+#if 1
+printf( "double -> long double: " );
+*(long double *)ee = *(double *)dd;
+for( i=0; i<6; i++ )
+ printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+e53toasc( dd, strx, NASC );
+printf( "e53toasc: %s\n", strx );
+printf( "Native printf: %.17e\n", *(double *)dd );
+
+/* float conversions
+ */
+*((float *)dd) = x;
+printf( "float: " );
+for( i=0; i<2; i++ )
+ printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+e24toe( dd, ee );
+printf( "e24toe: " );
+for( i=0; i<NE; i++ )
+ printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+e24toasc( dd, strx, NASC );
+printf( "e24toasc: %s\n", strx );
+/* printf( "Native printf: %.16e\n", (double) *(float *)dd ); */
+
+#ifdef DEC
+printf( "etodec: " );
+etodec( x, dd );
+for( i=0; i<4; i++ )
+ printf( "0x%04x,", dd[i] & 0xffff );
+printf( "\n" );
+printf( "dectoe: " );
+dectoe( dd, ee );
+for( i=0; i<NE; i++ )
+ printf( "0x%04x,", ee[i] & 0xffff );
+printf( "\n" );
+printf( "DEC printf: %.16e\n", *(double *)dd );
+#endif
+#endif /* 0 */
+return(x);
+}
+
+
+/* Exit to monitor. */
+long double mxit()
+{
+
+exit(0);
+return(0.0L);
+}
+
+
+long double cmddig( x )
+long double x;
+{
+long double f;
+long lx;
+
+f = floorl(x);
+lx = f;
+ndigits = lx;
+if( ndigits <= 0 )
+ ndigits = DEFDIS;
+return(f);
+}
+
+
+long double csys(x)
+char *x;
+{
+void system();
+
+system( x+1 );
+cmdh();
+return(0.0L);
+}
+
+
+long double ifrac(x)
+long double x;
+{
+unsigned long lx;
+long double y, z;
+
+z = floorl(x);
+lx = z;
+y = x - z;
+printf( " int = %lx\n", lx );
+return(y);
+}
+
+long double xcmpl(x,y)
+long double x,y;
+{
+long double ans;
+char str[40];
+
+#if NE == 6
+ e64toasc( &x, str, 100 );
+ printf( "x = %s\n", str );
+ e64toasc( &y, str, 100 );
+ printf( "y = %s\n", str );
+#else
+ e113toasc( &x, str, 100 );
+ printf( "x = %s\n", str );
+ e113toasc( &y, str, 100 );
+ printf( "y = %s\n", str );
+#endif
+
+ans = -2.0;
+if( x == y )
+ {
+ printf( "x == y " );
+ ans = 0.0;
+ }
+if( x < y )
+ {
+ printf( "x < y" );
+ ans = -1.0;
+ }
+if( x > y )
+ {
+ printf( "x > y" );
+ ans = 1.0;
+ }
+return( ans );
+}
+
+long double zstdtrl(k,t)
+long double k, t;
+{
+int ki;
+long double y;
+ki = k;
+y = stdtrl(ki,t);
+return(y);
+}
+
+long double zstdtril(k,t)
+long double k, t;
+{
+int ki;
+long double y;
+ki = k;
+y = stdtril(ki,t);
+return(y);
+}
+
+#ifdef NANS
+long double zisnan(x)
+long double x;
+{
+ long double y;
+ int k;
+ k = isnanl(x);
+ y = k;
+ return(y);
+}
+long double zisfinite(x)
+long double x;
+{
+ long double y;
+ int k;
+ k = isfinitel(x);
+ y = k;
+ return(y);
+}
+long double zsignbit(x)
+long double x;
+{
+ long double y;
+ int k;
+ k = signbitl(x);
+ y = k;
+ return(y);
+}
+#endif
diff --git a/libm/ldouble/lcalc.h b/libm/ldouble/lcalc.h
new file mode 100644
index 000000000..7be51d79e
--- /dev/null
+++ b/libm/ldouble/lcalc.h
@@ -0,0 +1,79 @@
+/* calc.h
+ * include file for calc.c
+ */
+
+/* 32 bit memory addresses: */
+#ifndef LARGEMEM
+#define LARGEMEM 1
+#endif
+
+/* data structure of symbol table */
+struct symbol
+ {
+ char *spel;
+ short attrib;
+#if LARGEMEM
+ long sym;
+#else
+ short sym;
+#endif
+ };
+
+struct funent
+ {
+ char *spel;
+ short attrib;
+ long double (*fun )();
+ };
+
+struct varent
+ {
+ char *spel;
+ short attrib;
+ long double *value;
+ };
+
+struct strent
+ {
+ char *spel;
+ short attrib;
+ char *string;
+ };
+
+
+/* general symbol attributes: */
+#define OPR 0x8000
+#define VAR 0x4000
+#define CONST 0x2000
+#define FUNC 0x1000
+#define ILLEG 0x800
+#define BUSY 0x400
+#define TEMP 0x200
+#define STRING 0x100
+#define COMMAN 0x80
+#define IND 0x1
+
+/* attributes of operators (ordered by precedence): */
+#define BOL 1
+#define EOL 2
+/* end of expression (comma): */
+#define EOE 3
+#define EQU 4
+#define PLUS 5
+#define MINUS 6
+#define MULT 7
+#define DIV 8
+#define UMINUS 9
+#define LPAREN 10
+#define RPAREN 11
+#define COMP 12
+#define MOD 13
+#define LAND 14
+#define LOR 15
+#define LXOR 16
+
+
+extern struct funent funtbl[];
+/*extern struct symbol symtbl[];*/
+extern struct varent indtbl[];
+
diff --git a/libm/ldouble/ldrand.c b/libm/ldouble/ldrand.c
new file mode 100644
index 000000000..892b465df
--- /dev/null
+++ b/libm/ldouble/ldrand.c
@@ -0,0 +1,175 @@
+/* ldrand.c
+ *
+ * Pseudorandom number generator
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double y;
+ * int ldrand();
+ *
+ * ldrand( &y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Yields a random number 1.0 <= y < 2.0.
+ *
+ * The three-generator congruential algorithm by Brian
+ * Wichmann and David Hill (BYTE magazine, March, 1987,
+ * pp 127-8) is used.
+ *
+ * Versions invoked by the different arithmetic compile
+ * time options IBMPC, and MIEEE, produce the same sequences.
+ *
+ */
+
+
+
+#include <math.h>
+#ifdef ANSIPROT
+int ranwh ( void );
+#else
+int ranwh();
+#endif
+#ifdef UNK
+#undef UNK
+#if BIGENDIAN
+#define MIEEE
+#else
+#define IBMPC
+#endif
+#endif
+
+/* Three-generator random number algorithm
+ * of Brian Wichmann and David Hill
+ * BYTE magazine, March, 1987 pp 127-8
+ *
+ * The period, given by them, is (p-1)(q-1)(r-1)/4 = 6.95e12.
+ */
+
+static int sx = 1;
+static int sy = 10000;
+static int sz = 3000;
+
+static union {
+ long double d;
+ unsigned short s[8];
+} unkans;
+
+/* This function implements the three
+ * congruential generators.
+ */
+
+int ranwh()
+{
+int r, s;
+
+/* sx = sx * 171 mod 30269 */
+r = sx/177;
+s = sx - 177 * r;
+sx = 171 * s - 2 * r;
+if( sx < 0 )
+ sx += 30269;
+
+
+/* sy = sy * 172 mod 30307 */
+r = sy/176;
+s = sy - 176 * r;
+sy = 172 * s - 35 * r;
+if( sy < 0 )
+ sy += 30307;
+
+/* sz = 170 * sz mod 30323 */
+r = sz/178;
+s = sz - 178 * r;
+sz = 170 * s - 63 * r;
+if( sz < 0 )
+ sz += 30323;
+/* The results are in static sx, sy, sz. */
+return 0;
+}
+
+/* ldrand.c
+ *
+ * Random double precision floating point number between 1 and 2.
+ *
+ * C callable:
+ * drand( &x );
+ */
+
+int ldrand( a )
+long double *a;
+{
+unsigned short r;
+
+/* This algorithm of Wichmann and Hill computes a floating point
+ * result:
+ */
+ranwh();
+unkans.d = sx/30269.0L + sy/30307.0L + sz/30323.0L;
+r = unkans.d;
+unkans.d -= r;
+unkans.d += 1.0L;
+
+if( sizeof(long double) == 16 )
+ {
+#ifdef MIEEE
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[7] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[6] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[5] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[4] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[3] = r;
+#endif
+#ifdef IBMPC
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[0] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[1] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[2] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[3] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[4] = r;
+#endif
+ }
+else
+ {
+#ifdef MIEEE
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[5] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[4] = r;
+#endif
+#ifdef IBMPC
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[0] = r;
+ ranwh();
+ r = sx * sy + sz;
+ unkans.s[1] = r;
+#endif
+ }
+*a = unkans.d;
+return 0;
+}
diff --git a/libm/ldouble/log10l.c b/libm/ldouble/log10l.c
new file mode 100644
index 000000000..fa13ff3a2
--- /dev/null
+++ b/libm/ldouble/log10l.c
@@ -0,0 +1,319 @@
+/* log10l.c
+ *
+ * Common logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log10l();
+ *
+ * y = log10l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 10 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20
+ * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns MINLOG
+ * log domain: x < 0; returns MINLOG
+ */
+
+/*
+Cephes Math Library Release 2.2: January, 1991
+Copyright 1984, 1991 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include <math.h>
+static char fname[] = {"log10l"};
+
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.2e-22
+ */
+#ifdef UNK
+static long double P[] = {
+ 4.9962495940332550844739E-1L,
+ 1.0767376367209449010438E1L,
+ 7.7671073698359539859595E1L,
+ 2.5620629828144409632571E2L,
+ 4.2401812743503691187826E2L,
+ 3.4258224542413922935104E2L,
+ 1.0747524399916215149070E2L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 2.3479774160285863271658E1L,
+ 1.9444210022760132894510E2L,
+ 7.7952888181207260646090E2L,
+ 1.6911722418503949084863E3L,
+ 2.0307734695595183428202E3L,
+ 1.2695660352705325274404E3L,
+ 3.2242573199748645407652E2L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0xfe72,0xce22,0xd7b9,0xffce,0x3ffd, XPD
+0xb778,0x0e34,0x2c71,0xac47,0x4002, XPD
+0xea8b,0xc751,0x96f8,0x9b57,0x4005, XPD
+0xfeaf,0x6a02,0x67fb,0x801a,0x4007, XPD
+0x6b5a,0xf252,0x51ff,0xd402,0x4007, XPD
+0x39ce,0x9f76,0x8704,0xab4a,0x4007, XPD
+0x1b39,0x740b,0x532e,0xd6f3,0x4005, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x2f3a,0xbf26,0x93d5,0xbbd6,0x4003, XPD
+0x13c8,0x031a,0x2d7b,0xc271,0x4006, XPD
+0x449d,0x1993,0xd933,0xc2e1,0x4008, XPD
+0x5b65,0x574e,0x8301,0xd365,0x4009, XPD
+0xa65d,0x3bd2,0xc043,0xfdd8,0x4009, XPD
+0x3b21,0xffea,0x1cf5,0x9eb2,0x4009, XPD
+0x545c,0xd708,0x7e62,0xa136,0x4007, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ffd0000,0xffced7b9,0xce22fe72,
+0x40020000,0xac472c71,0x0e34b778,
+0x40050000,0x9b5796f8,0xc751ea8b,
+0x40070000,0x801a67fb,0x6a02feaf,
+0x40070000,0xd40251ff,0xf2526b5a,
+0x40070000,0xab4a8704,0x9f7639ce,
+0x40050000,0xd6f3532e,0x740b1b39,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40030000,0xbbd693d5,0xbf262f3a,
+0x40060000,0xc2712d7b,0x031a13c8,
+0x40080000,0xc2e1d933,0x1993449d,
+0x40090000,0xd3658301,0x574e5b65,
+0x40090000,0xfdd8c043,0x3bd2a65d,
+0x40090000,0x9eb21cf5,0xffea3b21,
+0x40070000,0xa1367e62,0xd708545c,
+};
+#endif
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+
+#ifdef UNK
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+/* log10(2) */
+#define L102A 0.3125L
+#define L102B -1.1470004336018804786261e-2L
+/* log10(e) */
+#define L10EA 0.5L
+#define L10EB -6.5705518096748172348871e-2L
+#endif
+#ifdef IBMPC
+static short R[] = {
+0x6ef4,0xf922,0x7763,0x817b,0x3ff6, XPD
+0x15fd,0x1af9,0xde8f,0xb84b,0xbffe, XPD
+0x8b96,0x4f8d,0xa53c,0xac6f,0x4002, XPD
+0x8932,0xb4e3,0xe8ae,0x8ede,0xc004, XPD
+};
+static short S[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x7ce4,0x1fc9,0xbdc5,0xd19b,0xc003, XPD
+0x0af3,0x0d10,0x716f,0xc19e,0x4006, XPD
+0x4d7d,0x0f55,0x5d06,0xd64e,0xc007, XPD
+};
+static short LG102A[] = {0x0000,0x0000,0x0000,0xa000,0x3ffd, XPD};
+#define L102A *(long double *)LG102A
+static short LG102B[] = {0x0cee,0x8601,0xaf60,0xbbec,0xbff8, XPD};
+#define L102B *(long double *)LG102B
+static short LG10EA[] = {0x0000,0x0000,0x0000,0x8000,0x3ffe, XPD};
+#define L10EA *(long double *)LG10EA
+static short LG10EB[] = {0x39ab,0x235e,0x9d5b,0x8690,0xbffb, XPD};
+#define L10EB *(long double *)LG10EB
+#endif
+
+#ifdef MIEEE
+static long R[12] = {
+0x3ff60000,0x817b7763,0xf9226ef4,
+0xbffe0000,0xb84bde8f,0x1af915fd,
+0x40020000,0xac6fa53c,0x4f8d8b96,
+0xc0040000,0x8edee8ae,0xb4e38932,
+};
+static long S[9] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0030000,0xd19bbdc5,0x1fc97ce4,
+0x40060000,0xc19e716f,0x0d100af3,
+0xc0070000,0xd64e5d06,0x0f554d7d,
+};
+static long LG102A[] = {0x3ffd0000,0xa0000000,0x00000000};
+#define L102A *(long double *)LG102A
+static long LG102B[] = {0xbff80000,0xbbecaf60,0x86010cee};
+#define L102B *(long double *)LG102B
+static long LG10EA[] = {0x3ffe0000,0x80000000,0x00000000};
+#define L10EA *(long double *)LG10EA
+static long LG10EB[] = {0xbffb0000,0x86909d5b,0x235e39ab};
+#define L10EB *(long double *)LG10EB
+#endif
+
+
+#define SQRTH 0.70710678118654752440L
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+#else
+long double frexpl(), ldexpl(), polevll(), p1evll(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double log10l(x)
+long double x;
+{
+long double y;
+VOLATILE long double z;
+int e;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0L )
+ {
+ if( x == 0.0L )
+ {
+ mtherr( fname, SING );
+#ifdef INFINITIES
+ return(-INFINITYL);
+#else
+ return( -4.9314733889673399399914e3L );
+#endif
+ }
+ else
+ {
+ mtherr( fname, DOMAIN );
+#ifdef NANS
+ return(NANL);
+#else
+ return( -4.9314733889673399399914e3L );
+#endif
+ }
+ }
+#ifdef INFINITIES
+if( x == INFINITYL )
+ return(INFINITYL);
+#endif
+/* separate mantissa from exponent */
+
+/* Note, frexp is used so that denormal numbers
+ * will be handled properly.
+ */
+x = frexpl( x, &e );
+
+
+/* logarithm using log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/x+1)
+ */
+if( (e > 2) || (e < -2) )
+{
+if( x < SQRTH )
+ { /* 2( 2x-1 )/( 2x+1 ) */
+ e -= 1;
+ z = x - 0.5L;
+ y = 0.5L * z + 0.5L;
+ }
+else
+ { /* 2 (x-1)/(x+1) */
+ z = x - 0.5L;
+ z -= 0.5L;
+ y = 0.5L * x + 0.5L;
+ }
+x = z / y;
+z = x*x;
+y = x * ( z * polevll( z, R, 3 ) / p1evll( z, S, 3 ) );
+goto done;
+}
+
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0L;
+ }
+z = x*x;
+y = x * ( z * polevll( x, P, 6 ) / p1evll( x, Q, 7 ) );
+y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */
+
+done:
+
+/* Multiply log of fraction by log10(e)
+ * and base 2 exponent by log10(2).
+ *
+ * ***CAUTION***
+ *
+ * This sequence of operations is critical and it may
+ * be horribly defeated by some compiler optimizers.
+ */
+z = y * (L10EB);
+z += x * (L10EB);
+z += e * (L102B);
+z += y * (L10EA);
+z += x * (L10EA);
+z += e * (L102A);
+
+return( z );
+}
diff --git a/libm/ldouble/log2l.c b/libm/ldouble/log2l.c
new file mode 100644
index 000000000..220b881ae
--- /dev/null
+++ b/libm/ldouble/log2l.c
@@ -0,0 +1,302 @@
+/* log2l.c
+ *
+ * Base 2 logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log2l();
+ *
+ * y = log2l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 2 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the (natural)
+ * logarithm of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20
+ * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITYL
+ * log domain: x < 0; returns NANL
+ */
+
+/*
+Cephes Math Library Release 2.8: May, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.2e-22
+ */
+#ifdef UNK
+static long double P[] = {
+ 4.9962495940332550844739E-1L,
+ 1.0767376367209449010438E1L,
+ 7.7671073698359539859595E1L,
+ 2.5620629828144409632571E2L,
+ 4.2401812743503691187826E2L,
+ 3.4258224542413922935104E2L,
+ 1.0747524399916215149070E2L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 2.3479774160285863271658E1L,
+ 1.9444210022760132894510E2L,
+ 7.7952888181207260646090E2L,
+ 1.6911722418503949084863E3L,
+ 2.0307734695595183428202E3L,
+ 1.2695660352705325274404E3L,
+ 3.2242573199748645407652E2L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0xfe72,0xce22,0xd7b9,0xffce,0x3ffd, XPD
+0xb778,0x0e34,0x2c71,0xac47,0x4002, XPD
+0xea8b,0xc751,0x96f8,0x9b57,0x4005, XPD
+0xfeaf,0x6a02,0x67fb,0x801a,0x4007, XPD
+0x6b5a,0xf252,0x51ff,0xd402,0x4007, XPD
+0x39ce,0x9f76,0x8704,0xab4a,0x4007, XPD
+0x1b39,0x740b,0x532e,0xd6f3,0x4005, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x2f3a,0xbf26,0x93d5,0xbbd6,0x4003, XPD
+0x13c8,0x031a,0x2d7b,0xc271,0x4006, XPD
+0x449d,0x1993,0xd933,0xc2e1,0x4008, XPD
+0x5b65,0x574e,0x8301,0xd365,0x4009, XPD
+0xa65d,0x3bd2,0xc043,0xfdd8,0x4009, XPD
+0x3b21,0xffea,0x1cf5,0x9eb2,0x4009, XPD
+0x545c,0xd708,0x7e62,0xa136,0x4007, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ffd0000,0xffced7b9,0xce22fe72,
+0x40020000,0xac472c71,0x0e34b778,
+0x40050000,0x9b5796f8,0xc751ea8b,
+0x40070000,0x801a67fb,0x6a02feaf,
+0x40070000,0xd40251ff,0xf2526b5a,
+0x40070000,0xab4a8704,0x9f7639ce,
+0x40050000,0xd6f3532e,0x740b1b39,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40030000,0xbbd693d5,0xbf262f3a,
+0x40060000,0xc2712d7b,0x031a13c8,
+0x40080000,0xc2e1d933,0x1993449d,
+0x40090000,0xd3658301,0x574e5b65,
+0x40090000,0xfdd8c043,0x3bd2a65d,
+0x40090000,0x9eb21cf5,0xffea3b21,
+0x40070000,0xa1367e62,0xd708545c,
+};
+#endif
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+#ifdef UNK
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+/* log2(e) - 1 */
+#define LOG2EA 4.4269504088896340735992e-1L
+#endif
+#ifdef IBMPC
+static short R[] = {
+0x6ef4,0xf922,0x7763,0x817b,0x3ff6, XPD
+0x15fd,0x1af9,0xde8f,0xb84b,0xbffe, XPD
+0x8b96,0x4f8d,0xa53c,0xac6f,0x4002, XPD
+0x8932,0xb4e3,0xe8ae,0x8ede,0xc004, XPD
+};
+static short S[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x7ce4,0x1fc9,0xbdc5,0xd19b,0xc003, XPD
+0x0af3,0x0d10,0x716f,0xc19e,0x4006, XPD
+0x4d7d,0x0f55,0x5d06,0xd64e,0xc007, XPD
+};
+static short LG2EA[] = {0xc2ef,0x705f,0xeca5,0xe2a8,0x3ffd, XPD};
+#define LOG2EA *(long double *)LG2EA
+#endif
+
+#ifdef MIEEE
+static long R[12] = {
+0x3ff60000,0x817b7763,0xf9226ef4,
+0xbffe0000,0xb84bde8f,0x1af915fd,
+0x40020000,0xac6fa53c,0x4f8d8b96,
+0xc0040000,0x8edee8ae,0xb4e38932,
+};
+static long S[9] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0030000,0xd19bbdc5,0x1fc97ce4,
+0x40060000,0xc19e716f,0x0d100af3,
+0xc0070000,0xd64e5d06,0x0f554d7d,
+};
+static long LG2EA[] = {0x3ffd0000,0xe2a8eca5,0x705fc2ef};
+#define LOG2EA *(long double *)LG2EA
+#endif
+
+
+#define SQRTH 0.70710678118654752440L
+extern long double MINLOGL;
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+#else
+long double frexpl(), ldexpl(), polevll(), p1evll();
+extern int isnanl ();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double log2l(x)
+long double x;
+{
+VOLATILE long double z;
+long double y;
+int e;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITYL )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0L )
+ {
+ if( x == 0.0L )
+ {
+#ifdef INFINITIES
+ return( -INFINITYL );
+#else
+ mtherr( "log2l", SING );
+ return( -16384.0L );
+#endif
+ }
+ else
+ {
+#ifdef NANS
+ return( NANL );
+#else
+ mtherr( "log2l", DOMAIN );
+ return( -16384.0L );
+#endif
+ }
+ }
+
+/* separate mantissa from exponent */
+
+/* Note, frexp is used so that denormal numbers
+ * will be handled properly.
+ */
+x = frexpl( x, &e );
+
+
+/* logarithm using log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/x+1)
+ */
+if( (e > 2) || (e < -2) )
+{
+if( x < SQRTH )
+ { /* 2( 2x-1 )/( 2x+1 ) */
+ e -= 1;
+ z = x - 0.5L;
+ y = 0.5L * z + 0.5L;
+ }
+else
+ { /* 2 (x-1)/(x+1) */
+ z = x - 0.5L;
+ z -= 0.5L;
+ y = 0.5L * x + 0.5L;
+ }
+x = z / y;
+z = x*x;
+y = x * ( z * polevll( z, R, 3 ) / p1evll( z, S, 3 ) );
+goto done;
+}
+
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0L;
+ }
+z = x*x;
+y = x * ( z * polevll( x, P, 6 ) / p1evll( x, Q, 7 ) );
+y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */
+
+done:
+
+/* Multiply log of fraction by log2(e)
+ * and base 2 exponent by 1
+ *
+ * ***CAUTION***
+ *
+ * This sequence of operations is critical and it may
+ * be horribly defeated by some compiler optimizers.
+ */
+z = y * LOG2EA;
+z += x * LOG2EA;
+z += y;
+z += x;
+z += e;
+return( z );
+}
+
diff --git a/libm/ldouble/logl.c b/libm/ldouble/logl.c
new file mode 100644
index 000000000..d6367eb19
--- /dev/null
+++ b/libm/ldouble/logl.c
@@ -0,0 +1,292 @@
+/* logl.c
+ *
+ * Natural logarithm, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, logl();
+ *
+ * y = logl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20
+ * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITYL
+ * log domain: x < 0; returns NANL
+ */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1990, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 2.32e-20
+ */
+#ifdef UNK
+static long double P[] = {
+ 4.5270000862445199635215E-5L,
+ 4.9854102823193375972212E-1L,
+ 6.5787325942061044846969E0L,
+ 2.9911919328553073277375E1L,
+ 6.0949667980987787057556E1L,
+ 5.7112963590585538103336E1L,
+ 2.0039553499201281259648E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 1.5062909083469192043167E1L,
+ 8.3047565967967209469434E1L,
+ 2.2176239823732856465394E2L,
+ 3.0909872225312059774938E2L,
+ 2.1642788614495947685003E2L,
+ 6.0118660497603843919306E1L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0x51b9,0x9cae,0x4b15,0xbde0,0x3ff0, XPD
+0x19cf,0xf0d4,0xc507,0xff40,0x3ffd, XPD
+0x9942,0xa7d2,0xfa37,0xd284,0x4001, XPD
+0x4add,0x65ce,0x9c5c,0xef4b,0x4003, XPD
+0x8445,0x619a,0x75c3,0xf3cc,0x4004, XPD
+0x81ab,0x3cd0,0xacba,0xe473,0x4004, XPD
+0x4cbf,0xcc18,0x016c,0xa051,0x4003, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0xb8b7,0x81f1,0xacf4,0xf101,0x4002, XPD
+0xbc31,0x09a4,0x5a91,0xa618,0x4005, XPD
+0xaeec,0xe7da,0x2c87,0xddc3,0x4006, XPD
+0x2bde,0x4845,0xa2ee,0x9a8c,0x4007, XPD
+0x3120,0x4703,0x89f2,0xd86d,0x4006, XPD
+0x7347,0x3224,0x8223,0xf079,0x4004, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ff00000,0xbde04b15,0x9cae51b9,
+0x3ffd0000,0xff40c507,0xf0d419cf,
+0x40010000,0xd284fa37,0xa7d29942,
+0x40030000,0xef4b9c5c,0x65ce4add,
+0x40040000,0xf3cc75c3,0x619a8445,
+0x40040000,0xe473acba,0x3cd081ab,
+0x40030000,0xa051016c,0xcc184cbf,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40020000,0xf101acf4,0x81f1b8b7,
+0x40050000,0xa6185a91,0x09a4bc31,
+0x40060000,0xddc32c87,0xe7daaeec,
+0x40070000,0x9a8ca2ee,0x48452bde,
+0x40060000,0xd86d89f2,0x47033120,
+0x40040000,0xf0798223,0x32247347,
+};
+#endif
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+
+#ifdef UNK
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+static long double C1 = 6.9314575195312500000000E-1L;
+static long double C2 = 1.4286068203094172321215E-6L;
+#endif
+#ifdef IBMPC
+static short R[] = {
+0x6ef4,0xf922,0x7763,0x817b,0x3ff6, XPD
+0x15fd,0x1af9,0xde8f,0xb84b,0xbffe, XPD
+0x8b96,0x4f8d,0xa53c,0xac6f,0x4002, XPD
+0x8932,0xb4e3,0xe8ae,0x8ede,0xc004, XPD
+};
+static short S[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x7ce4,0x1fc9,0xbdc5,0xd19b,0xc003, XPD
+0x0af3,0x0d10,0x716f,0xc19e,0x4006, XPD
+0x4d7d,0x0f55,0x5d06,0xd64e,0xc007, XPD
+};
+static short sc1[] = {0x0000,0x0000,0x0000,0xb172,0x3ffe, XPD};
+#define C1 (*(long double *)sc1)
+static short sc2[] = {0x4f1e,0xcd5e,0x8e7b,0xbfbe,0x3feb, XPD};
+#define C2 (*(long double *)sc2)
+#endif
+#ifdef MIEEE
+static long R[12] = {
+0x3ff60000,0x817b7763,0xf9226ef4,
+0xbffe0000,0xb84bde8f,0x1af915fd,
+0x40020000,0xac6fa53c,0x4f8d8b96,
+0xc0040000,0x8edee8ae,0xb4e38932,
+};
+static long S[9] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0030000,0xd19bbdc5,0x1fc97ce4,
+0x40060000,0xc19e716f,0x0d100af3,
+0xc0070000,0xd64e5d06,0x0f554d7d,
+};
+static long sc1[] = {0x3ffe0000,0xb1720000,0x00000000};
+#define C1 (*(long double *)sc1)
+static long sc2[] = {0x3feb0000,0xbfbe8e7b,0xcd5e4f1e};
+#define C2 (*(long double *)sc2)
+#endif
+
+
+#define SQRTH 0.70710678118654752440L
+extern long double MINLOGL;
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern int isnanl ( long double );
+#else
+long double frexpl(), ldexpl(), polevll(), p1evll(), isnanl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double logl(x)
+long double x;
+{
+long double y, z;
+int e;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITYL )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0L )
+ {
+ if( x == 0.0L )
+ {
+#ifdef INFINITIES
+ return( -INFINITYL );
+#else
+ mtherr( "logl", SING );
+ return( MINLOGL );
+#endif
+ }
+ else
+ {
+#ifdef NANS
+ return( NANL );
+#else
+ mtherr( "logl", DOMAIN );
+ return( MINLOGL );
+#endif
+ }
+ }
+
+/* separate mantissa from exponent */
+
+/* Note, frexp is used so that denormal numbers
+ * will be handled properly.
+ */
+x = frexpl( x, &e );
+
+/* logarithm using log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/x+1)
+ */
+if( (e > 2) || (e < -2) )
+{
+if( x < SQRTH )
+ { /* 2( 2x-1 )/( 2x+1 ) */
+ e -= 1;
+ z = x - 0.5L;
+ y = 0.5L * z + 0.5L;
+ }
+else
+ { /* 2 (x-1)/(x+1) */
+ z = x - 0.5L;
+ z -= 0.5L;
+ y = 0.5L * x + 0.5L;
+ }
+x = z / y;
+z = x*x;
+z = x * ( z * polevll( z, R, 3 ) / p1evll( z, S, 3 ) );
+z = z + e * C2;
+z = z + x;
+z = z + e * C1;
+return( z );
+}
+
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0L;
+ }
+z = x*x;
+y = x * ( z * polevll( x, P, 6 ) / p1evll( x, Q, 6 ) );
+y = y + e * C2;
+z = y - ldexpl( z, -1 ); /* y - 0.5 * z */
+/* Note, the sum of above terms does not exceed x/4,
+ * so it contributes at most about 1/4 lsb to the error.
+ */
+z = z + x;
+z = z + e * C1; /* This sum has an error of 1/2 lsb. */
+return( z );
+}
diff --git a/libm/ldouble/lparanoi.c b/libm/ldouble/lparanoi.c
new file mode 100644
index 000000000..eb8fd25c7
--- /dev/null
+++ b/libm/ldouble/lparanoi.c
@@ -0,0 +1,2348 @@
+/* A C version of Kahan's Floating Point Test "Paranoia"
+
+ Thos Sumner, UCSF, Feb. 1985
+ David Gay, BTL, Jan. 1986
+
+ This is a rewrite from the Pascal version by
+
+ B. A. Wichmann, 18 Jan. 1985
+
+ (and does NOT exhibit good C programming style).
+
+(C) Apr 19 1983 in BASIC version by:
+ Professor W. M. Kahan,
+ 567 Evans Hall
+ Electrical Engineering & Computer Science Dept.
+ University of California
+ Berkeley, California 94720
+ USA
+
+converted to Pascal by:
+ B. A. Wichmann
+ National Physical Laboratory
+ Teddington Middx
+ TW11 OLW
+ UK
+
+converted to C by:
+
+ David M. Gay and Thos Sumner
+ AT&T Bell Labs Computer Center, Rm. U-76
+ 600 Mountainn Avenue University of California
+ Murray Hill, NJ 07974 San Francisco, CA 94143
+ USA USA
+
+with simultaneous corrections to the Pascal source (reflected
+in the Pascal source available over netlib).
+
+Reports of results on various systems from all the versions
+of Paranoia are being collected by Richard Karpinski at the
+same address as Thos Sumner. This includes sample outputs,
+bug reports, and criticisms.
+
+You may copy this program freely if you acknowledge its source.
+Comments on the Pascal version to NPL, please.
+
+
+The C version catches signals from floating-point exceptions.
+If signal(SIGFPE,...) is unavailable in your environment, you may
+#define NOSIGNAL to comment out the invocations of signal.
+
+This source file is too big for some C compilers, but may be split
+into pieces. Comments containing "SPLIT" suggest convenient places
+for this splitting. At the end of these comments is an "ed script"
+(for the UNIX(tm) editor ed) that will do this splitting.
+
+By #defining Single when you compile this source, you may obtain
+a single-precision C version of Paranoia.
+
+
+The following is from the introductory commentary from Wichmann's work:
+
+The BASIC program of Kahan is written in Microsoft BASIC using many
+facilities which have no exact analogy in Pascal. The Pascal
+version below cannot therefore be exactly the same. Rather than be
+a minimal transcription of the BASIC program, the Pascal coding
+follows the conventional style of block-structured languages. Hence
+the Pascal version could be useful in producing versions in other
+structured languages.
+
+Rather than use identifiers of minimal length (which therefore have
+little mnemonic significance), the Pascal version uses meaningful
+identifiers as follows [Note: A few changes have been made for C]:
+
+
+BASIC C BASIC C BASIC C
+
+ A J S StickyBit
+ A1 AInverse J0 NoErrors T
+ B Radix [Failure] T0 Underflow
+ B1 BInverse J1 NoErrors T2 ThirtyTwo
+ B2 RadixD2 [SeriousDefect] T5 OneAndHalf
+ B9 BMinusU2 J2 NoErrors T7 TwentySeven
+ C [Defect] T8 TwoForty
+ C1 CInverse J3 NoErrors U OneUlp
+ D [Flaw] U0 UnderflowThreshold
+ D4 FourD K PageNo U1
+ E0 L Milestone U2
+ E1 M V
+ E2 Exp2 N V0
+ E3 N1 V8
+ E5 MinSqEr O Zero V9
+ E6 SqEr O1 One W
+ E7 MaxSqEr O2 Two X
+ E8 O3 Three X1
+ E9 O4 Four X8
+ F1 MinusOne O5 Five X9 Random1
+ F2 Half O8 Eight Y
+ F3 Third O9 Nine Y1
+ F6 P Precision Y2
+ F9 Q Y9 Random2
+ G1 GMult Q8 Z
+ G2 GDiv Q9 Z0 PseudoZero
+ G3 GAddSub R Z1
+ H R1 RMult Z2
+ H1 HInverse R2 RDiv Z9
+ I R3 RAddSub
+ IO NoTrials R4 RSqrt
+ I3 IEEE R9 Random9
+
+ SqRWrng
+
+All the variables in BASIC are true variables and in consequence,
+the program is more difficult to follow since the "constants" must
+be determined (the glossary is very helpful). The Pascal version
+uses Real constants, but checks are added to ensure that the values
+are correctly converted by the compiler.
+
+The major textual change to the Pascal version apart from the
+identifiersis that named procedures are used, inserting parameters
+wherehelpful. New procedures are also introduced. The
+correspondence is as follows:
+
+
+BASIC Pascal
+lines
+
+ 90- 140 Pause
+ 170- 250 Instructions
+ 380- 460 Heading
+ 480- 670 Characteristics
+ 690- 870 History
+2940-2950 Random
+3710-3740 NewD
+4040-4080 DoesYequalX
+4090-4110 PrintIfNPositive
+4640-4850 TestPartialUnderflow
+
+=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
+
+Below is an "ed script" that splits para.c into 10 files
+of the form part[1-8].c, subs.c, and msgs.c, plus a header
+file, paranoia.h, that these files require.
+r paranoia.c
+$
+?SPLIT
++,$w msgs.c
+.,$d
+?SPLIT
+.d
++d
+-,$w subs.c
+-,$d
+?part8
++d
+?include
+.,$w part8.c
+.,$d
+-d
+?part7
++d
+?include
+.,$w part7.c
+.,$d
+-d
+?part6
++d
+?include
+.,$w part6.c
+.,$d
+-d
+?part5
++d
+?include
+.,$w part5.c
+.,$d
+-d
+?part4
++d
+?include
+.,$w part4.c
+.,$d
+-d
+?part3
++d
+?include
+.,$w part3.c
+.,$d
+-d
+?part2
++d
+?include
+.,$w part2.c
+.,$d
+?SPLIT
+.d
+1,/^#include/-1d
+1,$w part1.c
+/Computed constants/,$d
+1,$s/^int/extern &/
+1,$s/^FLOAT/extern &/
+1,$s! = .*!;!
+/^Guard/,/^Round/s/^/extern /
+/^jmp_buf/s/^/extern /
+/^Sig_type/s/^/extern /
+a
+extern int sigfpe();
+.
+w paranoia.h
+q
+
+*/
+
+#include <stdio.h>
+#ifndef NOSIGNAL
+#include <signal.h>
+#endif
+#include <setjmp.h>
+
+#define Ldouble
+/*#define Single*/
+
+#ifdef Single
+#define NPRT 2
+extern double fabs(), floor(), log(), pow(), sqrt();
+#define FLOAT float
+#define FABS(x) (float)fabs((double)(x))
+#define FLOOR(x) (float)floor((double)(x))
+#define LOG(x) (float)log((double)(x))
+#define POW(x,y) (float)pow((double)(x),(double)(y))
+#define SQRT(x) (float)sqrt((double)(x))
+#define FSETUP sprec
+/*sprec() { }*/
+#else
+#ifdef Ldouble
+#define NPRT 6
+extern long double fabsl(), floorl(), logl(), powl(), sqrtl();
+#define FLOAT long double
+#define FABS(x) fabsl(x)
+#define FLOOR(x) floorl(x)
+#define LOG(x) logl(x)
+#define POW(x,y) powl(x,y)
+#define SQRT(x) sqrtl(x)
+#define FSETUP ldprec
+#else
+#define NPRT 4
+extern double fabs(), floor(), log(), pow(), sqrt();
+#define FLOAT double
+#define FABS(x) fabs(x)
+#define FLOOR(x) floor(x)
+#define LOG(x) log(x)
+#define POW(x,y) pow(x,y)
+#define SQRT(x) sqrt(x)
+/*double __sqrtdf2();
+#define SQRT(x) __sqrtdf2(x)
+*/
+#define FSETUP dprec
+/* dprec() { } */
+#endif
+#endif
+
+jmp_buf ovfl_buf;
+typedef int (*Sig_type)();
+Sig_type sigsave;
+
+#define KEYBOARD 0
+
+FLOAT Radix, BInvrse, RadixD2, BMinusU2;
+FLOAT Sign(), Random();
+
+/*Small floating point constants.*/
+FLOAT Zero = 0.0;
+FLOAT Half = 0.5;
+FLOAT One = 1.0;
+FLOAT Two = 2.0;
+FLOAT Three = 3.0;
+FLOAT Four = 4.0;
+FLOAT Five = 5.0;
+FLOAT Eight = 8.0;
+FLOAT Nine = 9.0;
+FLOAT TwentySeven = 27.0;
+FLOAT ThirtyTwo = 32.0;
+FLOAT TwoForty = 240.0;
+FLOAT MinusOne = -1.0;
+FLOAT OneAndHalf = 1.5;
+/*Integer constants*/
+int NoTrials = 20; /*Number of tests for commutativity. */
+#define False 0
+#define True 1
+
+/* Definitions for declared types
+ Guard == (Yes, No);
+ Rounding == (Chopped, Rounded, Other);
+ Message == packed array [1..40] of char;
+ Class == (Flaw, Defect, Serious, Failure);
+ */
+#define Yes 1
+#define No 0
+#define Chopped 2
+#define Rounded 1
+#define Other 0
+#define Flaw 3
+#define Defect 2
+#define Serious 1
+#define Failure 0
+typedef int Guard, Rounding, Class;
+typedef char Message;
+
+/* Declarations of Variables */
+int Indx;
+char ch[8];
+FLOAT AInvrse, A1;
+FLOAT C, CInvrse;
+FLOAT D, FourD;
+static FLOAT E0, E1, Exp2, E3, MinSqEr;
+FLOAT SqEr, MaxSqEr, E9;
+FLOAT Third;
+FLOAT F6, F9;
+FLOAT H, HInvrse;
+int I;
+FLOAT StickyBit, J;
+FLOAT MyZero;
+FLOAT Precision;
+FLOAT Q, Q9;
+FLOAT R, Random9;
+FLOAT T, Underflow, S;
+FLOAT OneUlp, UfThold, U1, U2;
+FLOAT V, V0, V9;
+FLOAT W;
+FLOAT X, X1, X2, X8, Random1;
+static FLOAT Y, Y1, Y2, Random2;
+FLOAT Z, PseudoZero, Z1, Z2, Z9;
+int ErrCnt[4];
+int fpecount;
+int Milestone;
+int PageNo;
+int M, N, N1;
+Guard GMult, GDiv, GAddSub;
+Rounding RMult, RDiv, RAddSub, RSqrt;
+int Break, Done, NotMonot, Monot, Anomaly, IEEE,
+ SqRWrng, UfNGrad;
+/* Computed constants. */
+/*U1 gap below 1.0, i.e, 1.0-U1 is next number below 1.0 */
+/*U2 gap above 1.0, i.e, 1.0+U2 is next number above 1.0 */
+
+/* floating point exception receiver */
+sigfpe()
+{
+ fpecount++;
+ printf("\n* * * FLOATING-POINT ERROR * * *\n");
+ fflush(stdout);
+ if (sigsave) {
+#ifndef NOSIGNAL
+ signal(SIGFPE, sigsave);
+#endif
+ sigsave = 0;
+ longjmp(ovfl_buf, 1);
+ }
+ abort();
+}
+
+
+FLOAT Ptemp;
+
+pnum( x )
+FLOAT *x;
+{
+char str[30];
+double d;
+unsigned short *p;
+int i;
+
+p = (unsigned short *)x;
+for( i=0; i<NPRT; i++ )
+ printf( "%04x ", *p++ & 0xffff );
+#ifdef Ldouble
+e64toasc( x, str, 20 );
+#else
+#ifdef Single
+e24toasc( x, str, 20 );
+#else
+e53toasc( x, str, 20 );
+#endif
+#endif
+printf( " = %s\n", str );
+/*
+d = *x;
+printf( " = %.16e\n", d );
+*/
+}
+
+
+
+main()
+{
+/* noexcept(); */
+ FSETUP();
+ /* First two assignments use integer right-hand sides. */
+ Zero = 0;
+ One = 1;
+ Two = One + One;
+ Three = Two + One;
+ Four = Three + One;
+ Five = Four + One;
+ Eight = Four + Four;
+ Nine = Three * Three;
+ TwentySeven = Nine * Three;
+ ThirtyTwo = Four * Eight;
+ TwoForty = Four * Five * Three * Four;
+ MinusOne = -One;
+ Half = One / Two;
+ OneAndHalf = One + Half;
+ ErrCnt[Failure] = 0;
+ ErrCnt[Serious] = 0;
+ ErrCnt[Defect] = 0;
+ ErrCnt[Flaw] = 0;
+ PageNo = 1;
+ /*=============================================*/
+ Milestone = 0;
+ /*=============================================*/
+#ifndef NOSIGNAL
+ signal(SIGFPE, sigfpe);
+#endif
+ Instructions();
+ Pause();
+ Heading();
+ Pause();
+ Characteristics();
+ Pause();
+ History();
+ Pause();
+ /*=============================================*/
+ Milestone = 7;
+ /*=============================================*/
+ printf("Program is now RUNNING tests on small integers:\n");
+
+ TstCond (Failure, (Zero + Zero == Zero) && (One - One == Zero)
+ && (One > Zero) && (One + One == Two),
+ "0+0 != 0, 1-1 != 0, 1 <= 0, or 1+1 != 2");
+ Z = - Zero;
+ if (Z == 0.0) {
+ U1 = 0.001;
+ Radix = 1;
+ TstPtUf();
+ }
+ else {
+ ErrCnt[Failure] = ErrCnt[Failure] + 1;
+ printf("Comparison alleges that -0.0 is Non-zero!\n");
+ }
+ TstCond (Failure, (Three == Two + One) && (Four == Three + One)
+ && (Four + Two * (- Two) == Zero)
+ && (Four - Three - One == Zero),
+ "3 != 2+1, 4 != 3+1, 4+2*(-2) != 0, or 4-3-1 != 0");
+ TstCond (Failure, (MinusOne == (0 - One))
+ && (MinusOne + One == Zero ) && (One + MinusOne == Zero)
+ && (MinusOne + FABS(One) == Zero)
+ && (MinusOne + MinusOne * MinusOne == Zero),
+ "-1+1 != 0, (-1)+abs(1) != 0, or -1+(-1)*(-1) != 0");
+ TstCond (Failure, Half + MinusOne + Half == Zero,
+ "1/2 + (-1) + 1/2 != 0");
+ /*=============================================*/
+ /*SPLIT
+ part2();
+ part3();
+ part4();
+ part5();
+ part6();
+ part7();
+ part8();
+ }
+#include "paranoia.h"
+part2(){
+*/
+ Milestone = 10;
+ /*=============================================*/
+ TstCond (Failure, (Nine == Three * Three)
+ && (TwentySeven == Nine * Three) && (Eight == Four + Four)
+ && (ThirtyTwo == Eight * Four)
+ && (ThirtyTwo - TwentySeven - Four - One == Zero),
+ "9 != 3*3, 27 != 9*3, 32 != 8*4, or 32-27-4-1 != 0");
+ TstCond (Failure, (Five == Four + One) &&
+ (TwoForty == Four * Five * Three * Four)
+ && (TwoForty / Three - Four * Four * Five == Zero)
+ && ( TwoForty / Four - Five * Three * Four == Zero)
+ && ( TwoForty / Five - Four * Three * Four == Zero),
+ "5 != 4+1, 240/3 != 80, 240/4 != 60, or 240/5 != 48");
+ if (ErrCnt[Failure] == 0) {
+ printf("-1, 0, 1/2, 1, 2, 3, 4, 5, 9, 27, 32 & 240 are O.K.\n");
+ printf("\n");
+ }
+ printf("Searching for Radix and Precision.\n");
+ W = One;
+ do {
+ W = W + W;
+ Y = W + One;
+ Z = Y - W;
+ Y = Z - One;
+ } while (MinusOne + FABS(Y) < Zero);
+ /*.. now W is just big enough that |((W+1)-W)-1| >= 1 ...*/
+ Precision = Zero;
+ Y = One;
+ do {
+ Radix = W + Y;
+ Y = Y + Y;
+ Radix = Radix - W;
+ } while ( Radix == Zero);
+ if (Radix < Two) Radix = One;
+ printf("Radix = " );
+ pnum( &Radix );
+ if (Radix != 1) {
+ W = One;
+ do {
+ Precision = Precision + One;
+ W = W * Radix;
+ Y = W + One;
+ } while ((Y - W) == One);
+ }
+ /*... now W == Radix^Precision is barely too big to satisfy (W+1)-W == 1
+ ...*/
+ U1 = One / W;
+ U2 = Radix * U1;
+ printf("Closest relative separation found is U1 = " );
+ pnum( &U1 );
+ printf("U2 = ");
+ pnum( &U2 );
+ printf("Recalculating radix and precision.");
+
+ /*save old values*/
+ E0 = Radix;
+ E1 = U1;
+ E9 = U2;
+ E3 = Precision;
+
+ X = Four / Three;
+ Third = X - One;
+ F6 = Half - Third;
+ X = F6 + F6;
+ X = FABS(X - Third);
+ if (X < U2) X = U2;
+
+ /*... now X = (unknown no.) ulps of 1+...*/
+ do {
+ U2 = X;
+ Y = Half * U2 + ThirtyTwo * U2 * U2;
+ Y = One + Y;
+ X = Y - One;
+ } while ( ! ((U2 <= X) || (X <= Zero)));
+
+ /*... now U2 == 1 ulp of 1 + ... */
+ X = Two / Three;
+ F6 = X - Half;
+ Third = F6 + F6;
+ X = Third - Half;
+ X = FABS(X + F6);
+ if (X < U1) X = U1;
+
+ /*... now X == (unknown no.) ulps of 1 -... */
+ do {
+ U1 = X;
+ Y = Half * U1 + ThirtyTwo * U1 * U1;
+ Y = Half - Y;
+ X = Half + Y;
+ Y = Half - X;
+ X = Half + Y;
+ } while ( ! ((U1 <= X) || (X <= Zero)));
+ /*... now U1 == 1 ulp of 1 - ... */
+ if (U1 == E1) printf("confirms closest relative separation U1 .\n");
+ else
+ {
+ printf("gets better closest relative separation U1 = " );
+ pnum( &U1 );
+ }
+ W = One / U1;
+ F9 = (Half - U1) + Half;
+ Radix = FLOOR(0.01 + U2 / U1);
+ if (Radix == E0) printf("Radix confirmed.\n");
+ else
+ {
+ printf("MYSTERY: recalculated Radix = " );
+ pnum( &Radix );
+ }
+ TstCond (Defect, Radix <= Eight + Eight,
+ "Radix is too big: roundoff problems");
+ TstCond (Flaw, (Radix == Two) || (Radix == 10)
+ || (Radix == One), "Radix is not as good as 2 or 10");
+ /*=============================================*/
+ Milestone = 20;
+ /*=============================================*/
+ TstCond (Failure, F9 - Half < Half,
+ "(1-U1)-1/2 < 1/2 is FALSE, prog. fails?");
+ X = F9;
+ I = 1;
+ Y = X - Half;
+ Z = Y - Half;
+ TstCond (Failure, (X != One)
+ || (Z == Zero), "Comparison is fuzzy,X=1 but X-1/2-1/2 != 0");
+ X = One + U2;
+ I = 0;
+ /*=============================================*/
+ Milestone = 25;
+ /*=============================================*/
+ /*... BMinusU2 = nextafter(Radix, 0) */
+ BMinusU2 = Radix - One;
+ BMinusU2 = (BMinusU2 - U2) + One;
+ /* Purify Integers */
+ if (Radix != One) {
+ X = - TwoForty * LOG(U1) / LOG(Radix);
+ Y = FLOOR(Half + X);
+ if (FABS(X - Y) * Four < One) X = Y;
+ Precision = X / TwoForty;
+ Y = FLOOR(Half + Precision);
+ if (FABS(Precision - Y) * TwoForty < Half) Precision = Y;
+ }
+ if ((Precision != FLOOR(Precision)) || (Radix == One)) {
+ printf("Precision cannot be characterized by an Integer number\n");
+ printf("of significant digits but, by itself, this is a minor flaw.\n");
+ }
+ if (Radix == One)
+ printf("logarithmic encoding has precision characterized solely by U1.\n");
+ else
+ {
+ printf("The number of significant digits of the Radix is " );
+ pnum( &Precision );
+ }
+ TstCond (Serious, U2 * Nine * Nine * TwoForty < One,
+ "Precision worse than 5 decimal figures ");
+ /*=============================================*/
+ Milestone = 30;
+ /*=============================================*/
+ /* Test for extra-precise subepressions */
+ X = FABS(((Four / Three - One) - One / Four) * Three - One / Four);
+ do {
+ Z2 = X;
+ X = (One + (Half * Z2 + ThirtyTwo * Z2 * Z2)) - One;
+ } while ( ! ((Z2 <= X) || (X <= Zero)));
+ X = Y = Z = FABS((Three / Four - Two / Three) * Three - One / Four);
+ do {
+ Z1 = Z;
+ Z = (One / Two - ((One / Two - (Half * Z1 + ThirtyTwo * Z1 * Z1))
+ + One / Two)) + One / Two;
+ } while ( ! ((Z1 <= Z) || (Z <= Zero)));
+ do {
+ do {
+ Y1 = Y;
+ Y = (Half - ((Half - (Half * Y1 + ThirtyTwo * Y1 * Y1)) + Half
+ )) + Half;
+ } while ( ! ((Y1 <= Y) || (Y <= Zero)));
+ X1 = X;
+ X = ((Half * X1 + ThirtyTwo * X1 * X1) - F9) + F9;
+ } while ( ! ((X1 <= X) || (X <= Zero)));
+ if ((X1 != Y1) || (X1 != Z1)) {
+ BadCond(Serious, "Disagreements among the values X1, Y1, Z1,\n");
+ printf("respectively " );
+ pnum( &X1 );
+ pnum( &Y1 );
+ pnum( &Z1 );
+ printf("are symptoms of inconsistencies introduced\n");
+ printf("by extra-precise evaluation of arithmetic subexpressions.\n");
+ notify("Possibly some part of this");
+ if ((X1 == U1) || (Y1 == U1) || (Z1 == U1)) printf(
+ "That feature is not tested further by this program.\n") ;
+ }
+ else {
+ if ((Z1 != U1) || (Z2 != U2)) {
+ if ((Z1 >= U1) || (Z2 >= U2)) {
+ BadCond(Failure, "");
+ notify("Precision");
+ printf("\tU1 = " );
+ pnum( &U1 );
+ printf( "Z1 - U1 = " );
+ Ptemp = Z1-U1;
+ pnum( &Ptemp );
+ printf("\tU2 = " );
+ pnum( &U2 );
+ Ptemp = Z2-U2;
+ printf( "Z2 - U2 = " );
+ pnum( &Ptemp );
+ }
+ else {
+ if ((Z1 <= Zero) || (Z2 <= Zero)) {
+ printf("Because of unusual Radix = ");
+ pnum( &Radix );
+ printf(", or exact rational arithmetic a result\n");
+ printf("Z1 = " );
+ pnum( &Z1 );
+ printf( "or Z2 = " );
+ pnum( &Z2 );
+ notify("of an\nextra-precision");
+ }
+ if (Z1 != Z2 || Z1 > Zero) {
+ X = Z1 / U1;
+ Y = Z2 / U2;
+ if (Y > X) X = Y;
+ Q = - LOG(X);
+ printf("Some subexpressions appear to be calculated extra\n");
+ printf("precisely with about" );
+ Ptemp = Q / LOG(Radix);
+ pnum( &Ptemp );
+ printf( "extra B-digits, i.e.\n" );
+ Ptemp = Q / LOG(10.);
+ printf("roughly " );
+ pnum( &Ptemp );
+ printf( "extra significant decimals.\n");
+ }
+ printf("That feature is not tested further by this program.\n");
+ }
+ }
+ }
+ Pause();
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part3(){
+*/
+ Milestone = 35;
+ /*=============================================*/
+ if (Radix >= Two) {
+ X = W / (Radix * Radix);
+ Y = X + One;
+ Z = Y - X;
+ T = Z + U2;
+ X = T - Z;
+ TstCond (Failure, X == U2,
+ "Subtraction is not normalized X=Y,X+Z != Y+Z!");
+ if (X == U2) printf(
+ "Subtraction appears to be normalized, as it should be.");
+ }
+ printf("\nChecking for guard digit in *, /, and -.\n");
+ Y = F9 * One;
+ Z = One * F9;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ Z = (Z - Half) - X;
+ X = One + U2;
+ T = X * Radix;
+ R = Radix * X;
+ X = T - Radix;
+ X = X - Radix * U2;
+ T = R - Radix;
+ T = T - Radix * U2;
+ X = X * (Radix - One);
+ T = T * (Radix - One);
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)) GMult = Yes;
+ else {
+ GMult = No;
+ TstCond (Serious, False,
+ "* lacks a Guard Digit, so 1*X != X");
+ }
+ Z = Radix * U2;
+ X = One + Z;
+ Y = FABS((X + Z) - X * X) - U2;
+ X = One - U2;
+ Z = FABS((X - U2) - X * X) - U1;
+ TstCond (Failure, (Y <= Zero)
+ && (Z <= Zero), "* gets too many final digits wrong.\n");
+ Y = One - U2;
+ X = One + U2;
+ Z = One / Y;
+ Y = Z - X;
+ X = One / Three;
+ Z = Three / Nine;
+ X = X - Z;
+ T = Nine / TwentySeven;
+ Z = Z - T;
+ TstCond(Defect, X == Zero && Y == Zero && Z == Zero,
+ "Division lacks a Guard Digit, so error can exceed 1 ulp\n\
+or 1/3 and 3/9 and 9/27 may disagree");
+ Y = F9 / One;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ X = One + U2;
+ T = X / One;
+ X = T - X;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero)) GDiv = Yes;
+ else {
+ GDiv = No;
+ TstCond (Serious, False,
+ "Division lacks a Guard Digit, so X/1 != X");
+ }
+ X = One / (One + U2);
+ Y = X - Half - Half;
+ TstCond (Serious, Y < Zero,
+ "Computed value of 1/1.000..1 >= 1");
+ X = One - U2;
+ Y = One + Radix * U2;
+ Z = X * Radix;
+ T = Y * Radix;
+ R = Z / Radix;
+ StickyBit = T / Radix;
+ X = R - X;
+ Y = StickyBit - Y;
+ TstCond (Failure, X == Zero && Y == Zero,
+ "* and/or / gets too many last digits wrong");
+ Y = One - U1;
+ X = One - F9;
+ Y = One - Y;
+ T = Radix - U2;
+ Z = Radix - BMinusU2;
+ T = Radix - T;
+ if ((X == U1) && (Y == U1) && (Z == U2) && (T == U2)) GAddSub = Yes;
+ else {
+ GAddSub = No;
+ TstCond (Serious, False,
+ "- lacks Guard Digit, so cancellation is obscured");
+ }
+ if (F9 != One && F9 - One >= Zero) {
+ BadCond(Serious, "comparison alleges (1-U1) < 1 although\n");
+ printf(" subtration yields (1-U1) - 1 = 0 , thereby vitiating\n");
+ printf(" such precautions against division by zero as\n");
+ printf(" ... if (X == 1.0) {.....} else {.../(X-1.0)...}\n");
+ }
+ if (GMult == Yes && GDiv == Yes && GAddSub == Yes) printf(
+ " *, /, and - appear to have guard digits, as they should.\n");
+ /*=============================================*/
+ Milestone = 40;
+ /*=============================================*/
+ Pause();
+ printf("Checking rounding on multiply, divide and add/subtract.\n");
+ RMult = Other;
+ RDiv = Other;
+ RAddSub = Other;
+ RadixD2 = Radix / Two;
+ A1 = Two;
+ Done = False;
+ do {
+ AInvrse = Radix;
+ do {
+ X = AInvrse;
+ AInvrse = AInvrse / A1;
+ } while ( ! (FLOOR(AInvrse) != AInvrse));
+ Done = (X == One) || (A1 > Three);
+ if (! Done) A1 = Nine + One;
+ } while ( ! (Done));
+ if (X == One) A1 = Radix;
+ AInvrse = One / A1;
+ X = A1;
+ Y = AInvrse;
+ Done = False;
+ do {
+ Z = X * Y - Half;
+ TstCond (Failure, Z == Half,
+ "X * (1/X) differs from 1");
+ Done = X == Radix;
+ X = Radix;
+ Y = One / X;
+ } while ( ! (Done));
+ Y2 = One + U2;
+ Y1 = One - U2;
+ X = OneAndHalf - U2;
+ Y = OneAndHalf + U2;
+ Z = (X - U2) * Y2;
+ T = Y * Y1;
+ Z = Z - X;
+ T = T - X;
+ X = X * Y2;
+ Y = (Y + U2) * Y1;
+ X = X - OneAndHalf;
+ Y = Y - OneAndHalf;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T <= Zero)) {
+ printf("Y2 = ");
+ pnum( &Y2 );
+ printf("Y1 = ");
+ pnum( &Y1 );
+ printf("U2 = ");
+ pnum( &U2 );
+ X = (OneAndHalf + U2) * Y2;
+ Y = OneAndHalf - U2 - U2;
+ Z = OneAndHalf + U2 + U2;
+ T = (OneAndHalf - U2) * Y1;
+ X = X - (Z + U2);
+ StickyBit = Y * Y1;
+ S = Z * Y2;
+ T = T - Y;
+ Y = (U2 - Y) + StickyBit;
+ Z = S - (Z + U2 + U2);
+ StickyBit = (Y2 + U2) * Y1;
+ Y1 = Y2 * Y1;
+ StickyBit = StickyBit - Y2;
+ Y1 = Y1 - Half;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && ( StickyBit == Zero) && (Y1 == Half)) {
+ RMult = Rounded;
+ printf("Multiplication appears to round correctly.\n");
+ }
+ else if ((X + U2 == Zero) && (Y < Zero) && (Z + U2 == Zero)
+ && (T < Zero) && (StickyBit + U2 == Zero)
+ && (Y1 < Half)) {
+ RMult = Chopped;
+ printf("Multiplication appears to chop.\n");
+ }
+ else printf("* is neither chopped nor correctly rounded.\n");
+ if ((RMult == Rounded) && (GMult == No)) notify("Multiplication");
+ }
+ else printf("* is neither chopped nor correctly rounded.\n");
+ /*=============================================*/
+ Milestone = 45;
+ /*=============================================*/
+ Y2 = One + U2;
+ Y1 = One - U2;
+ Z = OneAndHalf + U2 + U2;
+ X = Z / Y2;
+ T = OneAndHalf - U2 - U2;
+ Y = (T - U2) / Y1;
+ Z = (Z + U2) / Y2;
+ X = X - OneAndHalf;
+ Y = Y - T;
+ T = T / Y1;
+ Z = Z - (OneAndHalf + U2);
+ T = (U2 - OneAndHalf) + T;
+ if (! ((X > Zero) || (Y > Zero) || (Z > Zero) || (T > Zero))) {
+ X = OneAndHalf / Y2;
+ Y = OneAndHalf - U2;
+ Z = OneAndHalf + U2;
+ X = X - Y;
+ T = OneAndHalf / Y1;
+ Y = Y / Y1;
+ T = T - (Z + U2);
+ Y = Y - Z;
+ Z = Z / Y2;
+ Y1 = (Y2 + U2) / Y2;
+ Z = Z - OneAndHalf;
+ Y2 = Y1 - Y2;
+ Y1 = (F9 - U1) / F9;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && (Y2 == Zero) && (Y2 == Zero)
+ && (Y1 - Half == F9 - Half )) {
+ RDiv = Rounded;
+ printf("Division appears to round correctly.\n");
+ if (GDiv == No) notify("Division");
+ }
+ else if ((X < Zero) && (Y < Zero) && (Z < Zero) && (T < Zero)
+ && (Y2 < Zero) && (Y1 - Half < F9 - Half)) {
+ RDiv = Chopped;
+ printf("Division appears to chop.\n");
+ }
+ }
+ if (RDiv == Other) printf("/ is neither chopped nor correctly rounded.\n");
+ BInvrse = One / Radix;
+ TstCond (Failure, (BInvrse * Radix - Half == Half),
+ "Radix * ( 1 / Radix ) differs from 1");
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part4(){
+*/
+ Milestone = 50;
+ /*=============================================*/
+ TstCond (Failure, ((F9 + U1) - Half == Half)
+ && ((BMinusU2 + U2 ) - One == Radix - One),
+ "Incomplete carry-propagation in Addition");
+ X = One - U1 * U1;
+ Y = One + U2 * (One - U2);
+ Z = F9 - Half;
+ X = (X - Half) - Z;
+ Y = Y - One;
+ if ((X == Zero) && (Y == Zero)) {
+ RAddSub = Chopped;
+ printf("Add/Subtract appears to be chopped.\n");
+ }
+ if (GAddSub == Yes) {
+ X = (Half + U2) * U2;
+ Y = (Half - U2) * U2;
+ X = One + X;
+ Y = One + Y;
+ X = (One + U2) - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero)) {
+ X = (Half + U2) * U1;
+ Y = (Half - U2) * U1;
+ X = One - X;
+ Y = One - Y;
+ X = F9 - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero)) {
+ RAddSub = Rounded;
+ printf("Addition/Subtraction appears to round correctly.\n");
+ if (GAddSub == No) notify("Add/Subtract");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ S = One;
+ X = One + Half * (One + Half);
+ Y = (One + U2) * Half;
+ Z = X - Y;
+ T = Y - X;
+ StickyBit = Z + T;
+ if (StickyBit != Zero) {
+ S = Zero;
+ BadCond(Flaw, "(X - Y) + (Y - X) is non zero!\n");
+ }
+ StickyBit = Zero;
+ if ((GMult == Yes) && (GDiv == Yes) && (GAddSub == Yes)
+ && (RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (FLOOR(RadixD2) == RadixD2)) {
+ printf("Checking for sticky bit.\n");
+ X = (Half + U1) * U2;
+ Y = Half * U2;
+ Z = One + Y;
+ T = One + X;
+ if ((Z - One <= Zero) && (T - One >= U2)) {
+ Z = T + Y;
+ Y = Z - X;
+ if ((Z - T >= U2) && (Y - T == Zero)) {
+ X = (Half + U1) * U1;
+ Y = Half * U1;
+ Z = One - Y;
+ T = One - X;
+ if ((Z - One == Zero) && (T - F9 == Zero)) {
+ Z = (Half - U1) * U1;
+ T = F9 - Z;
+ Q = F9 - Y;
+ if ((T - F9 == Zero) && (F9 - U1 - Q == Zero)) {
+ Z = (One + U2) * OneAndHalf;
+ T = (OneAndHalf + U2) - Z + U2;
+ X = One + Half / Radix;
+ Y = One + Radix * U2;
+ Z = X * Y;
+ if (T == Zero && X + Radix * U2 - Z == Zero) {
+ if (Radix != Two) {
+ X = Two + U2;
+ Y = X / Two;
+ if ((Y - One == Zero)) StickyBit = S;
+ }
+ else StickyBit = S;
+ }
+ }
+ }
+ }
+ }
+ }
+ if (StickyBit == One) printf("Sticky bit apparently used correctly.\n");
+ else printf("Sticky bit used incorrectly or not at all.\n");
+ TstCond (Flaw, !(GMult == No || GDiv == No || GAddSub == No ||
+ RMult == Other || RDiv == Other || RAddSub == Other),
+ "lack(s) of guard digits or failure(s) to correctly round or chop\n\
+(noted above) count as one flaw in the final tally below");
+ /*=============================================*/
+ Milestone = 60;
+ /*=============================================*/
+ printf("\n");
+ printf("Does Multiplication commute? ");
+ printf("Testing on %d random pairs.\n", NoTrials);
+ Ptemp = 3.0;
+ Random9 = SQRT(Ptemp);
+ Random1 = Third;
+ I = 1;
+ do {
+ X = Random();
+ Y = Random();
+ Z9 = Y * X;
+ Z = X * Y;
+ Z9 = Z - Z9;
+ I = I + 1;
+ } while ( ! ((I > NoTrials) || (Z9 != Zero)));
+ if (I == NoTrials) {
+ Random1 = One + Half / Three;
+ Random2 = (U2 + U1) + One;
+ Z = Random1 * Random2;
+ Y = Random2 * Random1;
+ Z9 = (One + Half / Three) * ((U2 + U1) + One) - (One + Half /
+ Three) * ((U2 + U1) + One);
+ }
+ if (! ((I == NoTrials) || (Z9 == Zero)))
+ BadCond(Defect, "X * Y == Y * X trial fails.\n");
+ else printf(" No failures found in %d integer pairs.\n", NoTrials);
+ /*=============================================*/
+ Milestone = 70;
+ /*=============================================*/
+ printf("\nRunning test of square root(x).\n");
+ TstCond (Failure, (Zero == SQRT(Zero))
+ && (- Zero == SQRT(- Zero))
+ && (One == SQRT(One)), "Square root of 0.0, -0.0 or 1.0 wrong");
+ MinSqEr = Zero;
+ MaxSqEr = Zero;
+ J = Zero;
+ X = Radix;
+ OneUlp = U2;
+ SqXMinX (Serious);
+ X = BInvrse;
+ OneUlp = BInvrse * U1;
+ SqXMinX (Serious);
+ X = U1;
+ OneUlp = U1 * U1;
+ SqXMinX (Serious);
+ if (J != Zero) Pause();
+ printf("Testing if sqrt(X * X) == X for %d Integers X.\n", NoTrials);
+ J = Zero;
+ X = Two;
+ Y = Radix;
+ if ((Radix != One)) do {
+ X = Y;
+ Y = Radix * Y;
+ } while ( ! ((Y - X >= NoTrials)));
+ OneUlp = X * U2;
+ I = 1;
+ while (I < 10) {
+ X = X + One;
+ SqXMinX (Defect);
+ if (J > Zero) break;
+ I = I + 1;
+ }
+ printf("Test for sqrt monotonicity.\n");
+ I = - 1;
+ X = BMinusU2;
+ Y = Radix;
+ Z = Radix + Radix * U2;
+ NotMonot = False;
+ Monot = False;
+ while ( ! (NotMonot || Monot)) {
+ I = I + 1;
+ X = SQRT(X);
+ Q = SQRT(Y);
+ Z = SQRT(Z);
+ if ((X > Q) || (Q > Z)) NotMonot = True;
+ else {
+ Q = FLOOR(Q + Half);
+ if ((I > 0) || (Radix == Q * Q)) Monot = True;
+ else if (I > 0) {
+ if (I > 1) Monot = True;
+ else {
+ Y = Y * BInvrse;
+ X = Y - U1;
+ Z = Y + U1;
+ }
+ }
+ else {
+ Y = Q;
+ X = Y - U2;
+ Z = Y + U2;
+ }
+ }
+ }
+ if (Monot) printf("sqrt has passed a test for Monotonicity.\n");
+ else {
+ BadCond(Defect, "");
+ printf("sqrt(X) is non-monotonic for X near " );
+ pnum( &Y );
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part5(){
+*/
+ Milestone = 80;
+ /*=============================================*/
+ MinSqEr = MinSqEr + Half;
+ MaxSqEr = MaxSqEr - Half;
+ Y = (SQRT(One + U2) - One) / U2;
+ SqEr = (Y - One) + U2 / Eight;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ SqEr = Y + U2 / Eight;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ Y = ((SQRT(F9) - U2) - (One - U2)) / U1;
+ SqEr = Y + U1 / Eight;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ SqEr = (Y + One) + U1 / Eight;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ OneUlp = U2;
+ X = OneUlp;
+ for( Indx = 1; Indx <= 3; ++Indx) {
+ Y = SQRT((X + U1 + X) + F9);
+ Y = ((Y - U2) - ((One - U2) + X)) / OneUlp;
+ Z = ((U1 - X) + F9) * Half * X * X / OneUlp;
+ SqEr = (Y + Half) + Z;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ SqEr = (Y - Half) + Z;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ if (((Indx == 1) || (Indx == 3)))
+ X = OneUlp * Sign (X) * FLOOR(Eight / (Nine * SQRT(OneUlp)));
+ else {
+ OneUlp = U1;
+ X = - OneUlp;
+ }
+ }
+ /*=============================================*/
+ Milestone = 85;
+ /*=============================================*/
+ SqRWrng = False;
+ Anomaly = False;
+ if (Radix != One) {
+ printf("Testing whether sqrt is rounded or chopped.\n");
+ D = FLOOR(Half + POW(Radix, One + Precision - FLOOR(Precision)));
+ /* ... == Radix^(1 + fract) if (Precision == Integer + fract. */
+ X = D / Radix;
+ Y = D / A1;
+ if ((X != FLOOR(X)) || (Y != FLOOR(Y))) {
+ Anomaly = True;
+ }
+ else {
+ X = Zero;
+ Z2 = X;
+ Y = One;
+ Y2 = Y;
+ Z1 = Radix - One;
+ FourD = Four * D;
+ do {
+ if (Y2 > Z2) {
+ Q = Radix;
+ Y1 = Y;
+ do {
+ X1 = FABS(Q + FLOOR(Half - Q / Y1) * Y1);
+ Q = Y1;
+ Y1 = X1;
+ } while ( ! (X1 <= Zero));
+ if (Q <= One) {
+ Z2 = Y2;
+ Z = Y;
+ }
+ }
+ Y = Y + Two;
+ X = X + Eight;
+ Y2 = Y2 + X;
+ if (Y2 >= FourD) Y2 = Y2 - FourD;
+ } while ( ! (Y >= D));
+ X8 = FourD - Z2;
+ Q = (X8 + Z * Z) / FourD;
+ X8 = X8 / Eight;
+ if (Q != FLOOR(Q)) Anomaly = True;
+ else {
+ Break = False;
+ do {
+ X = Z1 * Z;
+ X = X - FLOOR(X / Radix) * Radix;
+ if (X == One)
+ Break = True;
+ else
+ Z1 = Z1 - One;
+ } while ( ! (Break || (Z1 <= Zero)));
+ if ((Z1 <= Zero) && (! Break)) Anomaly = True;
+ else {
+ if (Z1 > RadixD2) Z1 = Z1 - Radix;
+ do {
+ NewD();
+ } while ( ! (U2 * D >= F9));
+ if (D * Radix - D != W - D) Anomaly = True;
+ else {
+ Z2 = D;
+ I = 0;
+ Y = D + (One + Z) * Half;
+ X = D + Z + Q;
+ SR3750();
+ Y = D + (One - Z) * Half + D;
+ X = D - Z + D;
+ X = X + Q + X;
+ SR3750();
+ NewD();
+ if (D - Z2 != W - Z2) Anomaly = True;
+ else {
+ Y = (D - Z2) + (Z2 + (One - Z) * Half);
+ X = (D - Z2) + (Z2 - Z + Q);
+ SR3750();
+ Y = (One + Z) * Half;
+ X = Q;
+ SR3750();
+ if (I == 0) Anomaly = True;
+ }
+ }
+ }
+ }
+ }
+ if ((I == 0) || Anomaly) {
+ BadCond(Failure, "Anomalous arithmetic with Integer < ");
+ printf("Radix^Precision = " );
+ pnum( &W );
+ printf(" fails test whether sqrt rounds or chops.\n");
+ SqRWrng = True;
+ }
+ }
+ if (! Anomaly) {
+ if (! ((MinSqEr < Zero) || (MaxSqEr > Zero))) {
+ RSqrt = Rounded;
+ printf("Square root appears to be correctly rounded.\n");
+ }
+ else {
+ if ((MaxSqEr + U2 > U2 - Half) || (MinSqEr > Half)
+ || (MinSqEr + Radix < Half)) SqRWrng = True;
+ else {
+ RSqrt = Chopped;
+ printf("Square root appears to be chopped.\n");
+ }
+ }
+ }
+ if (SqRWrng) {
+ printf("Square root is neither chopped nor correctly rounded.\n");
+ printf("Observed errors run from " );
+ Ptemp = MinSqEr - Half;
+ pnum( &Ptemp );
+ printf("to %.7e ulps.\n");
+ Ptemp = Half + MaxSqEr;
+ pnum( &Ptemp );
+ TstCond (Serious, MaxSqEr - MinSqEr < Radix * Radix,
+ "sqrt gets too many last digits wrong");
+ }
+ /*=============================================*/
+ Milestone = 90;
+ /*=============================================*/
+ Pause();
+ printf("Testing powers Z^i for small Integers Z and i.\n");
+ N = 0;
+ /* ... test powers of zero. */
+ I = 0;
+ Z = -Zero;
+ M = 3.0;
+ Break = False;
+ do {
+ X = One;
+ SR3980();
+ if (I <= 10) {
+ I = 1023;
+ SR3980();
+ }
+ if (Z == MinusOne) Break = True;
+ else {
+ Z = MinusOne;
+ PrintIfNPositive();
+ N = 0;
+ /* .. if(-1)^N is invalid, replace MinusOne by One. */
+ I = - 4;
+ }
+ } while ( ! Break);
+ PrintIfNPositive();
+ N1 = N;
+ N = 0;
+ Z = A1;
+ M = FLOOR(Two * LOG(W) / LOG(A1));
+ Break = False;
+ do {
+ X = Z;
+ I = 1;
+ SR3980();
+ if (Z == AInvrse) Break = True;
+ else Z = AInvrse;
+ } while ( ! (Break));
+ /*=============================================*/
+ Milestone = 100;
+ /*=============================================*/
+ /* Powers of Radix have been tested, */
+ /* next try a few primes */
+ M = NoTrials;
+ Z = Three;
+ do {
+ X = Z;
+ I = 1;
+ SR3980();
+ do {
+ Z = Z + Two;
+ } while ( Three * FLOOR(Z / Three) == Z );
+ } while ( Z < Eight * Three );
+ if (N > 0) {
+ printf("Errors like this may invalidate financial calculations\n");
+ printf("\tinvolving interest rates.\n");
+ }
+ PrintIfNPositive();
+ N += N1;
+ if (N == 0) printf("... no discrepancis found.\n");
+ if (N > 0) Pause();
+ else printf("\n");
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part6(){
+*/
+ Milestone = 110;
+ /*=============================================*/
+ printf("Seeking Underflow thresholds UfThold and E0.\n");
+ D = U1;
+ if (Precision != FLOOR(Precision)) {
+ D = BInvrse;
+ X = Precision;
+ do {
+ D = D * BInvrse;
+ X = X - One;
+ } while ( X > Zero);
+ }
+ Y = One;
+ Z = D;
+ /* ... D is power of 1/Radix < 1. */
+ do {
+ C = Y;
+ Y = Z;
+ Z = Y * Y;
+ } while ((Y > Z) && (Z + Z > Z));
+ Y = C;
+ Z = Y * D;
+ do {
+ C = Y;
+ Y = Z;
+ Z = Y * D;
+ } while ((Y > Z) && (Z + Z > Z));
+ if (Radix < Two) HInvrse = Two;
+ else HInvrse = Radix;
+ H = One / HInvrse;
+ /* ... 1/HInvrse == H == Min(1/Radix, 1/2) */
+ CInvrse = One / C;
+ E0 = C;
+ Z = E0 * H;
+ /* ...1/Radix^(BIG Integer) << 1 << CInvrse == 1/C */
+ do {
+ Y = E0;
+ E0 = Z;
+ Z = E0 * H;
+ } while ((E0 > Z) && (Z + Z > Z));
+ UfThold = E0;
+ E1 = Zero;
+ Q = Zero;
+ E9 = U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C) {
+ E9 = Radix * U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C) {
+ BadCond(Failure, "multiplication gets too many last digits wrong.\n");
+ Underflow = E0;
+ Y1 = Zero;
+ PseudoZero = Z;
+ Pause();
+ }
+ }
+ else {
+ Underflow = D;
+ PseudoZero = Underflow * H;
+ UfThold = Zero;
+ do {
+ Y1 = Underflow;
+ Underflow = PseudoZero;
+ if (E1 + E1 <= E1) {
+ Y2 = Underflow * HInvrse;
+ E1 = FABS(Y1 - Y2);
+ Q = Y1;
+ if ((UfThold == Zero) && (Y1 != Y2)) UfThold = Y1;
+ }
+ PseudoZero = PseudoZero * H;
+ } while ((Underflow > PseudoZero)
+ && (PseudoZero + PseudoZero > PseudoZero));
+ }
+ /* Comment line 4530 .. 4560 */
+ if (PseudoZero != Zero) {
+ printf("\n");
+ Z = PseudoZero;
+ /* ... Test PseudoZero for "phoney- zero" violates */
+ /* ... PseudoZero < Underflow or PseudoZero < PseudoZero + PseudoZero
+ ... */
+ if (PseudoZero <= Zero) {
+ BadCond(Failure, "Positive expressions can underflow to an\n");
+ printf("allegedly negative value\n");
+ printf("PseudoZero that prints out as: " );
+ pnum( &PseudoZero );
+ X = - PseudoZero;
+ if (X <= Zero) {
+ printf("But -PseudoZero, which should be\n");
+ printf("positive, isn't; it prints out as " );
+ pnum( &X );
+ }
+ }
+ else {
+ BadCond(Flaw, "Underflow can stick at an allegedly positive\n");
+ printf("value PseudoZero that prints out as ");
+ pnum( &PseudoZero );
+ }
+ TstPtUf();
+ }
+ /*=============================================*/
+ Milestone = 120;
+ /*=============================================*/
+ if (CInvrse * Y > CInvrse * Y1) {
+ S = H * S;
+ E0 = Underflow;
+ }
+ if (! ((E1 == Zero) || (E1 == E0))) {
+ BadCond(Defect, "");
+ if (E1 < E0) {
+ printf("Products underflow at a higher");
+ printf(" threshold than differences.\n");
+ if (PseudoZero == Zero)
+ E0 = E1;
+ }
+ else {
+ printf("Difference underflows at a higher");
+ printf(" threshold than products.\n");
+ }
+ }
+ printf("Smallest strictly positive number found is E0 = ");
+ Pause();
+ pnum( &E0 );
+ Z = E0;
+ TstPtUf();
+ Underflow = E0;
+ if (N == 1) Underflow = Y;
+ I = 4;
+ if (E1 == Zero) I = 3;
+ if (UfThold == Zero) I = I - 2;
+ UfNGrad = True;
+ switch (I) {
+ case 1:
+ UfThold = Underflow;
+ if ((CInvrse * Q) != ((CInvrse * Y) * S)) {
+ UfThold = Y;
+ BadCond(Failure, "Either accuracy deteriorates as numbers\n");
+ printf("approach a threshold = ");
+ pnum( &UfThold );
+ printf(" coming down from " );
+ pnum( &C );
+ printf(" or else multiplication gets too many last digits wrong.\n");
+ }
+ Pause();
+ break;
+
+ case 2:
+ BadCond(Failure, "Underflow confuses Comparison which alleges that\n");
+ printf("Q == Y while denying that |Q - Y| == 0; these values\n");
+ printf("print out as Q = " );
+ pnum( &Q );
+ printf( "Y = " );
+ pnum( &Y );
+ printf ("|Q - Y| = " );
+ Ptemp = FABS(Q - Y2);
+ pnum( &Ptemp );
+ UfThold = Q;
+ break;
+
+ case 3:
+ X = X;
+ break;
+
+ case 4:
+ if ((Q == UfThold) && (E1 == E0)
+ && (FABS( UfThold - E1 / E9) <= E1)) {
+ UfNGrad = False;
+ printf("Underflow is gradual; it incurs Absolute Error =\n");
+ printf("(roundoff in UfThold) < E0.\n");
+ Y = E0 * CInvrse;
+ Y = Y * (OneAndHalf + U2);
+ X = CInvrse * (One + U2);
+ Y = Y / X;
+ IEEE = (Y == E0);
+ }
+ }
+ if (UfNGrad) {
+ printf("\n");
+ R = SQRT(Underflow / UfThold);
+ if (R <= H) {
+ Z = R * UfThold;
+ X = Z * (One + R * H * (One + H));
+ }
+ else {
+ Z = UfThold;
+ X = Z * (One + H * H * (One + H));
+ }
+ if (! ((X == Z) || (X - Z != Zero))) {
+ BadCond(Flaw, "");
+ printf("X = " );
+ pnum( &X );
+ printf( "is not equal to Z = ");
+ pnum( &Z );
+ Z9 = X - Z;
+ printf("yet X - Z yields " );
+ pnum( &Z9 );
+ printf(" Should this NOT signal Underflow, ");
+ printf("this is a SERIOUS DEFECT\nthat causes ");
+ printf("confusion when innocent statements like\n");;
+ printf(" if (X == Z) ... else");
+ printf(" ... (f(X) - f(Z)) / (X - Z) ...\n");
+ printf("encounter Division by Zero although actually\n");
+ printf("X / Z = 1 + ");
+ Ptemp = (X / Z - Half) - Half;
+ pnum( &Ptemp );
+ }
+ }
+ printf("The Underflow threshold is ");
+ pnum( &UfThold );
+ printf("below which calculation may suffer larger Relative error than ");
+ printf("merely roundoff.\n");
+ Y2 = U1 * U1;
+ Y = Y2 * Y2;
+ Y2 = Y * U1;
+ if (Y2 <= UfThold) {
+ if (Y > E0) {
+ BadCond(Defect, "");
+ I = 5;
+ }
+ else {
+ BadCond(Serious, "");
+ I = 4;
+ }
+ printf("Range is too narrow; U1^%d Underflows.\n", I);
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part7(){
+*/
+ Milestone = 130;
+ /*=============================================*/
+ Y = - FLOOR(Half - TwoForty * LOG(UfThold) / LOG(HInvrse)) / TwoForty;
+ Y2 = Y - One;
+ printf("Since underflow occurs below the threshold\n");
+ printf("UfThold = ");
+ pnum( &HInvrse );
+ printf( ") ^ (Y=" );
+ pnum( &Y );
+ printf( ")\nonly underflow " );
+ printf("should afflict the expression HInvrse^(Y+1).\n");
+ pnum( &HInvrse );
+ pnum( &Y2 );
+ V9 = POW(HInvrse, Y2);
+ printf("actually calculating yields: ");
+ pnum( &V9 );
+ if (! ((V9 >= Zero) && (V9 <= (Radix + Radix + E9) * UfThold))) {
+ BadCond(Serious, "this is not between 0 and underflow\n");
+ printf(" threshold = ");
+ pnum( &UfThold );
+ }
+ else if (! (V9 > UfThold * (One + E9)))
+ printf("This computed value is O.K.\n");
+ else {
+ BadCond(Defect, "this is not between 0 and underflow\n");
+ printf(" threshold = ");
+ pnum( &UfThold);
+ }
+ /*=============================================*/
+ Milestone = 140;
+ /*=============================================*/
+ printf("\n");
+ /* ...calculate Exp2 == exp(2) == 7.389056099... */
+ X = Zero;
+ I = 2;
+ Y = Two * Three;
+ Q = Zero;
+ N = 0;
+ do {
+ Z = X;
+ I = I + 1;
+ Y = Y / (I + I);
+ R = Y + Q;
+ X = Z + R;
+ Q = (Z - X) + R;
+ } while(X > Z);
+ Z = (OneAndHalf + One / Eight) + X / (OneAndHalf * ThirtyTwo);
+ X = Z * Z;
+ Exp2 = X * X;
+ X = F9;
+ Y = X - U1;
+ printf("Testing X^((X + 1) / (X - 1)) vs. exp(2) = ");
+ pnum( &Exp2 );
+ printf( "as X -> 1.\n");
+ for(I = 1;;) {
+ Z = X - BInvrse;
+ Z = (X + One) / (Z - (One - BInvrse));
+ Q = POW(X, Z) - Exp2;
+ if (FABS(Q) > TwoForty * U2) {
+ N = 1;
+ V9 = (X - BInvrse) - (One - BInvrse);
+ BadCond(Defect, "Calculated");
+ Ptemp = POW(X,Z);
+ pnum(&Ptemp);
+ printf("for (1 + (" );
+ pnum( &V9 );
+ printf( ") ^ (" );
+ pnum( &Z );
+ printf(") differs from correct value by ");
+ pnum( &Q );
+ printf("\tThis much error may spoil financial\n");
+ printf("\tcalculations involving tiny interest rates.\n");
+ break;
+ }
+ else {
+ Z = (Y - X) * Two + Y;
+ X = Y;
+ Y = Z;
+ Z = One + (X - F9)*(X - F9);
+ if (Z > One && I < NoTrials) I++;
+ else {
+ if (X > One) {
+ if (N == 0)
+ printf("Accuracy seems adequate.\n");
+ break;
+ }
+ else {
+ X = One + U2;
+ Y = U2 + U2;
+ Y += X;
+ I = 1;
+ }
+ }
+ }
+ }
+ /*=============================================*/
+ Milestone = 150;
+ /*=============================================*/
+ printf("Testing powers Z^Q at four nearly extreme values.\n");
+ N = 0;
+ Z = A1;
+ Q = FLOOR(Half - LOG(C) / LOG(A1));
+ Break = False;
+ do {
+ X = CInvrse;
+ Y = POW(Z, Q);
+ IsYeqX();
+ Q = - Q;
+ X = C;
+ Y = POW(Z, Q);
+ IsYeqX();
+ if (Z < One) Break = True;
+ else Z = AInvrse;
+ } while ( ! (Break));
+ PrintIfNPositive();
+ if (N == 0) printf(" ... no discrepancies found.\n");
+ printf("\n");
+
+ /*=============================================*/
+ Milestone = 160;
+ /*=============================================*/
+ Pause();
+ printf("Searching for Overflow threshold:\n");
+ printf("This may generate an error.\n");
+ sigsave = sigfpe;
+ I = 0;
+ Y = - CInvrse;
+ V9 = HInvrse * Y;
+ if (setjmp(ovfl_buf)) goto overflow;
+ do {
+ V = Y;
+ Y = V9;
+ V9 = HInvrse * Y;
+ } while(V9 < Y);
+ I = 1;
+overflow:
+ Z = V9;
+ printf("Can `Z = -Y' overflow?\n");
+ printf("Trying it on Y = " );
+ pnum( &Y );
+ V9 = - Y;
+ V0 = V9;
+ if (V - Y == V + V0) printf("Seems O.K.\n");
+ else {
+ printf("finds a ");
+ BadCond(Flaw, "-(-Y) differs from Y.\n");
+ }
+#if 0
+/* this doesn't handle infinity. */
+ if (Z != Y) {
+ BadCond(Serious, "");
+ printf("overflow past " );
+ pnum( &Y );
+ printf( "shrinks to " );
+ pnum( &Z );
+ }
+#endif
+ Y = V * (HInvrse * U2 - HInvrse);
+ Z = Y + ((One - HInvrse) * U2) * V;
+ if (Z < V0) Y = Z;
+ if (Y < V0) V = Y;
+ if (V0 - V < V0) V = V0;
+ printf("Overflow threshold is V = " );
+ pnum( &V );
+ if (I)
+ {
+ printf("Overflow saturates at V0 = " );
+ pnum( &V0 );
+ }
+ else printf("There is no saturation value because the system traps on overflow.\n");
+ V9 = V * One;
+ printf("No Overflow should be signaled for V * 1 = " );
+ pnum( &V9 );
+ V9 = V / One;
+ printf(" nor for V / 1 = " );
+ pnum( &V9 );
+ printf("Any overflow signal separating this * from the one\n");
+ printf("above is a DEFECT.\n");
+ /*=============================================*/
+ Milestone = 170;
+ /*=============================================*/
+ if (!(-V < V && -V0 < V0 && -UfThold < V && UfThold < V)) {
+ BadCond(Failure, "Comparisons involving ");
+ printf("+-" );
+ pnum( &V );
+ printf( ", +- " );
+ pnum( &V0 );
+ printf( "and +- " );
+ pnum( &UfThold );
+ printf( "are confused by Overflow." );
+ }
+ /*=============================================*/
+ Milestone = 175;
+ /*=============================================*/
+ printf("\n");
+ for(Indx = 1; Indx <= 3; ++Indx) {
+ switch (Indx) {
+ case 1: Z = UfThold; break;
+ case 2: Z = E0; break;
+ case 3: Z = PseudoZero; break;
+ }
+ if (Z != Zero) {
+ V9 = SQRT(Z);
+ Y = V9 * V9;
+ if (Y / (One - Radix * E9) < Z
+ || Y > (One + Radix + E9) * Z) {
+ if (V9 > U1) BadCond(Serious, "");
+ else BadCond(Defect, "");
+ printf("Comparison alleges that what prints as Z =" );
+ pnum( &Z );
+ printf(" is too far from sqrt(Z) ^ 2 = ");
+ pnum( &Y );
+ }
+ }
+ }
+ /*=============================================*/
+ Milestone = 180;
+ /*=============================================*/
+ for(Indx = 1; Indx <= 2; ++Indx) {
+ if (Indx == 1) Z = V;
+ else Z = V0;
+ V9 = SQRT(Z);
+ X = (One - Radix * E9) * V9;
+ V9 = V9 * X;
+ if (((V9 < (One - Two * Radix * E9) * Z) || (V9 > Z))) {
+ Y = V9;
+ if (X < W) BadCond(Serious, "");
+ else BadCond(Defect, "");
+ printf("Comparison alleges that Z = ");
+ pnum( &Z );
+ printf(" is too far from sqrt(Z) ^ 2 " );
+ pnum( &Y );
+ }
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part8(){
+*/
+ Milestone = 190;
+ /*=============================================*/
+ Pause();
+ X = UfThold * V;
+ Y = Radix * Radix;
+ if (X*Y < One || X > Y) {
+ if (X * Y < U1 || X > Y/U1) BadCond(Defect, "Badly");
+ else BadCond(Flaw, "");
+
+ printf(" unbalanced range; UfThold * V = " );
+ pnum( &X );
+ printf( "is too far from 1.\n");
+ }
+ /*=============================================*/
+ Milestone = 200;
+ /*=============================================*/
+ for (Indx = 1; Indx <= 5; ++Indx) {
+ X = F9;
+ switch (Indx) {
+ case 2: X = One + U2; break;
+ case 3: X = V; break;
+ case 4: X = UfThold; break;
+ case 5: X = Radix;
+ }
+ Y = X;
+ sigsave = sigfpe;
+ if (setjmp(ovfl_buf))
+ {
+ printf(" X / X traps when X = ");
+ pnum( &X );
+ }
+ else {
+ V9 = (Y / X - Half) - Half;
+ if (V9 == Zero) continue;
+ if (V9 == - U1 && Indx < 5) BadCond(Flaw, "");
+ else BadCond(Serious, "");
+ printf(" X / X differs from 1 when X =");
+ pnum( &X );
+ printf(" instead, X / X - 1/2 - 1/2 = ");
+ pnum( &V9 );
+ }
+ }
+ /*=============================================*/
+ Milestone = 210;
+ /*=============================================*/
+ MyZero = Zero;
+ printf("\n");
+ printf("What message and/or values does Division by Zero produce?\n") ;
+#ifndef NOPAUSE
+ printf("This can interupt your program. You can ");
+ printf("skip this part if you wish.\n");
+ printf("Do you wish to compute 1 / 0? ");
+ fflush(stdout);
+ read (KEYBOARD, ch, 8);
+ if ((ch[0] == 'Y') || (ch[0] == 'y')) {
+#endif
+ sigsave = sigfpe;
+ printf(" Trying to compute 1 / 0 produces ...");
+ if (!setjmp(ovfl_buf))
+ {
+ Ptemp = One / MyZero;
+ pnum( &Ptemp );
+ }
+#ifndef NOPAUSE
+ }
+ else printf("O.K.\n");
+ printf("\nDo you wish to compute 0 / 0? ");
+ fflush(stdout);
+ read (KEYBOARD, ch, 80);
+ if ((ch[0] == 'Y') || (ch[0] == 'y')) {
+#endif
+ sigsave = sigfpe;
+ printf("\n Trying to compute 0 / 0 produces ...");
+ if (!setjmp(ovfl_buf))
+ {
+ Ptemp = Zero / MyZero;
+ pnum( &Ptemp );
+ }
+#ifndef NOPAUSE
+ }
+ else printf("O.K.\n");
+#endif
+ /*=============================================*/
+ Milestone = 220;
+ /*=============================================*/
+ Pause();
+ printf("\n");
+ {
+ static char *msg[] = {
+ "FAILUREs encountered =",
+ "SERIOUS DEFECTs discovered =",
+ "DEFECTs discovered =",
+ "FLAWs discovered =" };
+ int i;
+ for(i = 0; i < 4; i++) if (ErrCnt[i])
+ printf("The number of %-29s %d.\n",
+ msg[i], ErrCnt[i]);
+ }
+ printf("\n");
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[Defect]
+ + ErrCnt[Flaw]) > 0) {
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[
+ Defect] == 0) && (ErrCnt[Flaw] > 0)) {
+ printf("The arithmetic diagnosed seems ");
+ printf("satisfactory though flawed.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious] == 0)
+ && ( ErrCnt[Defect] > 0)) {
+ printf("The arithmetic diagnosed may be acceptable\n");
+ printf("despite inconvenient Defects.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious]) > 0) {
+ printf("The arithmetic diagnosed has ");
+ printf("unacceptable serious defects.\n");
+ }
+ if (ErrCnt[Failure] > 0) {
+ printf("Fatal FAILURE may have spoiled this");
+ printf(" program's subsequent diagnoses.\n");
+ }
+ }
+ else {
+ printf("No failures, defects nor flaws have been discovered.\n");
+ if (! ((RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (RSqrt == Rounded)))
+ printf("The arithmetic diagnosed seems satisfactory.\n");
+ else {
+ if (StickyBit >= One &&
+ (Radix - Two) * (Radix - Nine - One) == Zero) {
+ printf("Rounding appears to conform to ");
+ printf("the proposed IEEE standard P");
+ if ((Radix == Two) &&
+ ((Precision - Four * Three * Two) *
+ ( Precision - TwentySeven -
+ TwentySeven + One) == Zero))
+ printf("754");
+ else printf("854");
+ if (IEEE) printf(".\n");
+ else {
+ printf(",\nexcept for possibly Double Rounding");
+ printf(" during Gradual Underflow.\n");
+ }
+ }
+ printf("The arithmetic diagnosed appears to be excellent!\n");
+ }
+ }
+ if (fpecount)
+ printf("\nA total of %d floating point exceptions were registered.\n",
+ fpecount);
+ printf("END OF TEST.\n");
+ }
+
+/*SPLIT subs.c
+#include "paranoia.h"
+*/
+
+/* Sign */
+
+FLOAT Sign (X)
+FLOAT X;
+{ return X >= 0. ? 1.0 : -1.0; }
+
+/* Pause */
+
+Pause()
+{
+ char ch[8];
+
+#ifndef NOPAUSE
+ printf("\nTo continue, press RETURN");
+ fflush(stdout);
+ read(KEYBOARD, ch, 8);
+#endif
+ printf("\nDiagnosis resumes after milestone Number %d", Milestone);
+ printf(" Page: %d\n\n", PageNo);
+ ++Milestone;
+ ++PageNo;
+ }
+
+ /* TstCond */
+
+TstCond (K, Valid, T)
+int K, Valid;
+char *T;
+{ if (! Valid) { BadCond(K,T); printf(".\n"); } }
+
+BadCond(K, T)
+int K;
+char *T;
+{
+ static char *msg[] = { "FAILURE", "SERIOUS DEFECT", "DEFECT", "FLAW" };
+
+ ErrCnt [K] = ErrCnt [K] + 1;
+ printf("%s: %s", msg[K], T);
+ }
+
+/* Random */
+/* Random computes
+ X = (Random1 + Random9)^5
+ Random1 = X - FLOOR(X) + 0.000005 * X;
+ and returns the new value of Random1
+*/
+
+FLOAT Random()
+{
+ FLOAT X, Y;
+
+ X = Random1 + Random9;
+ Y = X * X;
+ Y = Y * Y;
+ X = X * Y;
+ Y = X - FLOOR(X);
+ Random1 = Y + X * 0.000005;
+ return(Random1);
+ }
+
+/* SqXMinX */
+
+SqXMinX (ErrKind)
+int ErrKind;
+{
+ FLOAT XA, XB;
+
+ XB = X * BInvrse;
+ XA = X - XB;
+ SqEr = ((SQRT(X * X) - XB) - XA) / OneUlp;
+ if (SqEr != Zero) {
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ J = J + 1.0;
+ BadCond(ErrKind, "\n");
+ printf("sqrt( ");
+ Ptemp = X * X;
+ pnum( &Ptemp );
+ printf( ") - " );
+ pnum( &X );
+ printf(" = " );
+ Ptemp = OneUlp * SqEr;
+ pnum( &Ptemp );
+ printf("\tinstead of correct value 0 .\n");
+ }
+ }
+
+/* NewD */
+
+NewD()
+{
+ X = Z1 * Q;
+ X = FLOOR(Half - X / Radix) * Radix + X;
+ Q = (Q - X * Z) / Radix + X * X * (D / Radix);
+ Z = Z - Two * X * D;
+ if (Z <= Zero) {
+ Z = - Z;
+ Z1 = - Z1;
+ }
+ D = Radix * D;
+ }
+
+/* SR3750 */
+
+SR3750()
+{
+ if (! ((X - Radix < Z2 - Radix) || (X - Z2 > W - Z2))) {
+ I = I + 1;
+ X2 = SQRT(X * D);
+ Y2 = (X2 - Z2) - (Y - Z2);
+ X2 = X8 / (Y - Half);
+ X2 = X2 - Half * X2 * X2;
+ SqEr = (Y2 + Half) + (Half - X2);
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ SqEr = Y2 - X2;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ }
+ }
+
+/* IsYeqX */
+
+IsYeqX()
+{
+ if (Y != X) {
+ if (N <= 0) {
+ if (Z == Zero && Q <= Zero)
+ printf("WARNING: computing\n");
+ else BadCond(Defect, "computing\n");
+ printf("\t(");
+ pnum( &Z );
+ printf( ") ^ (" );
+ pnum( &Q );
+ printf("\tyielded " );
+ pnum( &Y );
+ printf("\twhich compared unequal to correct " );
+ pnum( &X );
+ printf("\t\tthey differ by " );
+ Ptemp = Y - X;
+ pnum( &Ptemp );
+ }
+ N = N + 1; /* ... count discrepancies. */
+ }
+ }
+
+/* SR3980 */
+
+SR3980()
+{
+ do {
+ Q = (FLOAT) I;
+ Y = POW(Z, Q);
+ IsYeqX();
+ if (++I > M) break;
+ X = Z * X;
+ } while ( X < W );
+ }
+
+/* PrintIfNPositive */
+
+PrintIfNPositive()
+{
+ if (N > 0) printf("Similar discrepancies have occurred %d times.\n", N);
+ }
+
+/* TstPtUf */
+
+TstPtUf()
+{
+ N = 0;
+ if (Z != Zero) {
+ printf("Since comparison denies Z = 0, evaluating ");
+ printf("(Z + Z) / Z should be safe.\n");
+ sigsave = sigfpe;
+ if (setjmp(ovfl_buf)) goto very_serious;
+ Q9 = (Z + Z) / Z;
+ printf("What the machine gets for (Z + Z) / Z is " );
+ pnum( &Q9 );
+ if (FABS(Q9 - Two) < Radix * U2) {
+ printf("This is O.K., provided Over/Underflow");
+ printf(" has NOT just been signaled.\n");
+ }
+ else {
+ if ((Q9 < One) || (Q9 > Two)) {
+very_serious:
+ N = 1;
+ ErrCnt [Serious] = ErrCnt [Serious] + 1;
+ printf("This is a VERY SERIOUS DEFECT!\n");
+ }
+ else {
+ N = 1;
+ ErrCnt [Defect] = ErrCnt [Defect] + 1;
+ printf("This is a DEFECT!\n");
+ }
+ }
+ V9 = Z * One;
+ Random1 = V9;
+ V9 = One * Z;
+ Random2 = V9;
+ V9 = Z / One;
+ if ((Z == Random1) && (Z == Random2) && (Z == V9)) {
+ if (N > 0) Pause();
+ }
+ else {
+ N = 1;
+ BadCond(Defect, "What prints as Z = ");
+ pnum( &Z );
+ printf("\tcompares different from ");
+ if (Z != Random1)
+ {
+ printf("Z * 1 = " );
+ pnum( &Random1 );
+ }
+ if (! ((Z == Random2)
+ || (Random2 == Random1)))
+ {
+ printf("1 * Z == " );
+ pnum( &Random2 );
+ }
+ if (! (Z == V9))
+ {
+ printf("Z / 1 = ");
+ pnum( &V9 );
+ }
+ if (Random2 != Random1) {
+ ErrCnt [Defect] = ErrCnt [Defect] + 1;
+ BadCond(Defect, "Multiplication does not commute!\n");
+ printf("\tComparison alleges that 1 * Z = ");
+ pnum( &Random2 );
+ printf("\tdiffers from Z * 1 = ");
+ pnum( &Random1 );
+ }
+ Pause();
+ }
+ }
+ }
+
+notify(s)
+char *s;
+{
+ printf("%s test appears to be inconsistent...\n", s);
+ printf(" PLEASE NOTIFY KARPINKSI!\n");
+ }
+
+/*SPLIT msgs.c */
+
+/* Instructions */
+
+msglist(s)
+char **s;
+{ while(*s) printf("%s\n", *s++); }
+
+Instructions()
+{
+ static char *instr[] = {
+ "Lest this program stop prematurely, i.e. before displaying\n",
+ " `END OF TEST',\n",
+ "try to persuade the computer NOT to terminate execution when an",
+ "error like Over/Underflow or Division by Zero occurs, but rather",
+ "to persevere with a surrogate value after, perhaps, displaying some",
+ "warning. If persuasion avails naught, don't despair but run this",
+ "program anyway to see how many milestones it passes, and then",
+ "amend it to make further progress.\n",
+ "Answer questions with Y, y, N or n (unless otherwise indicated).\n",
+ 0};
+
+ msglist(instr);
+ }
+
+/* Heading */
+
+Heading()
+{
+ static char *head[] = {
+ "Users are invited to help debug and augment this program so it will",
+ "cope with unanticipated and newly uncovered arithmetic pathologies.\n",
+ "Please send suggestions and interesting results to",
+ "\tRichard Karpinski",
+ "\tComputer Center U-76",
+ "\tUniversity of California",
+ "\tSan Francisco, CA 94143-0704, USA\n",
+ "In doing so, please include the following information:",
+#ifdef Single
+ "\tPrecision:\tsingle;",
+#else
+ "\tPrecision:\tdouble;",
+#endif
+ "\tVersion:\t27 January 1986;",
+ "\tComputer:\n",
+ "\tCompiler:\n",
+ "\tOptimization level:\n",
+ "\tOther relevant compiler options:",
+ 0};
+
+ msglist(head);
+ }
+
+/* Characteristics */
+
+Characteristics()
+{
+ static char *chars[] = {
+ "Running this program should reveal these characteristics:",
+ " Radix = 1, 2, 4, 8, 10, 16, 100, 256 ...",
+ " Precision = number of significant digits carried.",
+ " U2 = Radix/Radix^Precision = One Ulp",
+ "\t(OneUlpnit in the Last Place) of 1.000xxx .",
+ " U1 = 1/Radix^Precision = One Ulp of numbers a little less than 1.0 .",
+ " Adequacy of guard digits for Mult., Div. and Subt.",
+ " Whether arithmetic is chopped, correctly rounded, or something else",
+ "\tfor Mult., Div., Add/Subt. and Sqrt.",
+ " Whether a Sticky Bit used correctly for rounding.",
+ " UnderflowThreshold = an underflow threshold.",
+ " E0 and PseudoZero tell whether underflow is abrupt, gradual, or fuzzy.",
+ " V = an overflow threshold, roughly.",
+ " V0 tells, roughly, whether Infinity is represented.",
+ " Comparisions are checked for consistency with subtraction",
+ "\tand for contamination with pseudo-zeros.",
+ " Sqrt is tested. Y^X is not tested.",
+ " Extra-precise subexpressions are revealed but NOT YET tested.",
+ " Decimal-Binary conversion is NOT YET tested for accuracy.",
+ 0};
+
+ msglist(chars);
+ }
+
+History()
+
+{ /* History */
+ /* Converted from Brian Wichmann's Pascal version to C by Thos Sumner,
+ with further massaging by David M. Gay. */
+
+ static char *hist[] = {
+ "The program attempts to discriminate among",
+ " FLAWs, like lack of a sticky bit,",
+ " Serious DEFECTs, like lack of a guard digit, and",
+ " FAILUREs, like 2+2 == 5 .",
+ "Failures may confound subsequent diagnoses.\n",
+ "The diagnostic capabilities of this program go beyond an earlier",
+ "program called `MACHAR', which can be found at the end of the",
+ "book `Software Manual for the Elementary Functions' (1980) by",
+ "W. J. Cody and W. Waite. Although both programs try to discover",
+ "the Radix, Precision and range (over/underflow thresholds)",
+ "of the arithmetic, this program tries to cope with a wider variety",
+ "of pathologies, and to say how well the arithmetic is implemented.",
+ "\nThe program is based upon a conventional radix representation for",
+ "floating-point numbers, but also allows logarithmic encoding",
+ "as used by certain early WANG machines.\n",
+ "BASIC version of this program (C) 1983 by Prof. W. M. Kahan;",
+ "see source comments for more history.",
+ 0};
+
+ msglist(hist);
+ }
diff --git a/libm/ldouble/monotl.c b/libm/ldouble/monotl.c
new file mode 100644
index 000000000..86b85eca1
--- /dev/null
+++ b/libm/ldouble/monotl.c
@@ -0,0 +1,307 @@
+
+/* monot.c
+ Floating point function test vectors.
+
+ Arguments and function values are synthesized for NPTS points in
+ the vicinity of each given tabulated test point. The points are
+ chosen to be near and on either side of the likely function algorithm
+ domain boundaries. Since the function programs change their methods
+ at these points, major coding errors or monotonicity failures might be
+ detected.
+
+ August, 1998
+ S. L. Moshier */
+
+
+#include <stdio.h>
+
+/* Avoid including math.h. */
+long double frexpl (long double, int *);
+long double ldexpl (long double, int);
+
+/* Number of test points to generate on each side of tabulated point. */
+#define NPTS 100
+
+/* Functions of one variable. */
+long double expl (long double);
+long double logl (long double);
+long double sinl (long double);
+long double cosl (long double);
+long double tanl (long double);
+long double atanl (long double);
+long double asinl (long double);
+long double acosl (long double);
+long double sinhl (long double);
+long double coshl (long double);
+long double tanhl (long double);
+long double asinhl (long double);
+long double acoshl (long double);
+long double atanhl (long double);
+long double gammal (long double);
+long double fabsl (long double);
+long double floorl (long double);
+
+struct oneargument
+ {
+ char *name; /* Name of the function. */
+ long double (*func) (long double);
+ long double arg1; /* Function argument, assumed exact. */
+ long double answer1; /* Exact, close to function value. */
+ long double answer2; /* answer1 + answer2 has extended precision. */
+ long double derivative; /* dy/dx evaluated at x = arg1. */
+ int thresh; /* Error report threshold. 2 = 1 ULP approx. */
+ };
+
+/* Add this to error threshold test[i].thresh. */
+#define OKERROR 2
+
+/* Unit of relative error in test[i].thresh. */
+static long double MACHEPL = 5.42101086242752217003726400434970855712890625E-20L;
+
+/* extern double MACHEP; */
+
+
+struct oneargument test1[] =
+{
+ {"exp", expl, 1.0L, 2.7182769775390625L,
+ 4.85091998273536028747e-6L, 2.71828182845904523536L, 1},
+ {"exp", expl, -1.0L, 3.678741455078125e-1L,
+ 5.29566362982159552377e-6L, 3.678794411714423215955e-1L, 1},
+ {"exp", expl, 0.5L, 1.648712158203125L,
+ 9.1124970031468486507878e-6L, 1.64872127070012814684865L, 1},
+ {"exp", expl, -0.5L, 6.065216064453125e-1L,
+ 9.0532673209236037995e-6L, 6.0653065971263342360e-1L, 1},
+ {"exp", expl, 2.0L, 7.3890533447265625L,
+ 2.75420408772723042746e-6L, 7.38905609893065022723L, 1},
+ {"exp", expl, -2.0L, 1.353302001953125e-1L,
+ 5.08304130019189399949e-6L, 1.3533528323661269189e-1L, 1},
+ {"log", logl, 1.41421356237309492343L, 3.465728759765625e-1L,
+ 7.1430341006605745676897e-7L, 7.0710678118654758708668e-1L, 1},
+ {"log", logl, 7.07106781186547461715e-1L, -3.46588134765625e-1L,
+ 1.45444856522566402246e-5L, 1.41421356237309517417L, 1},
+ {"sin", sinl, 7.85398163397448278999e-1L, 7.0709228515625e-1L,
+ 1.4496030297502751942956e-5L, 7.071067811865475460497e-1L, 1},
+ {"sin", sinl, -7.85398163397448501044e-1L, -7.071075439453125e-1L,
+ 7.62758764840238811175e-7L, 7.07106781186547389040e-1L, 1},
+ {"sin", sinl, 1.570796326794896558L, 9.999847412109375e-1L,
+ 1.52587890625e-5L, 6.12323399573676588613e-17L, 1},
+ {"sin", sinl, -1.57079632679489678004L, -1.0L,
+ 1.29302922820150306903e-32L, -1.60812264967663649223e-16L, 1},
+ {"sin", sinl, 4.712388980384689674L, -1.0L,
+ 1.68722975549458979398e-32L, -1.83697019872102976584e-16L, 1},
+ {"sin", sinl, -4.71238898038468989604L, 9.999847412109375e-1L,
+ 1.52587890625e-5L, 3.83475850529283315008e-17L, 1},
+ {"cos", cosl, 3.92699081698724139500E-1L, 9.23873901367187500000E-1L,
+ 5.63114409926198633370E-6L, -3.82683432365089757586E-1L, 1},
+ {"cos", cosl, 7.85398163397448278999E-1L, 7.07092285156250000000E-1L,
+ 1.44960302975460497458E-5L, -7.07106781186547502752E-1L, 1},
+ {"cos", cosl, 1.17809724509617241850E0L, 3.82675170898437500000E-1L,
+ 8.26146665231415693919E-6L, -9.23879532511286738554E-1L, 1},
+ {"cos", cosl, 1.96349540849362069750E0L, -3.82690429687500000000E-1L,
+ 6.99732241029898567203E-6L, -9.23879532511286785419E-1L, 1},
+ {"cos", cosl, 2.35619449019234483700E0L, -7.07107543945312500000E-1L,
+ 7.62758765040545859856E-7L, -7.07106781186547589348E-1L, 1},
+ {"cos", cosl, 2.74889357189106897650E0L, -9.23889160156250000000E-1L,
+ 9.62764496328487887036E-6L, -3.82683432365089870728E-1L, 1},
+ {"cos", cosl, 3.14159265358979311600E0L, -1.00000000000000000000E0L,
+ 7.49879891330928797323E-33L, -1.22464679914735317723E-16L, 1},
+ {"tan", tanl, 7.85398163397448278999E-1L, 9.999847412109375e-1L,
+ 1.52587890624387676600E-5L, 1.99999999999999987754E0L, 1},
+ {"tan", tanl, 1.17809724509617241850E0L, 2.41419982910156250000E0L,
+ 1.37332715322352112604E-5L, 6.82842712474618858345E0L, 1},
+ {"tan", tanl, 1.96349540849362069750E0L, -2.41421508789062500000E0L,
+ 1.52551752942854759743E-6L, 6.82842712474619262118E0L, 1},
+ {"tan", tanl, 2.35619449019234483700E0L, -1.00001525878906250000E0L,
+ 1.52587890623163029801E-5L, 2.00000000000000036739E0L, 1},
+ {"tan", tanl, 2.74889357189106897650E0L, -4.14215087890625000000E-1L,
+ 1.52551752982565655126E-6L, 1.17157287525381000640E0L, 1},
+ {"atan", atanl, 4.14213562373094923430E-1L, 3.92684936523437500000E-1L,
+ 1.41451752865477964149E-5L, 8.53553390593273837869E-1L, 1},
+ {"atan", atanl, 1.0L, 7.85385131835937500000E-1L,
+ 1.30315615108096156608E-5L, 0.5L, 1},
+ {"atan", atanl, 2.41421356237309492343E0L, 1.17808532714843750000E0L,
+ 1.19179477349460632350E-5L, 1.46446609406726250782E-1L, 1},
+ {"atan", atanl, -2.41421356237309514547E0L, -1.17810058593750000000E0L,
+ 3.34084132752141908545E-6L, 1.46446609406726227789E-1L, 1},
+ {"atan", atanl, -1.0L, -7.85400390625000000000E-1L,
+ 2.22722755169038433915E-6L, 0.5L, 1},
+ {"atan", atanl, -4.14213562373095145475E-1L, -3.92700195312500000000E-1L,
+ 1.11361377576267665972E-6L, 8.53553390593273703853E-1L, 1},
+ {"asin", asinl, 3.82683432365089615246E-1L, 3.92684936523437500000E-1L,
+ 1.41451752864854321970E-5L, 1.08239220029239389286E0L, 1},
+ {"asin", asinl, 0.5L, 5.23590087890625000000E-1L,
+ 8.68770767387307710723E-6L, 1.15470053837925152902E0L, 1},
+ {"asin", asinl, 7.07106781186547461715E-1L, 7.85385131835937500000E-1L,
+ 1.30315615107209645016E-5L, 1.41421356237309492343E0L, 1},
+ {"asin", asinl, 9.23879532511286738483E-1L, 1.17808532714843750000E0L,
+ 1.19179477349183147612E-5L, 2.61312592975275276483E0L, 1},
+ {"asin", asinl, -0.5L, -5.23605346679687500000E-1L,
+ 6.57108138862692289277E-6L, 1.15470053837925152902E0L, 1},
+ {"acos", acosl, 1.95090322016128192573E-1L, 1.37443542480468750000E0L,
+ 1.13611408471185777914E-5L, -1.01959115820831832232E0L, 1},
+ {"acos", acosl, 3.82683432365089615246E-1L, 1.17808532714843750000E0L,
+ 1.19179477351337991247E-5L, -1.08239220029239389286E0L, 1},
+ {"acos", acosl, 0.5L, 1.04719543457031250000E0L,
+ 2.11662628524615421446E-6L, -1.15470053837925152902E0L, 1},
+ {"acos", acosl, 7.07106781186547461715E-1L, 7.85385131835937500000E-1L,
+ 1.30315615108982668201E-5L, -1.41421356237309492343E0L, 1},
+ {"acos", acosl, 9.23879532511286738483E-1L, 3.92684936523437500000E-1L,
+ 1.41451752867009165605E-5L, -2.61312592975275276483E0L, 1},
+ {"acos", acosl, 9.80785280403230430579E-1L, 1.96334838867187500000E-1L,
+ 1.47019821746724723933E-5L, -5.12583089548300990774E0L, 1},
+ {"acos", acosl, -0.5L, 2.09439086914062500000E0L,
+ 4.23325257049230842892E-6L, -1.15470053837925152902E0L, 1},
+ {"sinh", sinhl, 1.0L, 1.17518615722656250000E0L,
+ 1.50364172389568823819E-5L, 1.54308063481524377848E0L, 1},
+ {"sinh", sinhl, 7.09089565712818057364E2L, 4.49423283712885057274E307L,
+ 4.25947714184369757620E208L, 4.49423283712885057274E307L, 1},
+ {"sinh", sinhl, 2.22044604925031308085E-16L, 0.00000000000000000000E0L,
+ 2.22044604925031308085E-16L, 1.00000000000000000000E0L, 1},
+ {"cosh", coshl, 7.09089565712818057364E2L, 4.49423283712885057274E307L,
+ 4.25947714184369757620E208L, 4.49423283712885057274E307L, 1},
+ {"cosh", coshl, 1.0L, 1.54307556152343750000E0L,
+ 5.07329180627847790562E-6L, 1.17520119364380145688E0L, 1},
+ {"cosh", coshl, 0.5L, 1.12762451171875000000E0L,
+ 1.45348763078522622516E-6L, 5.21095305493747361622E-1L, 1},
+ {"tanh", tanhl, 0.5L, 4.62112426757812500000E-1L,
+ 4.73050219725850231848E-6L, 7.86447732965927410150E-1L, 1},
+ {"tanh", tanhl, 5.49306144334054780032E-1L, 4.99984741210937500000E-1L,
+ 1.52587890624507506378E-5L, 7.50000000000000049249E-1L, 1},
+ {"tanh", tanhl, 0.625L, 5.54595947265625000000E-1L,
+ 3.77508375729399903910E-6L, 6.92419147969988069631E-1L, 1},
+ {"asinh", asinhl, 0.5L, 4.81201171875000000000E-1L,
+ 1.06531846034474977589E-5L, 8.94427190999915878564E-1L, 1},
+ {"asinh", asinhl, 1.0L, 8.81362915039062500000E-1L,
+ 1.06719804805252326093E-5L, 7.07106781186547524401E-1L, 1},
+ {"asinh", asinhl, 2.0L, 1.44363403320312500000E0L,
+ 1.44197568534249327674E-6L, 4.47213595499957939282E-1L, 1},
+ {"acosh", acoshl, 2.0L, 1.31695556640625000000E0L,
+ 2.33051856670862504635E-6L, 5.77350269189625764509E-1L, 1},
+ {"acosh", acoshl, 1.5L, 9.62417602539062500000E-1L,
+ 6.04758014439499551783E-6L, 8.94427190999915878564E-1L, 1},
+ {"acosh", acoshl, 1.03125L, 2.49343872070312500000E-1L,
+ 9.62177257298785143908E-6L, 3.96911150685467059809E0L, 1},
+ {"atanh", atanhl, 0.5L, 5.49301147460937500000E-1L,
+ 4.99687311734569762262E-6L, 1.33333333333333333333E0L, 1},
+#if 0
+ {"gamma", gammal, 1.0L, 1.0L,
+ 0.0L, -5.772156649015328606e-1L, 1},
+ {"gamma", gammal, 2.0L, 1.0L,
+ 0.0L, 4.2278433509846713939e-1L, 1},
+ {"gamma", gammal, 3.0L, 2.0L,
+ 0.0L, 1.845568670196934279L, 1},
+ {"gamma", gammal, 4.0L, 6.0L,
+ 0.0L, 7.536706010590802836L, 1},
+#endif
+ {"null", NULL, 0.0L, 0.0L, 0.0L, 1},
+};
+
+/* These take care of extra-precise floating point register problems. */
+volatile long double volat1;
+volatile long double volat2;
+
+
+/* Return the next nearest floating point value to X
+ in the direction of UPDOWN (+1 or -1).
+ (Fails if X is denormalized.) */
+
+long double
+nextval (x, updown)
+ long double x;
+ int updown;
+{
+ long double m;
+ int i;
+
+ volat1 = x;
+ m = 0.25L * MACHEPL * volat1 * updown;
+ volat2 = volat1 + m;
+ if (volat2 != volat1)
+ printf ("successor failed\n");
+
+ for (i = 2; i < 10; i++)
+ {
+ volat2 = volat1 + i * m;
+ if (volat1 != volat2)
+ return volat2;
+ }
+
+ printf ("nextval failed\n");
+ return volat1;
+}
+
+
+
+
+int
+main ()
+{
+ long double (*fun1) (long double);
+ int i, j, errs, tests;
+ long double x, x0, y, dy, err;
+
+ errs = 0;
+ tests = 0;
+ i = 0;
+
+ for (;;)
+ {
+ fun1 = test1[i].func;
+ if (fun1 == NULL)
+ break;
+ volat1 = test1[i].arg1;
+ x0 = volat1;
+ x = volat1;
+ for (j = 0; j <= NPTS; j++)
+ {
+ volat1 = x - x0;
+ dy = volat1 * test1[i].derivative;
+ dy = test1[i].answer2 + dy;
+ volat1 = test1[i].answer1 + dy;
+ volat2 = (*(fun1)) (x);
+ if (volat2 != volat1)
+ {
+ /* Report difference between program result
+ and extended precision function value. */
+ err = volat2 - test1[i].answer1;
+ err = err - dy;
+ err = err / volat1;
+ if (fabsl (err) > ((OKERROR + test1[i].thresh) * MACHEPL))
+ {
+ printf ("%d %s(%.19Le) = %.19Le, rel err = %.3Le\n",
+ j, test1[i].name, x, volat2, err);
+ errs += 1;
+ }
+ }
+ x = nextval (x, 1);
+ tests += 1;
+ }
+
+ x = x0;
+ x = nextval (x, -1);
+ for (j = 1; j < NPTS; j++)
+ {
+ volat1 = x - x0;
+ dy = volat1 * test1[i].derivative;
+ dy = test1[i].answer2 + dy;
+ volat1 = test1[i].answer1 + dy;
+ volat2 = (*(fun1)) (x);
+ if (volat2 != volat1)
+ {
+ err = volat2 - test1[i].answer1;
+ err = err - dy;
+ err = err / volat1;
+ if (fabsl (err) > ((OKERROR + test1[i].thresh) * MACHEPL))
+ {
+ printf ("%d %s(%.19Le) = %.19Le, rel err = %.3Le\n",
+ j, test1[i].name, x, volat2, err);
+ errs += 1;
+ }
+ }
+ x = nextval (x, -1);
+ tests += 1;
+ }
+ i += 1;
+ }
+ printf ("%d errors in %d tests\n", errs, tests);
+}
diff --git a/libm/ldouble/mtherr.c b/libm/ldouble/mtherr.c
new file mode 100644
index 000000000..17d0485d2
--- /dev/null
+++ b/libm/ldouble/mtherr.c
@@ -0,0 +1,102 @@
+/* mtherr.c
+ *
+ * Library common error handling routine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * char *fctnam;
+ * int code;
+ * int mtherr();
+ *
+ * mtherr( fctnam, code );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This routine may be called to report one of the following
+ * error conditions (in the include file mconf.h).
+ *
+ * Mnemonic Value Significance
+ *
+ * DOMAIN 1 argument domain error
+ * SING 2 function singularity
+ * OVERFLOW 3 overflow range error
+ * UNDERFLOW 4 underflow range error
+ * TLOSS 5 total loss of precision
+ * PLOSS 6 partial loss of precision
+ * EDOM 33 Unix domain error code
+ * ERANGE 34 Unix range error code
+ *
+ * The default version of the file prints the function name,
+ * passed to it by the pointer fctnam, followed by the
+ * error condition. The display is directed to the standard
+ * output device. The routine then returns to the calling
+ * program. Users may wish to modify the program to abort by
+ * calling exit() under severe error conditions such as domain
+ * errors.
+ *
+ * Since all error conditions pass control to this function,
+ * the display may be easily changed, eliminated, or directed
+ * to an error logging device.
+ *
+ * SEE ALSO:
+ *
+ * mconf.h
+ *
+ */
+
+/*
+Cephes Math Library Release 2.0: April, 1987
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include <stdio.h>
+#include <math.h>
+
+int merror = 0;
+
+/* Notice: the order of appearance of the following
+ * messages is bound to the error codes defined
+ * in mconf.h.
+ */
+static char *ermsg[7] = {
+"unknown", /* error code 0 */
+"domain", /* error code 1 */
+"singularity", /* et seq. */
+"overflow",
+"underflow",
+"total loss of precision",
+"partial loss of precision"
+};
+
+
+int mtherr( name, code )
+char *name;
+int code;
+{
+
+/* Display string passed by calling program,
+ * which is supposed to be the name of the
+ * function in which the error occurred:
+ */
+printf( "\n%s ", name );
+
+/* Set global error message word */
+merror = code;
+
+/* Display error message defined
+ * by the code argument.
+ */
+if( (code <= 0) || (code >= 7) )
+ code = 0;
+printf( "%s error\n", ermsg[code] );
+
+/* Return to calling
+ * program
+ */
+return( 0 );
+}
diff --git a/libm/ldouble/mtstl.c b/libm/ldouble/mtstl.c
new file mode 100644
index 000000000..0cd6eed16
--- /dev/null
+++ b/libm/ldouble/mtstl.c
@@ -0,0 +1,521 @@
+/* mtst.c
+ Consistency tests for math functions.
+
+ With NTRIALS=10000, the following are typical results for
+ an alleged IEEE long double precision arithmetic:
+
+Consistency test of math functions.
+Max and rms errors for 10000 random arguments.
+A = absolute error criterion (but relative if >1):
+Otherwise, estimate is of relative error
+x = cbrt( cube(x) ): max = 7.65E-20 rms = 4.39E-21
+x = atan( tan(x) ): max = 2.01E-19 rms = 3.96E-20
+x = sin( asin(x) ): max = 2.15E-19 rms = 3.00E-20
+x = sqrt( square(x) ): max = 0.00E+00 rms = 0.00E+00
+x = log( exp(x) ): max = 5.42E-20 A rms = 1.87E-21 A
+x = log2( exp2(x) ): max = 1.08E-19 A rms = 3.37E-21 A
+x = log10( exp10(x) ): max = 2.71E-20 A rms = 6.76E-22 A
+x = acosh( cosh(x) ): max = 3.13E-18 A rms = 3.21E-20 A
+x = pow( pow(x,a),1/a ): max = 1.25E-17 rms = 1.70E-19
+x = tanh( atanh(x) ): max = 1.08E-19 rms = 1.16E-20
+x = asinh( sinh(x) ): max = 1.03E-19 rms = 2.94E-21
+x = cos( acos(x) ): max = 1.63E-19 A rms = 4.37E-20 A
+lgam(x) = log(gamma(x)): max = 2.31E-19 A rms = 5.93E-20 A
+x = ndtri( ndtr(x) ): max = 5.07E-17 rms = 7.03E-19
+Legendre ellpk, ellpe: max = 7.59E-19 A rms = 1.72E-19 A
+Absolute error and only 2000 trials:
+Wronksian of Yn, Jn: max = 6.40E-18 A rms = 1.49E-19 A
+Relative error and only 100 trials:
+x = stdtri(stdtr(k,x) ): max = 6.73E-19 rms = 2.46E-19
+*/
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1984, 1987, 1988, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* C9X spells lgam lgamma. */
+#define GLIBC2 0
+
+#define NTRIALS 10000
+#define WTRIALS (NTRIALS/5)
+#define STRTST 0
+
+/* Note, fabsl may be an intrinsic function. */
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double sqrtl ( long double );
+extern long double cbrtl ( long double );
+extern long double expl ( long double );
+extern long double logl ( long double );
+extern long double tanl ( long double );
+extern long double atanl ( long double );
+extern long double sinl ( long double );
+extern long double asinl ( long double );
+extern long double cosl ( long double );
+extern long double acosl ( long double );
+extern long double powl ( long double, long double );
+extern long double tanhl ( long double );
+extern long double atanhl ( long double );
+extern long double sinhl ( long double );
+extern long double asinhl ( long double );
+extern long double coshl ( long double );
+extern long double acoshl ( long double );
+extern long double exp2l ( long double );
+extern long double log2l ( long double );
+extern long double exp10l ( long double );
+extern long double log10l ( long double );
+extern long double gammal ( long double );
+extern long double lgaml ( long double );
+extern long double jnl ( int, long double );
+extern long double ynl ( int, long double );
+extern long double ndtrl ( long double );
+extern long double ndtril ( long double );
+extern long double stdtrl ( int, long double );
+extern long double stdtril ( int, long double );
+extern long double ellpel ( long double );
+extern long double ellpkl ( long double );
+extern void exit (int);
+#else
+long double fabsl(), sqrtl();
+long double cbrtl(), expl(), logl(), tanl(), atanl();
+long double sinl(), asinl(), cosl(), acosl(), powl();
+long double tanhl(), atanhl(), sinhl(), asinhl(), coshl(), acoshl();
+long double exp2l(), log2l(), exp10l(), log10l();
+long double gammal(), lgaml(), jnl(), ynl(), ndtrl(), ndtril();
+long double stdtrl(), stdtril(), ellpel(), ellpkl();
+void exit ();
+#endif
+extern int merror;
+#if GLIBC2
+long double lgammal(long double);
+#endif
+/*
+NYI:
+double iv(), kn();
+*/
+
+/* Provide inverses for square root and cube root: */
+long double squarel(x)
+long double x;
+{
+return( x * x );
+}
+
+long double cubel(x)
+long double x;
+{
+return( x * x * x );
+}
+
+/* lookup table for each function */
+struct fundef
+ {
+ char *nam1; /* the function */
+ long double (*name )();
+ char *nam2; /* its inverse */
+ long double (*inv )();
+ int nargs; /* number of function arguments */
+ int tstyp; /* type code of the function */
+ long ctrl; /* relative error flag */
+ long double arg1w; /* width of domain for 1st arg */
+ long double arg1l; /* lower bound domain 1st arg */
+ long arg1f; /* flags, e.g. integer arg */
+ long double arg2w; /* same info for args 2, 3, 4 */
+ long double arg2l;
+ long arg2f;
+/*
+ double arg3w;
+ double arg3l;
+ long arg3f;
+ double arg4w;
+ double arg4l;
+ long arg4f;
+*/
+ };
+
+
+/* fundef.ctrl bits: */
+#define RELERR 1
+#define EXPSCAL 4
+
+/* fundef.tstyp test types: */
+#define POWER 1
+#define ELLIP 2
+#define GAMMA 3
+#define WRONK1 4
+#define WRONK2 5
+#define WRONK3 6
+#define STDTR 7
+
+/* fundef.argNf argument flag bits: */
+#define INT 2
+
+extern long double MINLOGL;
+extern long double MAXLOGL;
+extern long double PIL;
+extern long double PIO2L;
+/*
+define MINLOG -170.0
+define MAXLOG +170.0
+define PI 3.14159265358979323846
+define PIO2 1.570796326794896619
+*/
+
+#define NTESTS 17
+struct fundef defs[NTESTS] = {
+{" cube", cubel, " cbrt", cbrtl, 1, 0, 1, 2000.0L, -1000.0L, 0,
+0.0, 0.0, 0},
+{" tan", tanl, " atan", atanl, 1, 0, 1, 0.0L, 0.0L, 0,
+0.0, 0.0, 0},
+{" asin", asinl, " sin", sinl, 1, 0, 1, 2.0L, -1.0L, 0,
+0.0, 0.0, 0},
+{"square", squarel, " sqrt", sqrtl, 1, 0, 1, 170.0L, -85.0L, EXPSCAL,
+0.0, 0.0, 0},
+{" exp", expl, " log", logl, 1, 0, 0, 340.0L, -170.0L, 0,
+0.0, 0.0, 0},
+{" exp2", exp2l, " log2", log2l, 1, 0, 0, 340.0L, -170.0L, 0,
+0.0, 0.0, 0},
+{" exp10", exp10l, " log10", log10l, 1, 0, 0, 340.0L, -170.0L, 0,
+0.0, 0.0, 0},
+{" cosh", coshl, " acosh", acoshl, 1, 0, 0, 340.0L, 0.0L, 0,
+0.0, 0.0, 0},
+{"pow", powl, "pow", powl, 2, POWER, 1, 25.0L, 0.0L, 0,
+50.0, -25.0, 0},
+{" atanh", atanhl, " tanh", tanhl, 1, 0, 1, 2.0L, -1.0L, 0,
+0.0, 0.0, 0},
+{" sinh", sinhl, " asinh", asinhl, 1, 0, 1, 340.0L, 0.0L, 0,
+0.0, 0.0, 0},
+{" acos", acosl, " cos", cosl, 1, 0, 0, 2.0L, -1.0L, 0,
+0.0, 0.0, 0},
+#if GLIBC2
+ /*
+{ "gamma", gammal, "lgammal", lgammal, 1, GAMMA, 0, 34.0, 0.0, 0,
+0.0, 0.0, 0},
+*/
+#else
+{ "gamma", gammal, "lgam", lgaml, 1, GAMMA, 0, 34.0, 0.0, 0,
+0.0, 0.0, 0},
+{ " ndtr", ndtrl, " ndtri", ndtril, 1, 0, 1, 10.0L, -10.0L, 0,
+0.0, 0.0, 0},
+{" ellpe", ellpel, " ellpk", ellpkl, 1, ELLIP, 0, 1.0L, 0.0L, 0,
+0.0, 0.0, 0},
+{ "stdtr", stdtrl, "stdtri", stdtril, 2, STDTR, 1, 4.0L, -2.0L, 0,
+30.0, 1.0, INT},
+{ " Jn", jnl, " Yn", ynl, 2, WRONK1, 0, 30.0, 0.1, 0,
+40.0, -20.0, INT},
+#endif
+};
+
+static char *headrs[] = {
+"x = %s( %s(x) ): ",
+"x = %s( %s(x,a),1/a ): ", /* power */
+"Legendre %s, %s: ", /* ellip */
+"%s(x) = log(%s(x)): ", /* gamma */
+"Wronksian of %s, %s: ", /* wronk1 */
+"Wronksian of %s, %s: ", /* wronk2 */
+"Wronksian of %s, %s: ", /* wronk3 */
+"x = %s(%s(k,x) ): ", /* stdtr */
+};
+
+static long double y1 = 0.0;
+static long double y2 = 0.0;
+static long double y3 = 0.0;
+static long double y4 = 0.0;
+static long double a = 0.0;
+static long double x = 0.0;
+static long double y = 0.0;
+static long double z = 0.0;
+static long double e = 0.0;
+static long double max = 0.0;
+static long double rmsa = 0.0;
+static long double rms = 0.0;
+static long double ave = 0.0;
+static double da, db, dc, dd;
+
+int ldrand();
+int printf();
+
+int
+main()
+{
+long double (*fun )();
+long double (*ifun )();
+struct fundef *d;
+int i, k, itst;
+int m, ntr;
+
+ntr = NTRIALS;
+printf( "Consistency test of math functions.\n" );
+printf( "Max and rms errors for %d random arguments.\n",
+ ntr );
+printf( "A = absolute error criterion (but relative if >1):\n" );
+printf( "Otherwise, estimate is of relative error\n" );
+
+/* Initialize machine dependent parameters to test near the
+ * largest an smallest possible arguments. To compare different
+ * machines, use the same test intervals for all systems.
+ */
+defs[1].arg1w = PIL;
+defs[1].arg1l = -PIL/2.0;
+/*
+defs[3].arg1w = MAXLOGL;
+defs[3].arg1l = -MAXLOGL/2.0;
+defs[4].arg1w = 2.0*MAXLOGL;
+defs[4].arg1l = -MAXLOGL;
+defs[6].arg1w = 2.0*MAXLOGL;
+defs[6].arg1l = -MAXLOGL;
+defs[7].arg1w = MAXLOGL;
+defs[7].arg1l = 0.0;
+*/
+
+/* Outer loop, on the test number: */
+
+for( itst=STRTST; itst<NTESTS; itst++ )
+{
+d = &defs[itst];
+m = 0;
+max = 0.0L;
+rmsa = 0.0L;
+ave = 0.0L;
+fun = d->name;
+ifun = d->inv;
+
+/* Smaller number of trials for Wronksians
+ * (put them at end of list)
+ */
+if( d->tstyp == WRONK1 )
+ {
+ ntr = WTRIALS;
+ printf( "Absolute error and only %d trials:\n", ntr );
+ }
+else if( d->tstyp == STDTR )
+ {
+ ntr = NTRIALS/100;
+ printf( "Relative error and only %d trials:\n", ntr );
+ }
+/*
+y1 = d->arg1l;
+y2 = d->arg1w;
+da = y1;
+db = y2;
+printf( "arg1l = %.4e, arg1w = %.4e\n", da, db );
+*/
+printf( headrs[d->tstyp], d->nam2, d->nam1 );
+
+for( i=0; i<ntr; i++ )
+{
+m++;
+k = 0;
+/* make random number(s) in desired range(s) */
+switch( d->nargs )
+{
+
+default:
+goto illegn;
+
+case 2:
+ldrand( &a );
+a = d->arg2w * ( a - 1.0L ) + d->arg2l;
+if( d->arg2f & EXPSCAL )
+ {
+ a = expl(a);
+ ldrand( &y2 );
+ a -= 1.0e-13L * a * (y2 - 1.0L);
+ }
+if( d->arg2f & INT )
+ {
+ k = a + 0.25L;
+ a = k;
+ }
+
+case 1:
+ldrand( &x );
+y1 = d->arg1l;
+y2 = d->arg1w;
+x = y2 * ( x - 1.0L ) + y1;
+if( x < y1 )
+ x = y1;
+y1 += y2;
+if( x > y1 )
+ x = y1;
+if( d->arg1f & EXPSCAL )
+ {
+ x = expl(x);
+ ldrand( &y2 );
+ x += 1.0e-13L * x * (y2 - 1.0L);
+ }
+}
+
+/* compute function under test */
+switch( d->nargs )
+ {
+ case 1:
+ switch( d->tstyp )
+ {
+ case ELLIP:
+ y1 = ( *(fun) )(x);
+ y2 = ( *(fun) )(1.0L-x);
+ y3 = ( *(ifun) )(x);
+ y4 = ( *(ifun) )(1.0L-x);
+ break;
+#if 1
+ case GAMMA:
+ y = lgaml(x);
+ x = logl( gammal(x) );
+ break;
+#endif
+ default:
+ z = ( *(fun) )(x);
+ y = ( *(ifun) )(z);
+ }
+/*
+if( merror )
+ {
+ printf( "error: x = %.15e, z = %.15e, y = %.15e\n",
+ (double )x, (double )z, (double )y );
+ }
+*/
+ break;
+
+ case 2:
+ if( d->arg2f & INT )
+ {
+ switch( d->tstyp )
+ {
+ case WRONK1:
+ y1 = (*fun)( k, x ); /* jn */
+ y2 = (*fun)( k+1, x );
+ y3 = (*ifun)( k, x ); /* yn */
+ y4 = (*ifun)( k+1, x );
+ break;
+
+ case WRONK2:
+ y1 = (*fun)( a, x ); /* iv */
+ y2 = (*fun)( a+1.0L, x );
+ y3 = (*ifun)( k, x ); /* kn */
+ y4 = (*ifun)( k+1, x );
+ break;
+
+ default:
+ z = (*fun)( k, x );
+ y = (*ifun)( k, z );
+ }
+ }
+ else
+ {
+ if( d->tstyp == POWER )
+ {
+ z = (*fun)( x, a );
+ y = (*ifun)( z, 1.0L/a );
+ }
+ else
+ {
+ z = (*fun)( a, x );
+ y = (*ifun)( a, z );
+ }
+ }
+ break;
+
+
+ default:
+illegn:
+ printf( "Illegal nargs= %d", d->nargs );
+ exit(1);
+ }
+
+switch( d->tstyp )
+ {
+ case WRONK1:
+ /* Jn, Yn */
+/* e = (y2*y3 - y1*y4) - 2.0L/(PIL*x);*/
+ e = x*(y2*y3 - y1*y4) - 2.0L/PIL;
+ break;
+
+ case WRONK2:
+/* In, Kn */
+/* e = (y2*y3 + y1*y4) - 1.0L/x; */
+ e = x*(y2*y3 + y1*y4) - 1.0L;
+ break;
+
+ case ELLIP:
+ e = (y1-y3)*y4 + y3*y2 - PIO2L;
+ break;
+
+ default:
+ e = y - x;
+ break;
+ }
+
+if( d->ctrl & RELERR )
+ {
+ if( x != 0.0L )
+ e /= x;
+ else
+ printf( "warning, x == 0\n" );
+ }
+else
+ {
+ if( fabsl(x) > 1.0L )
+ e /= x;
+ }
+
+ave += e;
+/* absolute value of error */
+if( e < 0 )
+ e = -e;
+
+/* peak detect the error */
+if( e > max )
+ {
+ max = e;
+
+ if( e > 1.0e-10L )
+ {
+da = x;
+db = z;
+dc = y;
+dd = max;
+ printf("x %.6E z %.6E y %.6E max %.4E\n",
+ da, db, dc, dd );
+/*
+ if( d->tstyp >= WRONK1 )
+ {
+ printf( "y1 %.4E y2 %.4E y3 %.4E y4 %.4E k %d x %.4E\n",
+ (double )y1, (double )y2, (double )y3,
+ (double )y4, k, (double )x );
+ }
+*/
+ }
+
+/*
+ printf("%.8E %.8E %.4E %6ld \n", x, y, max, n);
+ printf("%d %.8E %.8E %.4E %6ld \n", k, x, y, max, n);
+ printf("%.6E %.6E %.6E %.4E %6ld \n", a, x, y, max, n);
+ printf("%.6E %.6E %.6E %.6E %.4E %6ld \n", a, b, x, y, max, n);
+ printf("%.4E %.4E %.4E %.4E %.4E %.4E %6ld \n",
+ a, b, c, x, y, max, n);
+*/
+ }
+
+/* accumulate rms error */
+e *= 1.0e16L; /* adjust range */
+rmsa += e * e; /* accumulate the square of the error */
+}
+
+/* report after NTRIALS trials */
+rms = 1.0e-16L * sqrtl( rmsa/m );
+da = max;
+db = rms;
+if(d->ctrl & RELERR)
+ printf(" max = %.2E rms = %.2E\n", da, db );
+else
+ printf(" max = %.2E A rms = %.2E A\n", da, db );
+} /* loop on itst */
+
+exit (0);
+return 0;
+}
+
diff --git a/libm/ldouble/nantst.c b/libm/ldouble/nantst.c
new file mode 100644
index 000000000..855a43b5a
--- /dev/null
+++ b/libm/ldouble/nantst.c
@@ -0,0 +1,61 @@
+#include <stdio.h>
+long double inf = 1.0f/0.0f;
+long double nnn = 1.0f/0.0f - 1.0f/0.0f;
+long double fin = 1.0f;
+long double neg = -1.0f;
+long double nn2;
+
+int isnanl(), isfinitel(), signbitl();
+void abort (void);
+void exit (int);
+
+void pvalue (char *str, long double x)
+{
+union
+ {
+ long double f;
+ unsigned int i[3];
+ }u;
+int k;
+
+printf("%s ", str);
+u.f = x;
+for (k = 0; k < 3; k++)
+ printf("%08x ", u.i[k]);
+printf ("\n");
+}
+
+
+int
+main()
+{
+
+if (!isnanl(nnn))
+ abort();
+pvalue("nnn", nnn);
+pvalue("inf", inf);
+nn2 = inf - inf;
+pvalue("inf - inf", nn2);
+if (isnanl(fin))
+ abort();
+if (isnanl(inf))
+ abort();
+if (!isfinitel(fin))
+ abort();
+if (isfinitel(nnn))
+ abort();
+if (isfinitel(inf))
+ abort();
+if (!signbitl(neg))
+ abort();
+if (signbitl(fin))
+ abort();
+if (signbitl(inf))
+ abort();
+/*
+if (signbitf(nnn))
+ abort();
+ */
+exit (0);
+return 0;
+}
diff --git a/libm/ldouble/nbdtrl.c b/libm/ldouble/nbdtrl.c
new file mode 100644
index 000000000..91593f544
--- /dev/null
+++ b/libm/ldouble/nbdtrl.c
@@ -0,0 +1,197 @@
+/* nbdtrl.c
+ *
+ * Negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtrl();
+ *
+ * y = nbdtrl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms 0 through k of the negative
+ * binomial distribution:
+ *
+ * k
+ * -- ( n+j-1 ) n j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * In a sequence of Bernoulli trials, this is the probability
+ * that k or fewer failures precede the nth success.
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = nbdtr( k, n, p ) = incbet( n, k+1, p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (k,n,p) with k and n between 1 and 10,000
+ * and p between 0 and 1.
+ *
+ * arithmetic domain # trials peak rms
+ * Absolute error:
+ * IEEE 0,10000 10000 9.8e-15 2.1e-16
+ *
+ */
+ /* nbdtrcl.c
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtrcl();
+ *
+ * y = nbdtrcl( k, n, p );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 to infinity of the negative
+ * binomial distribution:
+ *
+ * inf
+ * -- ( n+j-1 ) n j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=k+1
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ).
+ *
+ * The arguments must be positive, with p ranging from 0 to 1.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbetl.c.
+ *
+ */
+ /* nbdtril
+ *
+ * Functional inverse of negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * long double p, y, nbdtril();
+ *
+ * p = nbdtril( k, n, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the argument p such that nbdtr(k,n,p) is equal to y.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,y), with y between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100
+ * See also incbil.c.
+ */
+
+/*
+Cephes Math Library Release 2.3: January,1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double incbetl ( long double, long double, long double );
+extern long double powl ( long double, long double );
+extern long double incbil ( long double, long double, long double );
+#else
+long double incbetl(), powl(), incbil();
+#endif
+
+long double nbdtrcl( k, n, p )
+int k, n;
+long double p;
+{
+long double dk, dn;
+
+if( (p < 0.0L) || (p > 1.0L) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtrl", DOMAIN );
+ return( 0.0L );
+ }
+dn = n;
+if( k == 0 )
+ return( 1.0L - powl( p, dn ) );
+
+dk = k+1;
+return( incbetl( dk, dn, 1.0L - p ) );
+}
+
+
+
+long double nbdtrl( k, n, p )
+int k, n;
+long double p;
+{
+long double dk, dn;
+
+if( (p < 0.0L) || (p > 1.0L) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtrl", DOMAIN );
+ return( 0.0L );
+ }
+dn = n;
+if( k == 0 )
+ return( powl( p, dn ) );
+
+dk = k+1;
+return( incbetl( dn, dk, p ) );
+}
+
+
+long double nbdtril( k, n, p )
+int k, n;
+long double p;
+{
+long double dk, dn, w;
+
+if( (p < 0.0L) || (p > 1.0L) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtrl", DOMAIN );
+ return( 0.0L );
+ }
+dk = k+1;
+dn = n;
+w = incbil( dn, dk, p );
+return( w );
+}
diff --git a/libm/ldouble/ndtril.c b/libm/ldouble/ndtril.c
new file mode 100644
index 000000000..b1a15cedf
--- /dev/null
+++ b/libm/ldouble/ndtril.c
@@ -0,0 +1,416 @@
+/* ndtril.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ndtril();
+ *
+ * x = ndtril( y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the argument, x, for which the area under the
+ * Gaussian probability density function (integrated from
+ * minus infinity to x) is equal to y.
+ *
+ *
+ * For small arguments 0 < y < exp(-2), the program computes
+ * z = sqrt( -2 log(y) ); then the approximation is
+ * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z) .
+ * For larger arguments, x/sqrt(2 pi) = w + w^3 R(w^2)/S(w^2)) ,
+ * where w = y - 0.5 .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * Arguments uniformly distributed:
+ * IEEE 0, 1 5000 7.8e-19 9.9e-20
+ * Arguments exponentially distributed:
+ * IEEE exp(-11355),-1 30000 1.7e-19 4.3e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtril domain x <= 0 -MAXNUML
+ * ndtril domain x >= 1 MAXNUML
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.3: January, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+extern long double MAXNUML;
+
+/* ndtri(y+0.5)/sqrt(2 pi) = y + y^3 R(y^2)
+ 0 <= y <= 3/8
+ Peak relative error 6.8e-21. */
+#if UNK
+/* sqrt(2pi) */
+static long double s2pi = 2.506628274631000502416E0L;
+static long double P0[8] = {
+ 8.779679420055069160496E-3L,
+-7.649544967784380691785E-1L,
+ 2.971493676711545292135E0L,
+-4.144980036933753828858E0L,
+ 2.765359913000830285937E0L,
+-9.570456817794268907847E-1L,
+ 1.659219375097958322098E-1L,
+-1.140013969885358273307E-2L,
+};
+static long double Q0[7] = {
+/* 1.000000000000000000000E0L, */
+-5.303846964603721860329E0L,
+ 9.908875375256718220854E0L,
+-9.031318655459381388888E0L,
+ 4.496118508523213950686E0L,
+-1.250016921424819972516E0L,
+ 1.823840725000038842075E-1L,
+-1.088633151006419263153E-2L,
+};
+#endif
+#if IBMPC
+static unsigned short s2p[] = {
+0x2cb3,0xb138,0x98ff,0xa06c,0x4000, XPD
+};
+#define s2pi *(long double *)s2p
+static short P0[] = {
+0xb006,0x9fc1,0xa4fe,0x8fd8,0x3ff8, XPD
+0x6f8a,0x976e,0x0ed2,0xc3d4,0xbffe, XPD
+0xf1f1,0x6fcc,0xf3d0,0xbe2c,0x4000, XPD
+0xccfb,0xa681,0xad2c,0x84a3,0xc001, XPD
+0x9a0d,0x0082,0xa825,0xb0fb,0x4000, XPD
+0x13d1,0x054a,0xf220,0xf500,0xbffe, XPD
+0xcee9,0x2c92,0x70bd,0xa9e7,0x3ffc, XPD
+0x5fee,0x4a42,0xa6cb,0xbac7,0xbff8, XPD
+};
+static short Q0[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0x841e,0xfec7,0x1d44,0xa9b9,0xc001, XPD
+0x97e6,0xcde0,0xc0e7,0x9e8a,0x4002, XPD
+0x66f9,0x8f3e,0x47fd,0x9080,0xc002, XPD
+0x212f,0x2185,0x33ec,0x8fe0,0x4001, XPD
+0x8e73,0x7bac,0x8df2,0xa000,0xbfff, XPD
+0xc143,0xcb94,0xe3ea,0xbac2,0x3ffc, XPD
+0x25d9,0xc8f3,0x9573,0xb25c,0xbff8, XPD
+};
+#endif
+#if MIEEE
+static unsigned long s2p[] = {
+0x40000000,0xa06c98ff,0xb1382cb3,
+};
+#define s2pi *(long double *)s2p
+static long P0[24] = {
+0x3ff80000,0x8fd8a4fe,0x9fc1b006,
+0xbffe0000,0xc3d40ed2,0x976e6f8a,
+0x40000000,0xbe2cf3d0,0x6fccf1f1,
+0xc0010000,0x84a3ad2c,0xa681ccfb,
+0x40000000,0xb0fba825,0x00829a0d,
+0xbffe0000,0xf500f220,0x054a13d1,
+0x3ffc0000,0xa9e770bd,0x2c92cee9,
+0xbff80000,0xbac7a6cb,0x4a425fee,
+};
+static long Q0[21] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0xc0010000,0xa9b91d44,0xfec7841e,
+0x40020000,0x9e8ac0e7,0xcde097e6,
+0xc0020000,0x908047fd,0x8f3e66f9,
+0x40010000,0x8fe033ec,0x2185212f,
+0xbfff0000,0xa0008df2,0x7bac8e73,
+0x3ffc0000,0xbac2e3ea,0xcb94c143,
+0xbff80000,0xb25c9573,0xc8f325d9,
+};
+#endif
+
+/* Approximation for interval z = sqrt(-2 log y ) between 2 and 8
+ */
+/* ndtri(p) = z - ln(z)/z - 1/z P1(1/z)/Q1(1/z)
+ z = sqrt(-2 ln(p))
+ 2 <= z <= 8, i.e., y between exp(-2) = .135 and exp(-32) = 1.27e-14.
+ Peak relative error 5.3e-21 */
+#if UNK
+static long double P1[10] = {
+ 4.302849750435552180717E0L,
+ 4.360209451837096682600E1L,
+ 9.454613328844768318162E1L,
+ 9.336735653151873871756E1L,
+ 5.305046472191852391737E1L,
+ 1.775851836288460008093E1L,
+ 3.640308340137013109859E0L,
+ 3.691354900171224122390E-1L,
+ 1.403530274998072987187E-2L,
+ 1.377145111380960566197E-4L,
+};
+static long double Q1[9] = {
+/* 1.000000000000000000000E0L, */
+ 2.001425109170530136741E1L,
+ 7.079893963891488254284E1L,
+ 8.033277265194672063478E1L,
+ 5.034715121553662712917E1L,
+ 1.779820137342627204153E1L,
+ 3.845554944954699547539E0L,
+ 3.993627390181238962857E-1L,
+ 1.526870689522191191380E-2L,
+ 1.498700676286675466900E-4L,
+};
+#endif
+#if IBMPC
+static short P1[] = {
+0x6105,0xb71e,0xf1f5,0x89b0,0x4001, XPD
+0x461d,0x2604,0x8b77,0xae68,0x4004, XPD
+0x8b33,0x4a47,0x9ec8,0xbd17,0x4005, XPD
+0xa0b2,0xc1b0,0x1627,0xbabc,0x4005, XPD
+0x9901,0x28f7,0xad06,0xd433,0x4004, XPD
+0xddcb,0x5009,0x7213,0x8e11,0x4003, XPD
+0x2432,0x0fa6,0xcfd5,0xe8fa,0x4000, XPD
+0x3e24,0xd53c,0x53b2,0xbcff,0x3ffd, XPD
+0x4058,0x3d75,0x5393,0xe5f4,0x3ff8, XPD
+0x1789,0xf50a,0x7524,0x9067,0x3ff2, XPD
+};
+static short Q1[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0xd901,0x2673,0x2fad,0xa01d,0x4003, XPD
+0x24f5,0xc93c,0x0e9d,0x8d99,0x4005, XPD
+0x8cda,0x523a,0x612d,0xa0aa,0x4005, XPD
+0x602c,0xb5fc,0x7b9b,0xc963,0x4004, XPD
+0xac72,0xd3e7,0xb766,0x8e62,0x4003, XPD
+0x048e,0xe34c,0x927c,0xf61d,0x4000, XPD
+0x6d88,0xa5cc,0x45de,0xcc79,0x3ffd, XPD
+0xe6d1,0x199a,0x9931,0xfa29,0x3ff8, XPD
+0x4c7d,0x3675,0x70a0,0x9d26,0x3ff2, XPD
+};
+#endif
+#if MIEEE
+static long P1[30] = {
+0x40010000,0x89b0f1f5,0xb71e6105,
+0x40040000,0xae688b77,0x2604461d,
+0x40050000,0xbd179ec8,0x4a478b33,
+0x40050000,0xbabc1627,0xc1b0a0b2,
+0x40040000,0xd433ad06,0x28f79901,
+0x40030000,0x8e117213,0x5009ddcb,
+0x40000000,0xe8facfd5,0x0fa62432,
+0x3ffd0000,0xbcff53b2,0xd53c3e24,
+0x3ff80000,0xe5f45393,0x3d754058,
+0x3ff20000,0x90677524,0xf50a1789,
+};
+static long Q1[27] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40030000,0xa01d2fad,0x2673d901,
+0x40050000,0x8d990e9d,0xc93c24f5,
+0x40050000,0xa0aa612d,0x523a8cda,
+0x40040000,0xc9637b9b,0xb5fc602c,
+0x40030000,0x8e62b766,0xd3e7ac72,
+0x40000000,0xf61d927c,0xe34c048e,
+0x3ffd0000,0xcc7945de,0xa5cc6d88,
+0x3ff80000,0xfa299931,0x199ae6d1,
+0x3ff20000,0x9d2670a0,0x36754c7d,
+};
+#endif
+
+/* ndtri(x) = z - ln(z)/z - 1/z P2(1/z)/Q2(1/z)
+ z = sqrt(-2 ln(y))
+ 8 <= z <= 32
+ i.e., y between exp(-32) = 1.27e-14 and exp(-512) = 4.38e-223
+ Peak relative error 1.0e-21 */
+#if UNK
+static long double P2[8] = {
+ 3.244525725312906932464E0L,
+ 6.856256488128415760904E0L,
+ 3.765479340423144482796E0L,
+ 1.240893301734538935324E0L,
+ 1.740282292791367834724E-1L,
+ 9.082834200993107441750E-3L,
+ 1.617870121822776093899E-4L,
+ 7.377405643054504178605E-7L,
+};
+static long double Q2[7] = {
+/* 1.000000000000000000000E0L, */
+ 6.021509481727510630722E0L,
+ 3.528463857156936773982E0L,
+ 1.289185315656302878699E0L,
+ 1.874290142615703609510E-1L,
+ 9.867655920899636109122E-3L,
+ 1.760452434084258930442E-4L,
+ 8.028288500688538331773E-7L,
+};
+#endif
+#if IBMPC
+static short P2[] = {
+0xafb1,0x4ff9,0x4f3a,0xcfa6,0x4000, XPD
+0xbd81,0xaffa,0x7401,0xdb66,0x4001, XPD
+0x3a32,0x3863,0x9d0f,0xf0fd,0x4000, XPD
+0x300e,0x633d,0x977a,0x9ed5,0x3fff, XPD
+0xea3a,0x56b6,0x74c5,0xb234,0x3ffc, XPD
+0x38c6,0x49d2,0x2af6,0x94d0,0x3ff8, XPD
+0xc85d,0xe17d,0x5ed1,0xa9a5,0x3ff2, XPD
+0x536c,0x808b,0x2542,0xc609,0x3fea, XPD
+};
+static short Q2[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0xaabd,0x125a,0x34a7,0xc0b0,0x4001, XPD
+0x0ded,0xe6da,0x5a11,0xe1d2,0x4000, XPD
+0xc742,0x9d16,0x0640,0xa504,0x3fff, XPD
+0xea1e,0x4cc2,0x643a,0xbfed,0x3ffc, XPD
+0x7a9b,0xfaff,0xf2dd,0xa1ab,0x3ff8, XPD
+0xfd90,0x4688,0xc902,0xb898,0x3ff2, XPD
+0xf003,0x032a,0xfa7e,0xd781,0x3fea, XPD
+};
+#endif
+#if MIEEE
+static long P2[24] = {
+0x40000000,0xcfa64f3a,0x4ff9afb1,
+0x40010000,0xdb667401,0xaffabd81,
+0x40000000,0xf0fd9d0f,0x38633a32,
+0x3fff0000,0x9ed5977a,0x633d300e,
+0x3ffc0000,0xb23474c5,0x56b6ea3a,
+0x3ff80000,0x94d02af6,0x49d238c6,
+0x3ff20000,0xa9a55ed1,0xe17dc85d,
+0x3fea0000,0xc6092542,0x808b536c,
+};
+static long Q2[21] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40010000,0xc0b034a7,0x125aaabd,
+0x40000000,0xe1d25a11,0xe6da0ded,
+0x3fff0000,0xa5040640,0x9d16c742,
+0x3ffc0000,0xbfed643a,0x4cc2ea1e,
+0x3ff80000,0xa1abf2dd,0xfaff7a9b,
+0x3ff20000,0xb898c902,0x4688fd90,
+0x3fea0000,0xd781fa7e,0x032af003,
+};
+#endif
+
+/* ndtri(x) = z - ln(z)/z - 1/z P3(1/z)/Q3(1/z)
+ 32 < z < 2048/13
+ Peak relative error 1.4e-20 */
+#if UNK
+static long double P3[8] = {
+ 2.020331091302772535752E0L,
+ 2.133020661587413053144E0L,
+ 2.114822217898707063183E-1L,
+-6.500909615246067985872E-3L,
+-7.279315200737344309241E-4L,
+-1.275404675610280787619E-5L,
+-6.433966387613344714022E-8L,
+-7.772828380948163386917E-11L,
+};
+static long double Q3[7] = {
+/* 1.000000000000000000000E0L, */
+ 2.278210997153449199574E0L,
+ 2.345321838870438196534E-1L,
+-6.916708899719964982855E-3L,
+-7.908542088737858288849E-4L,
+-1.387652389480217178984E-5L,
+-7.001476867559193780666E-8L,
+-8.458494263787680376729E-11L,
+};
+#endif
+#if IBMPC
+static short P3[] = {
+0x87b2,0x0f31,0x1ac7,0x814d,0x4000, XPD
+0x491c,0xcd74,0x6917,0x8883,0x4000, XPD
+0x935e,0x1776,0xcba9,0xd88e,0x3ffc, XPD
+0xbafd,0x8abb,0x9518,0xd505,0xbff7, XPD
+0xc87e,0x2ed3,0xa84a,0xbed2,0xbff4, XPD
+0x0094,0xa402,0x36b5,0xd5fa,0xbfee, XPD
+0xbc53,0x0fc3,0x1ab2,0x8a2b,0xbfe7, XPD
+0x30b4,0x71c0,0x223d,0xaaed,0xbfdd, XPD
+};
+static short Q3[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0xdfc1,0x8a57,0x357f,0x91ce,0x4000, XPD
+0xcc4f,0x9e03,0x346e,0xf029,0x3ffc, XPD
+0x38b1,0x9788,0x8f42,0xe2a5,0xbff7, XPD
+0xb281,0x2117,0x53da,0xcf51,0xbff4, XPD
+0xf2ab,0x1d42,0x3760,0xe8cf,0xbfee, XPD
+0x741b,0xf14f,0x06b0,0x965b,0xbfe7, XPD
+0x37c2,0xa91f,0x16ea,0xba01,0xbfdd, XPD
+};
+#endif
+#if MIEEE
+static long P3[24] = {
+0x40000000,0x814d1ac7,0x0f3187b2,
+0x40000000,0x88836917,0xcd74491c,
+0x3ffc0000,0xd88ecba9,0x1776935e,
+0xbff70000,0xd5059518,0x8abbbafd,
+0xbff40000,0xbed2a84a,0x2ed3c87e,
+0xbfee0000,0xd5fa36b5,0xa4020094,
+0xbfe70000,0x8a2b1ab2,0x0fc3bc53,
+0xbfdd0000,0xaaed223d,0x71c030b4,
+};
+static long Q3[21] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40000000,0x91ce357f,0x8a57dfc1,
+0x3ffc0000,0xf029346e,0x9e03cc4f,
+0xbff70000,0xe2a58f42,0x978838b1,
+0xbff40000,0xcf5153da,0x2117b281,
+0xbfee0000,0xe8cf3760,0x1d42f2ab,
+0xbfe70000,0x965b06b0,0xf14f741b,
+0xbfdd0000,0xba0116ea,0xa91f37c2,
+};
+#endif
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double logl ( long double );
+extern long double sqrtl ( long double );
+#else
+long double polevll(), p1evll(), logl(), sqrtl();
+#endif
+
+long double ndtril(y0)
+long double y0;
+{
+long double x, y, z, y2, x0, x1;
+int code;
+
+if( y0 <= 0.0L )
+ {
+ mtherr( "ndtril", DOMAIN );
+ return( -MAXNUML );
+ }
+if( y0 >= 1.0L )
+ {
+ mtherr( "ndtri", DOMAIN );
+ return( MAXNUML );
+ }
+code = 1;
+y = y0;
+if( y > (1.0L - 0.13533528323661269189L) ) /* 0.135... = exp(-2) */
+ {
+ y = 1.0L - y;
+ code = 0;
+ }
+
+if( y > 0.13533528323661269189L )
+ {
+ y = y - 0.5L;
+ y2 = y * y;
+ x = y + y * (y2 * polevll( y2, P0, 7 )/p1evll( y2, Q0, 7 ));
+ x = x * s2pi;
+ return(x);
+ }
+
+x = sqrtl( -2.0L * logl(y) );
+x0 = x - logl(x)/x;
+z = 1.0L/x;
+if( x < 8.0L )
+ x1 = z * polevll( z, P1, 9 )/p1evll( z, Q1, 9 );
+else if( x < 32.0L )
+ x1 = z * polevll( z, P2, 7 )/p1evll( z, Q2, 7 );
+else
+ x1 = z * polevll( z, P3, 7 )/p1evll( z, Q3, 7 );
+x = x0 - x1;
+if( code != 0 )
+ x = -x;
+return( x );
+}
diff --git a/libm/ldouble/ndtrl.c b/libm/ldouble/ndtrl.c
new file mode 100644
index 000000000..2c53314a5
--- /dev/null
+++ b/libm/ldouble/ndtrl.c
@@ -0,0 +1,473 @@
+/* ndtrl.c
+ *
+ * Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ndtrl();
+ *
+ * y = ndtrl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the Gaussian probability density
+ * function, integrated from minus infinity to x:
+ *
+ * x
+ * -
+ * 1 | | 2
+ * ndtr(x) = --------- | exp( - t /2 ) dt
+ * sqrt(2pi) | |
+ * -
+ * -inf.
+ *
+ * = ( 1 + erf(z) ) / 2
+ * = erfc(z) / 2
+ *
+ * where z = x/sqrt(2). Computation is via the functions
+ * erf and erfc.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -13,0 30000 1.6e-17 2.9e-18
+ * IEEE -150.7,0 2000 1.6e-15 3.8e-16
+ * Accuracy is limited by error amplification in computing exp(-x^2).
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfcl underflow x^2 / 2 > MAXLOGL 0.0
+ *
+ */
+ /* erfl.c
+ *
+ * Error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, erfl();
+ *
+ * y = erfl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The integral is
+ *
+ * x
+ * -
+ * 2 | | 2
+ * erf(x) = -------- | exp( - t ) dt.
+ * sqrt(pi) | |
+ * -
+ * 0
+ *
+ * The magnitude of x is limited to about 106.56 for IEEE
+ * arithmetic; 1 or -1 is returned outside this range.
+ *
+ * For 0 <= |x| < 1, erf(x) = x * P6(x^2)/Q6(x^2); otherwise
+ * erf(x) = 1 - erfc(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 50000 2.0e-19 5.7e-20
+ *
+ */
+ /* erfcl.c
+ *
+ * Complementary error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, erfcl();
+ *
+ * y = erfcl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * 1 - erf(x) =
+ *
+ * inf.
+ * -
+ * 2 | | 2
+ * erfc(x) = -------- | exp( - t ) dt
+ * sqrt(pi) | |
+ * -
+ * x
+ *
+ *
+ * For small x, erfc(x) = 1 - erf(x); otherwise rational
+ * approximations are computed.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,13 20000 7.0e-18 1.8e-18
+ * IEEE 0,106.56 10000 4.4e-16 1.2e-16
+ * Accuracy is limited by error amplification in computing exp(-x^2).
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfcl underflow x^2 > MAXLOGL 0.0
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.3: January, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+extern long double MAXLOGL;
+static long double SQRTHL = 7.071067811865475244008e-1L;
+
+/* erfc(x) = exp(-x^2) P(1/x)/Q(1/x)
+ 1/8 <= 1/x <= 1
+ Peak relative error 5.8e-21 */
+#if UNK
+static long double P[10] = {
+ 1.130609921802431462353E9L,
+ 2.290171954844785638925E9L,
+ 2.295563412811856278515E9L,
+ 1.448651275892911637208E9L,
+ 6.234814405521647580919E8L,
+ 1.870095071120436715930E8L,
+ 3.833161455208142870198E7L,
+ 4.964439504376477951135E6L,
+ 3.198859502299390825278E5L,
+-9.085943037416544232472E-6L,
+};
+static long double Q[10] = {
+/* 1.000000000000000000000E0L, */
+ 1.130609910594093747762E9L,
+ 3.565928696567031388910E9L,
+ 5.188672873106859049556E9L,
+ 4.588018188918609726890E9L,
+ 2.729005809811924550999E9L,
+ 1.138778654945478547049E9L,
+ 3.358653716579278063988E8L,
+ 6.822450775590265689648E7L,
+ 8.799239977351261077610E6L,
+ 5.669830829076399819566E5L,
+};
+#endif
+#if IBMPC
+static short P[] = {
+0x4bf0,0x9ad8,0x7a03,0x86c7,0x401d, XPD
+0xdf23,0xd843,0x4032,0x8881,0x401e, XPD
+0xd025,0xcfd5,0x8494,0x88d3,0x401e, XPD
+0xb6d0,0xc92b,0x5417,0xacb1,0x401d, XPD
+0xada8,0x356a,0x4982,0x94a6,0x401c, XPD
+0x4e13,0xcaee,0x9e31,0xb258,0x401a, XPD
+0x5840,0x554d,0x37a3,0x9239,0x4018, XPD
+0x3b58,0x3da2,0xaf02,0x9780,0x4015, XPD
+0x0144,0x489e,0xbe68,0x9c31,0x4011, XPD
+0x333b,0xd9e6,0xd404,0x986f,0xbfee, XPD
+};
+static short Q[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0x0e43,0x302d,0x79ed,0x86c7,0x401d, XPD
+0xf817,0x9128,0xc0f8,0xd48b,0x401e, XPD
+0x8eae,0x8dad,0x6eb4,0x9aa2,0x401f, XPD
+0x00e7,0x7595,0xcd06,0x88bb,0x401f, XPD
+0x4991,0xcfda,0x52f1,0xa2a9,0x401e, XPD
+0xc39d,0xe415,0xc43d,0x87c0,0x401d, XPD
+0xa75d,0x436f,0x30dd,0xa027,0x401b, XPD
+0xc4cb,0x305a,0xbf78,0x8220,0x4019, XPD
+0x3708,0x33b1,0x07fa,0x8644,0x4016, XPD
+0x24fa,0x96f6,0x7153,0x8a6c,0x4012, XPD
+};
+#endif
+#if MIEEE
+static long P[30] = {
+0x401d0000,0x86c77a03,0x9ad84bf0,
+0x401e0000,0x88814032,0xd843df23,
+0x401e0000,0x88d38494,0xcfd5d025,
+0x401d0000,0xacb15417,0xc92bb6d0,
+0x401c0000,0x94a64982,0x356aada8,
+0x401a0000,0xb2589e31,0xcaee4e13,
+0x40180000,0x923937a3,0x554d5840,
+0x40150000,0x9780af02,0x3da23b58,
+0x40110000,0x9c31be68,0x489e0144,
+0xbfee0000,0x986fd404,0xd9e6333b,
+};
+static long Q[30] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x401d0000,0x86c779ed,0x302d0e43,
+0x401e0000,0xd48bc0f8,0x9128f817,
+0x401f0000,0x9aa26eb4,0x8dad8eae,
+0x401f0000,0x88bbcd06,0x759500e7,
+0x401e0000,0xa2a952f1,0xcfda4991,
+0x401d0000,0x87c0c43d,0xe415c39d,
+0x401b0000,0xa02730dd,0x436fa75d,
+0x40190000,0x8220bf78,0x305ac4cb,
+0x40160000,0x864407fa,0x33b13708,
+0x40120000,0x8a6c7153,0x96f624fa,
+};
+#endif
+
+/* erfc(x) = exp(-x^2) 1/x R(1/x^2) / S(1/x^2)
+ 1/128 <= 1/x < 1/8
+ Peak relative error 1.9e-21 */
+#if UNK
+static long double R[5] = {
+ 3.621349282255624026891E0L,
+ 7.173690522797138522298E0L,
+ 3.445028155383625172464E0L,
+ 5.537445669807799246891E-1L,
+ 2.697535671015506686136E-2L,
+};
+static long double S[5] = {
+/* 1.000000000000000000000E0L, */
+ 1.072884067182663823072E1L,
+ 1.533713447609627196926E1L,
+ 6.572990478128949439509E0L,
+ 1.005392977603322982436E0L,
+ 4.781257488046430019872E-2L,
+};
+#endif
+#if IBMPC
+static short R[] = {
+0x260a,0xab95,0x2fc7,0xe7c4,0x4000, XPD
+0x4761,0x613e,0xdf6d,0xe58e,0x4001, XPD
+0x0615,0x4b00,0x575f,0xdc7b,0x4000, XPD
+0x521d,0x8527,0x3435,0x8dc2,0x3ffe, XPD
+0x22cf,0xc711,0x6c5b,0xdcfb,0x3ff9, XPD
+};
+static short S[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0x5de6,0x17d7,0x54d6,0xaba9,0x4002, XPD
+0x55d5,0xd300,0xe71e,0xf564,0x4002, XPD
+0xb611,0x8f76,0xf020,0xd255,0x4001, XPD
+0x3684,0x3798,0xb793,0x80b0,0x3fff, XPD
+0xf5af,0x2fb2,0x1e57,0xc3d7,0x3ffa, XPD
+};
+#endif
+#if MIEEE
+static long R[15] = {
+0x40000000,0xe7c42fc7,0xab95260a,
+0x40010000,0xe58edf6d,0x613e4761,
+0x40000000,0xdc7b575f,0x4b000615,
+0x3ffe0000,0x8dc23435,0x8527521d,
+0x3ff90000,0xdcfb6c5b,0xc71122cf,
+};
+static long S[15] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40020000,0xaba954d6,0x17d75de6,
+0x40020000,0xf564e71e,0xd30055d5,
+0x40010000,0xd255f020,0x8f76b611,
+0x3fff0000,0x80b0b793,0x37983684,
+0x3ffa0000,0xc3d71e57,0x2fb2f5af,
+};
+#endif
+
+/* erf(x) = x P(x^2)/Q(x^2)
+ 0 <= x <= 1
+ Peak relative error 7.6e-23 */
+#if UNK
+static long double T[7] = {
+ 1.097496774521124996496E-1L,
+ 5.402980370004774841217E0L,
+ 2.871822526820825849235E2L,
+ 2.677472796799053019985E3L,
+ 4.825977363071025440855E4L,
+ 1.549905740900882313773E5L,
+ 1.104385395713178565288E6L,
+};
+static long double U[6] = {
+/* 1.000000000000000000000E0L, */
+ 4.525777638142203713736E1L,
+ 9.715333124857259246107E2L,
+ 1.245905812306219011252E4L,
+ 9.942956272177178491525E4L,
+ 4.636021778692893773576E5L,
+ 9.787360737578177599571E5L,
+};
+#endif
+#if IBMPC
+static short T[] = {
+0xfd7a,0x3a1a,0x705b,0xe0c4,0x3ffb, XPD
+0x3128,0xc337,0x3716,0xace5,0x4001, XPD
+0x9517,0x4e93,0x540e,0x8f97,0x4007, XPD
+0x6118,0x6059,0x9093,0xa757,0x400a, XPD
+0xb954,0xa987,0xc60c,0xbc83,0x400e, XPD
+0x7a56,0xe45a,0xa4bd,0x975b,0x4010, XPD
+0xc446,0x6bab,0x0b2a,0x86d0,0x4013, XPD
+};
+static short U[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, XPD */
+0x3453,0x1f8e,0xf688,0xb507,0x4004, XPD
+0x71ac,0xb12f,0x21ca,0xf2e2,0x4008, XPD
+0xffe8,0x9cac,0x3b84,0xc2ac,0x400c, XPD
+0x481d,0x445b,0xc807,0xc232,0x400f, XPD
+0x9ad5,0x1aef,0x45b1,0xe25e,0x4011, XPD
+0x71a7,0x1cad,0x012e,0xeef3,0x4012, XPD
+};
+#endif
+#if MIEEE
+static long T[21] = {
+0x3ffb0000,0xe0c4705b,0x3a1afd7a,
+0x40010000,0xace53716,0xc3373128,
+0x40070000,0x8f97540e,0x4e939517,
+0x400a0000,0xa7579093,0x60596118,
+0x400e0000,0xbc83c60c,0xa987b954,
+0x40100000,0x975ba4bd,0xe45a7a56,
+0x40130000,0x86d00b2a,0x6babc446,
+};
+static long U[18] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40040000,0xb507f688,0x1f8e3453,
+0x40080000,0xf2e221ca,0xb12f71ac,
+0x400c0000,0xc2ac3b84,0x9cacffe8,
+0x400f0000,0xc232c807,0x445b481d,
+0x40110000,0xe25e45b1,0x1aef9ad5,
+0x40120000,0xeef3012e,0x1cad71a7,
+};
+#endif
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double expl ( long double );
+extern long double logl ( long double );
+extern long double erfl ( long double );
+extern long double erfcl ( long double );
+extern long double fabsl ( long double );
+#else
+long double polevll(), p1evll(), expl(), logl(), erfl(), erfcl(), fabsl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+
+long double ndtrl(a)
+long double a;
+{
+long double x, y, z;
+
+x = a * SQRTHL;
+z = fabsl(x);
+
+if( z < SQRTHL )
+ y = 0.5L + 0.5L * erfl(x);
+
+else
+ {
+ y = 0.5L * erfcl(z);
+
+ if( x > 0.0L )
+ y = 1.0L - y;
+ }
+
+return(y);
+}
+
+
+long double erfcl(a)
+long double a;
+{
+long double p,q,x,y,z;
+
+#ifdef INFINITIES
+if( a == INFINITYL )
+ return(0.0L);
+if( a == -INFINITYL )
+ return(2.0L);
+#endif
+if( a < 0.0L )
+ x = -a;
+else
+ x = a;
+
+if( x < 1.0L )
+ return( 1.0L - erfl(a) );
+
+z = -a * a;
+
+if( z < -MAXLOGL )
+ {
+under:
+ mtherr( "erfcl", UNDERFLOW );
+ if( a < 0 )
+ return( 2.0L );
+ else
+ return( 0.0L );
+ }
+
+z = expl(z);
+y = 1.0L/x;
+
+if( x < 8.0L )
+ {
+ p = polevll( y, P, 9 );
+ q = p1evll( y, Q, 10 );
+ }
+else
+ {
+ q = y * y;
+ p = y * polevll( q, R, 4 );
+ q = p1evll( q, S, 5 );
+ }
+y = (z * p)/q;
+
+if( a < 0.0L )
+ y = 2.0L - y;
+
+if( y == 0.0L )
+ goto under;
+
+return(y);
+}
+
+
+
+long double erfl(x)
+long double x;
+{
+long double y, z;
+
+#if MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == -INFINITYL )
+ return(-1.0L);
+if( x == INFINITYL )
+ return(1.0L);
+#endif
+if( fabsl(x) > 1.0L )
+ return( 1.0L - erfcl(x) );
+
+z = x * x;
+y = x * polevll( z, T, 6 ) / p1evll( z, U, 6 );
+return( y );
+}
diff --git a/libm/ldouble/pdtrl.c b/libm/ldouble/pdtrl.c
new file mode 100644
index 000000000..861b1d9ae
--- /dev/null
+++ b/libm/ldouble/pdtrl.c
@@ -0,0 +1,184 @@
+/* pdtrl.c
+ *
+ * Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrl();
+ *
+ * y = pdtrl( k, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the first k terms of the Poisson
+ * distribution:
+ *
+ * k j
+ * -- -m m
+ * > e --
+ * -- j!
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the relation
+ *
+ * y = pdtr( k, m ) = igamc( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igamc().
+ *
+ */
+ /* pdtrcl()
+ *
+ * Complemented poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrcl();
+ *
+ * y = pdtrcl( k, m );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the sum of the terms k+1 to infinity of the Poisson
+ * distribution:
+ *
+ * inf. j
+ * -- -m m
+ * > e --
+ * -- j!
+ * j=k+1
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the formula
+ *
+ * y = pdtrc( k, m ) = igam( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igam.c.
+ *
+ */
+ /* pdtril()
+ *
+ * Inverse Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * long double m, y, pdtrl();
+ *
+ * m = pdtril( k, y );
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the Poisson variable x such that the integral
+ * from 0 to x of the Poisson density is equal to the
+ * given probability y.
+ *
+ * This is accomplished using the inverse gamma integral
+ * function and the relation
+ *
+ * m = igami( k+1, y ).
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pdtri domain y < 0 or y >= 1 0.0
+ * k < 0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern long double igaml ( long double, long double );
+extern long double igamcl ( long double, long double );
+extern long double igamil ( long double, long double );
+#else
+long double igaml(), igamcl(), igamil();
+#endif
+
+long double pdtrcl( k, m )
+int k;
+long double m;
+{
+long double v;
+
+if( (k < 0) || (m <= 0.0L) )
+ {
+ mtherr( "pdtrcl", DOMAIN );
+ return( 0.0L );
+ }
+v = k+1;
+return( igaml( v, m ) );
+}
+
+
+
+long double pdtrl( k, m )
+int k;
+long double m;
+{
+long double v;
+
+if( (k < 0) || (m <= 0.0L) )
+ {
+ mtherr( "pdtrl", DOMAIN );
+ return( 0.0L );
+ }
+v = k+1;
+return( igamcl( v, m ) );
+}
+
+
+long double pdtril( k, y )
+int k;
+long double y;
+{
+long double v;
+
+if( (k < 0) || (y < 0.0L) || (y >= 1.0L) )
+ {
+ mtherr( "pdtril", DOMAIN );
+ return( 0.0L );
+ }
+v = k+1;
+v = igamil( v, y );
+return( v );
+}
diff --git a/libm/ldouble/polevll.c b/libm/ldouble/polevll.c
new file mode 100644
index 000000000..ce37c6d9d
--- /dev/null
+++ b/libm/ldouble/polevll.c
@@ -0,0 +1,182 @@
+/* polevll.c
+ * p1evll.c
+ *
+ * Evaluate polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * long double x, y, coef[N+1], polevl[];
+ *
+ * y = polevll( x, coef, N );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates polynomial of degree N:
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N] = C .
+ * N 0
+ *
+ * The function p1evll() assumes that coef[N] = 1.0 and is
+ * omitted from the array. Its calling arguments are
+ * otherwise the same as polevll().
+ *
+ * This module also contains the following globally declared constants:
+ * MAXNUML = 1.189731495357231765021263853E4932L;
+ * MACHEPL = 5.42101086242752217003726400434970855712890625E-20L;
+ * MAXLOGL = 1.1356523406294143949492E4L;
+ * MINLOGL = -1.1355137111933024058873E4L;
+ * LOGE2L = 6.9314718055994530941723E-1L;
+ * LOG2EL = 1.4426950408889634073599E0L;
+ * PIL = 3.1415926535897932384626L;
+ * PIO2L = 1.5707963267948966192313L;
+ * PIO4L = 7.8539816339744830961566E-1L;
+ *
+ * SPEED:
+ *
+ * In the interest of speed, there are no checks for out
+ * of bounds arithmetic. This routine is used by most of
+ * the functions in the library. Depending on available
+ * equipment features, the user may wish to rewrite the
+ * program in microcode or assembly language.
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.2: July, 1992
+Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+#include <math.h>
+
+#if UNK
+/* almost 2^16384 */
+long double MAXNUML = 1.189731495357231765021263853E4932L;
+/* 2^-64 */
+long double MACHEPL = 5.42101086242752217003726400434970855712890625E-20L;
+/* log( MAXNUML ) */
+long double MAXLOGL = 1.1356523406294143949492E4L;
+#ifdef DENORMAL
+/* log(smallest denormal number = 2^-16446) */
+long double MINLOGL = -1.13994985314888605586758E4L;
+#else
+/* log( underflow threshold = 2^(-16382) ) */
+long double MINLOGL = -1.1355137111933024058873E4L;
+#endif
+long double LOGE2L = 6.9314718055994530941723E-1L;
+long double LOG2EL = 1.4426950408889634073599E0L;
+long double PIL = 3.1415926535897932384626L;
+long double PIO2L = 1.5707963267948966192313L;
+long double PIO4L = 7.8539816339744830961566E-1L;
+#ifdef INFINITIES
+long double NANL = 0.0L / 0.0L;
+long double INFINITYL = 1.0L / 0.0L;
+#else
+long double INFINITYL = 1.189731495357231765021263853E4932L;
+long double NANL = 0.0L;
+#endif
+#endif
+#if IBMPC
+short MAXNUML[] = {0xffff,0xffff,0xffff,0xffff,0x7ffe, XPD};
+short MAXLOGL[] = {0x79ab,0xd1cf,0x17f7,0xb172,0x400c, XPD};
+#ifdef INFINITIES
+short INFINITYL[] = {0,0,0,0x8000,0x7fff, XPD};
+short NANL[] = {0,0,0,0xc000,0x7fff, XPD};
+#else
+short INFINITYL[] = {0xffff,0xffff,0xffff,0xffff,0x7ffe, XPD};
+long double NANL = 0.0L;
+#endif
+#ifdef DENORMAL
+short MINLOGL[] = {0xbaaa,0x09e2,0xfe7f,0xb21d,0xc00c, XPD};
+#else
+short MINLOGL[] = {0xeb2f,0x1210,0x8c67,0xb16c,0xc00c, XPD};
+#endif
+short MACHEPL[] = {0x0000,0x0000,0x0000,0x8000,0x3fbf, XPD};
+short LOGE2L[] = {0x79ac,0xd1cf,0x17f7,0xb172,0x3ffe, XPD};
+short LOG2EL[] = {0xf0bc,0x5c17,0x3b29,0xb8aa,0x3fff, XPD};
+short PIL[] = {0xc235,0x2168,0xdaa2,0xc90f,0x4000, XPD};
+short PIO2L[] = {0xc235,0x2168,0xdaa2,0xc90f,0x3fff, XPD};
+short PIO4L[] = {0xc235,0x2168,0xdaa2,0xc90f,0x3ffe, XPD};
+#endif
+#if MIEEE
+long MAXNUML[] = {0x7ffe0000,0xffffffff,0xffffffff};
+long MAXLOGL[] = {0x400c0000,0xb17217f7,0xd1cf79ab};
+#ifdef INFINITIES
+long INFINITY[] = {0x7fff0000,0x80000000,0x00000000};
+long NANL[] = {0x7fff0000,0xffffffff,0xffffffff};
+#else
+long INFINITYL[] = {0x7ffe0000,0xffffffff,0xffffffff};
+long double NANL = 0.0L;
+#endif
+#ifdef DENORMAL
+long MINLOGL[] = {0xc00c0000,0xb21dfe7f,0x09e2baaa};
+#else
+long MINLOGL[] = {0xc00c0000,0xb16c8c67,0x1210eb2f};
+#endif
+long MACHEPL[] = {0x3fbf0000,0x80000000,0x00000000};
+long LOGE2L[] = {0x3ffe0000,0xb17217f7,0xd1cf79ac};
+long LOG2EL[] = {0x3fff0000,0xb8aa3b29,0x5c17f0bc};
+long PIL[] = {0x40000000,0xc90fdaa2,0x2168c235};
+long PIO2L[] = {0x3fff0000,0xc90fdaa2,0x2168c235};
+long PIO4L[] = {0x3ffe0000,0xc90fdaa2,0x2168c235};
+#endif
+
+#ifdef MINUSZERO
+long double NEGZEROL = -0.0L;
+#else
+long double NEGZEROL = 0.0L;
+#endif
+
+/* Polynomial evaluator:
+ * P[0] x^n + P[1] x^(n-1) + ... + P[n]
+ */
+long double polevll( x, p, n )
+long double x;
+void *p;
+int n;
+{
+register long double y;
+register long double *P = (long double *)p;
+
+y = *P++;
+do
+ {
+ y = y * x + *P++;
+ }
+while( --n );
+return(y);
+}
+
+
+
+/* Polynomial evaluator:
+ * x^n + P[0] x^(n-1) + P[1] x^(n-2) + ... + P[n]
+ */
+long double p1evll( x, p, n )
+long double x;
+void *p;
+int n;
+{
+register long double y;
+register long double *P = (long double *)p;
+
+n -= 1;
+y = x + *P++;
+do
+ {
+ y = y * x + *P++;
+ }
+while( --n );
+return( y );
+}
diff --git a/libm/ldouble/powil.c b/libm/ldouble/powil.c
new file mode 100644
index 000000000..d36c7854e
--- /dev/null
+++ b/libm/ldouble/powil.c
@@ -0,0 +1,164 @@
+/* powil.c
+ *
+ * Real raised to integer power, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, powil();
+ * int n;
+ *
+ * y = powil( x, n );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns argument x raised to the nth power.
+ * The routine efficiently decomposes n as a sum of powers of
+ * two. The desired power is a product of two-to-the-kth
+ * powers of x. Thus to compute the 32767 power of x requires
+ * 28 multiplications instead of 32767 multiplications.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error:
+ * arithmetic x domain n domain # trials peak rms
+ * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18
+ * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18
+ * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17
+ *
+ * Returns MAXNUM on overflow, zero on underflow.
+ *
+ */
+
+/* powil.c */
+
+/*
+Cephes Math Library Release 2.2: December, 1990
+Copyright 1984, 1990 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include <math.h>
+extern long double MAXNUML, MAXLOGL, MINLOGL;
+extern long double LOGE2L;
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+#else
+long double frexpl();
+#endif
+
+long double powil( x, nn )
+long double x;
+int nn;
+{
+long double w, y;
+long double s;
+int n, e, sign, asign, lx;
+
+if( x == 0.0L )
+ {
+ if( nn == 0 )
+ return( 1.0L );
+ else if( nn < 0 )
+ return( MAXNUML );
+ else
+ return( 0.0L );
+ }
+
+if( nn == 0 )
+ return( 1.0L );
+
+
+if( x < 0.0L )
+ {
+ asign = -1;
+ x = -x;
+ }
+else
+ asign = 0;
+
+
+if( nn < 0 )
+ {
+ sign = -1;
+ n = -nn;
+ }
+else
+ {
+ sign = 1;
+ n = nn;
+ }
+
+/* Overflow detection */
+
+/* Calculate approximate logarithm of answer */
+s = x;
+s = frexpl( s, &lx );
+e = (lx - 1)*n;
+if( (e == 0) || (e > 64) || (e < -64) )
+ {
+ s = (s - 7.0710678118654752e-1L) / (s + 7.0710678118654752e-1L);
+ s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L;
+ }
+else
+ {
+ s = LOGE2L * e;
+ }
+
+if( s > MAXLOGL )
+ {
+ mtherr( "powil", OVERFLOW );
+ y = MAXNUML;
+ goto done;
+ }
+
+if( s < MINLOGL )
+ {
+ mtherr( "powil", UNDERFLOW );
+ return(0.0L);
+ }
+/* Handle tiny denormal answer, but with less accuracy
+ * since roundoff error in 1.0/x will be amplified.
+ * The precise demarcation should be the gradual underflow threshold.
+ */
+if( s < (-MAXLOGL+2.0L) )
+ {
+ x = 1.0L/x;
+ sign = -sign;
+ }
+
+/* First bit of the power */
+if( n & 1 )
+ y = x;
+
+else
+ {
+ y = 1.0L;
+ asign = 0;
+ }
+
+w = x;
+n >>= 1;
+while( n )
+ {
+ w = w * w; /* arg to the 2-to-the-kth power */
+ if( n & 1 ) /* if that bit is set, then include in product */
+ y *= w;
+ n >>= 1;
+ }
+
+
+done:
+
+if( asign )
+ y = -y; /* odd power of negative number */
+if( sign < 0 )
+ y = 1.0L/y;
+return(y);
+}
diff --git a/libm/ldouble/powl.c b/libm/ldouble/powl.c
new file mode 100644
index 000000000..bad380696
--- /dev/null
+++ b/libm/ldouble/powl.c
@@ -0,0 +1,739 @@
+/* powl.c
+ *
+ * Power function, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, z, powl();
+ *
+ * z = powl( x, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes x raised to the yth power. Analytically,
+ *
+ * x**y = exp( y log(x) ).
+ *
+ * Following Cody and Waite, this program uses a lookup table
+ * of 2**-i/32 and pseudo extended precision arithmetic to
+ * obtain several extra bits of accuracy in both the logarithm
+ * and the exponential.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * The relative error of pow(x,y) can be estimated
+ * by y dl ln(2), where dl is the absolute error of
+ * the internally computed base 2 logarithm. At the ends
+ * of the approximation interval the logarithm equal 1/32
+ * and its relative error is about 1 lsb = 1.1e-19. Hence
+ * the predicted relative error in the result is 2.3e-21 y .
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ *
+ * IEEE +-1000 40000 2.8e-18 3.7e-19
+ * .001 < x < 1000, with log(x) uniformly distributed.
+ * -1000 < y < 1000, y uniformly distributed.
+ *
+ * IEEE 0,8700 60000 6.5e-18 1.0e-18
+ * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pow overflow x**y > MAXNUM INFINITY
+ * pow underflow x**y < 1/MAXNUM 0.0
+ * pow domain x<0 and y noninteger 0.0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+static char fname[] = {"powl"};
+
+/* Table size */
+#define NXT 32
+/* log2(Table size) */
+#define LNXT 5
+
+#ifdef UNK
+/* log(1+x) = x - .5x^2 + x^3 * P(z)/Q(z)
+ * on the domain 2^(-1/32) - 1 <= x <= 2^(1/32) - 1
+ */
+static long double P[] = {
+ 8.3319510773868690346226E-4L,
+ 4.9000050881978028599627E-1L,
+ 1.7500123722550302671919E0L,
+ 1.4000100839971580279335E0L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+ 5.2500282295834889175431E0L,
+ 8.4000598057587009834666E0L,
+ 4.2000302519914740834728E0L,
+};
+/* A[i] = 2^(-i/32), rounded to IEEE long double precision.
+ * If i is even, A[i] + B[i/2] gives additional accuracy.
+ */
+static long double A[33] = {
+ 1.0000000000000000000000E0L,
+ 9.7857206208770013448287E-1L,
+ 9.5760328069857364691013E-1L,
+ 9.3708381705514995065011E-1L,
+ 9.1700404320467123175367E-1L,
+ 8.9735453750155359320742E-1L,
+ 8.7812608018664974155474E-1L,
+ 8.5930964906123895780165E-1L,
+ 8.4089641525371454301892E-1L,
+ 8.2287773907698242225554E-1L,
+ 8.0524516597462715409607E-1L,
+ 7.8799042255394324325455E-1L,
+ 7.7110541270397041179298E-1L,
+ 7.5458221379671136985669E-1L,
+ 7.3841307296974965571198E-1L,
+ 7.2259040348852331001267E-1L,
+ 7.0710678118654752438189E-1L,
+ 6.9195494098191597746178E-1L,
+ 6.7712777346844636413344E-1L,
+ 6.6261832157987064729696E-1L,
+ 6.4841977732550483296079E-1L,
+ 6.3452547859586661129850E-1L,
+ 6.2092890603674202431705E-1L,
+ 6.0762367999023443907803E-1L,
+ 5.9460355750136053334378E-1L,
+ 5.8186242938878875689693E-1L,
+ 5.6939431737834582684856E-1L,
+ 5.5719337129794626814472E-1L,
+ 5.4525386633262882960438E-1L,
+ 5.3357020033841180906486E-1L,
+ 5.2213689121370692017331E-1L,
+ 5.1094857432705833910408E-1L,
+ 5.0000000000000000000000E-1L,
+};
+static long double B[17] = {
+ 0.0000000000000000000000E0L,
+ 2.6176170809902549338711E-20L,
+-1.0126791927256478897086E-20L,
+ 1.3438228172316276937655E-21L,
+ 1.2207982955417546912101E-20L,
+-6.3084814358060867200133E-21L,
+ 1.3164426894366316434230E-20L,
+-1.8527916071632873716786E-20L,
+ 1.8950325588932570796551E-20L,
+ 1.5564775779538780478155E-20L,
+ 6.0859793637556860974380E-21L,
+-2.0208749253662532228949E-20L,
+ 1.4966292219224761844552E-20L,
+ 3.3540909728056476875639E-21L,
+-8.6987564101742849540743E-22L,
+-1.2327176863327626135542E-20L,
+ 0.0000000000000000000000E0L,
+};
+
+/* 2^x = 1 + x P(x),
+ * on the interval -1/32 <= x <= 0
+ */
+static long double R[] = {
+ 1.5089970579127659901157E-5L,
+ 1.5402715328927013076125E-4L,
+ 1.3333556028915671091390E-3L,
+ 9.6181291046036762031786E-3L,
+ 5.5504108664798463044015E-2L,
+ 2.4022650695910062854352E-1L,
+ 6.9314718055994530931447E-1L,
+};
+
+#define douba(k) A[k]
+#define doubb(k) B[k]
+#define MEXP (NXT*16384.0L)
+/* The following if denormal numbers are supported, else -MEXP: */
+#ifdef DENORMAL
+#define MNEXP (-NXT*(16384.0L+64.0L))
+#else
+#define MNEXP (-NXT*16384.0L)
+#endif
+/* log2(e) - 1 */
+#define LOG2EA 0.44269504088896340735992L
+#endif
+
+
+#ifdef IBMPC
+static short P[] = {
+0xb804,0xa8b7,0xc6f4,0xda6a,0x3ff4, XPD
+0x7de9,0xcf02,0x58c0,0xfae1,0x3ffd, XPD
+0x405a,0x3722,0x67c9,0xe000,0x3fff, XPD
+0xcd99,0x6b43,0x87ca,0xb333,0x3fff, XPD
+};
+static short Q[] = {
+/* 0x0000,0x0000,0x0000,0x8000,0x3fff, */
+0x6307,0xa469,0x3b33,0xa800,0x4001, XPD
+0xfec2,0x62d7,0xa51c,0x8666,0x4002, XPD
+0xda32,0xd072,0xa5d7,0x8666,0x4001, XPD
+};
+static short A[] = {
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+0x033a,0x722a,0xb2db,0xfa83,0x3ffe, XPD
+0xcc2c,0x2486,0x7d15,0xf525,0x3ffe, XPD
+0xf5cb,0xdcda,0xb99b,0xefe4,0x3ffe, XPD
+0x392f,0xdd24,0xc6e7,0xeac0,0x3ffe, XPD
+0x48a8,0x7c83,0x06e7,0xe5b9,0x3ffe, XPD
+0xe111,0x2a94,0xdeec,0xe0cc,0x3ffe, XPD
+0x3755,0xdaf2,0xb797,0xdbfb,0x3ffe, XPD
+0x6af4,0xd69d,0xfcca,0xd744,0x3ffe, XPD
+0xe45a,0xf12a,0x1d91,0xd2a8,0x3ffe, XPD
+0x80e4,0x1f84,0x8c15,0xce24,0x3ffe, XPD
+0x27a3,0x6e2f,0xbd86,0xc9b9,0x3ffe, XPD
+0xdadd,0x5506,0x2a11,0xc567,0x3ffe, XPD
+0x9456,0x6670,0x4cca,0xc12c,0x3ffe, XPD
+0x36bf,0x580c,0xa39f,0xbd08,0x3ffe, XPD
+0x9ee9,0x62fb,0xaf47,0xb8fb,0x3ffe, XPD
+0x6484,0xf9de,0xf333,0xb504,0x3ffe, XPD
+0x2590,0xd2ac,0xf581,0xb123,0x3ffe, XPD
+0x4ac6,0x42a1,0x3eea,0xad58,0x3ffe, XPD
+0x0ef8,0xea7c,0x5ab4,0xa9a1,0x3ffe, XPD
+0x38ea,0xb151,0xd6a9,0xa5fe,0x3ffe, XPD
+0x6819,0x0c49,0x4303,0xa270,0x3ffe, XPD
+0x11ae,0x91a1,0x3260,0x9ef5,0x3ffe, XPD
+0x5539,0xd54e,0x39b9,0x9b8d,0x3ffe, XPD
+0xa96f,0x8db8,0xf051,0x9837,0x3ffe, XPD
+0x0961,0xfef7,0xefa8,0x94f4,0x3ffe, XPD
+0xc336,0xab11,0xd373,0x91c3,0x3ffe, XPD
+0x53c0,0x45cd,0x398b,0x8ea4,0x3ffe, XPD
+0xd6e7,0xea8b,0xc1e3,0x8b95,0x3ffe, XPD
+0x8527,0x92da,0x0e80,0x8898,0x3ffe, XPD
+0x7b15,0xcc48,0xc367,0x85aa,0x3ffe, XPD
+0xa1d7,0xac2b,0x8698,0x82cd,0x3ffe, XPD
+0x0000,0x0000,0x0000,0x8000,0x3ffe, XPD
+};
+static short B[] = {
+0x0000,0x0000,0x0000,0x0000,0x0000, XPD
+0x1f87,0xdb30,0x18f5,0xf73a,0x3fbd, XPD
+0xac15,0x3e46,0x2932,0xbf4a,0xbfbc, XPD
+0x7944,0xba66,0xa091,0xcb12,0x3fb9, XPD
+0xff78,0x40b4,0x2ee6,0xe69a,0x3fbc, XPD
+0xc895,0x5069,0xe383,0xee53,0xbfbb, XPD
+0x7cde,0x9376,0x4325,0xf8ab,0x3fbc, XPD
+0xa10c,0x25e0,0xc093,0xaefd,0xbfbd, XPD
+0x7d3e,0xea95,0x1366,0xb2fb,0x3fbd, XPD
+0x5d89,0xeb34,0x5191,0x9301,0x3fbd, XPD
+0x80d9,0xb883,0xfb10,0xe5eb,0x3fbb, XPD
+0x045d,0x288c,0xc1ec,0xbedd,0xbfbd, XPD
+0xeded,0x5c85,0x4630,0x8d5a,0x3fbd, XPD
+0x9d82,0xe5ac,0x8e0a,0xfd6d,0x3fba, XPD
+0x6dfd,0xeb58,0xaf14,0x8373,0xbfb9, XPD
+0xf938,0x7aac,0x91cf,0xe8da,0xbfbc, XPD
+0x0000,0x0000,0x0000,0x0000,0x0000, XPD
+};
+static short R[] = {
+0xa69b,0x530e,0xee1d,0xfd2a,0x3fee, XPD
+0xc746,0x8e7e,0x5960,0xa182,0x3ff2, XPD
+0x63b6,0xadda,0xfd6a,0xaec3,0x3ff5, XPD
+0xc104,0xfd99,0x5b7c,0x9d95,0x3ff8, XPD
+0xe05e,0x249d,0x46b8,0xe358,0x3ffa, XPD
+0x5d1d,0x162c,0xeffc,0xf5fd,0x3ffc, XPD
+0x79aa,0xd1cf,0x17f7,0xb172,0x3ffe, XPD
+};
+
+/* 10 byte sizes versus 12 byte */
+#define douba(k) (*(long double *)(&A[(sizeof( long double )/2)*(k)]))
+#define doubb(k) (*(long double *)(&B[(sizeof( long double )/2)*(k)]))
+#define MEXP (NXT*16384.0L)
+#ifdef DENORMAL
+#define MNEXP (-NXT*(16384.0L+64.0L))
+#else
+#define MNEXP (-NXT*16384.0L)
+#endif
+static short L[] = {0xc2ef,0x705f,0xeca5,0xe2a8,0x3ffd, XPD};
+#define LOG2EA (*(long double *)(&L[0]))
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3ff40000,0xda6ac6f4,0xa8b7b804,
+0x3ffd0000,0xfae158c0,0xcf027de9,
+0x3fff0000,0xe00067c9,0x3722405a,
+0x3fff0000,0xb33387ca,0x6b43cd99,
+};
+static long Q[] = {
+/* 0x3fff0000,0x80000000,0x00000000, */
+0x40010000,0xa8003b33,0xa4696307,
+0x40020000,0x8666a51c,0x62d7fec2,
+0x40010000,0x8666a5d7,0xd072da32,
+};
+static long A[] = {
+0x3fff0000,0x80000000,0x00000000,
+0x3ffe0000,0xfa83b2db,0x722a033a,
+0x3ffe0000,0xf5257d15,0x2486cc2c,
+0x3ffe0000,0xefe4b99b,0xdcdaf5cb,
+0x3ffe0000,0xeac0c6e7,0xdd24392f,
+0x3ffe0000,0xe5b906e7,0x7c8348a8,
+0x3ffe0000,0xe0ccdeec,0x2a94e111,
+0x3ffe0000,0xdbfbb797,0xdaf23755,
+0x3ffe0000,0xd744fcca,0xd69d6af4,
+0x3ffe0000,0xd2a81d91,0xf12ae45a,
+0x3ffe0000,0xce248c15,0x1f8480e4,
+0x3ffe0000,0xc9b9bd86,0x6e2f27a3,
+0x3ffe0000,0xc5672a11,0x5506dadd,
+0x3ffe0000,0xc12c4cca,0x66709456,
+0x3ffe0000,0xbd08a39f,0x580c36bf,
+0x3ffe0000,0xb8fbaf47,0x62fb9ee9,
+0x3ffe0000,0xb504f333,0xf9de6484,
+0x3ffe0000,0xb123f581,0xd2ac2590,
+0x3ffe0000,0xad583eea,0x42a14ac6,
+0x3ffe0000,0xa9a15ab4,0xea7c0ef8,
+0x3ffe0000,0xa5fed6a9,0xb15138ea,
+0x3ffe0000,0xa2704303,0x0c496819,
+0x3ffe0000,0x9ef53260,0x91a111ae,
+0x3ffe0000,0x9b8d39b9,0xd54e5539,
+0x3ffe0000,0x9837f051,0x8db8a96f,
+0x3ffe0000,0x94f4efa8,0xfef70961,
+0x3ffe0000,0x91c3d373,0xab11c336,
+0x3ffe0000,0x8ea4398b,0x45cd53c0,
+0x3ffe0000,0x8b95c1e3,0xea8bd6e7,
+0x3ffe0000,0x88980e80,0x92da8527,
+0x3ffe0000,0x85aac367,0xcc487b15,
+0x3ffe0000,0x82cd8698,0xac2ba1d7,
+0x3ffe0000,0x80000000,0x00000000,
+};
+static long B[51] = {
+0x00000000,0x00000000,0x00000000,
+0x3fbd0000,0xf73a18f5,0xdb301f87,
+0xbfbc0000,0xbf4a2932,0x3e46ac15,
+0x3fb90000,0xcb12a091,0xba667944,
+0x3fbc0000,0xe69a2ee6,0x40b4ff78,
+0xbfbb0000,0xee53e383,0x5069c895,
+0x3fbc0000,0xf8ab4325,0x93767cde,
+0xbfbd0000,0xaefdc093,0x25e0a10c,
+0x3fbd0000,0xb2fb1366,0xea957d3e,
+0x3fbd0000,0x93015191,0xeb345d89,
+0x3fbb0000,0xe5ebfb10,0xb88380d9,
+0xbfbd0000,0xbeddc1ec,0x288c045d,
+0x3fbd0000,0x8d5a4630,0x5c85eded,
+0x3fba0000,0xfd6d8e0a,0xe5ac9d82,
+0xbfb90000,0x8373af14,0xeb586dfd,
+0xbfbc0000,0xe8da91cf,0x7aacf938,
+0x00000000,0x00000000,0x00000000,
+};
+static long R[] = {
+0x3fee0000,0xfd2aee1d,0x530ea69b,
+0x3ff20000,0xa1825960,0x8e7ec746,
+0x3ff50000,0xaec3fd6a,0xadda63b6,
+0x3ff80000,0x9d955b7c,0xfd99c104,
+0x3ffa0000,0xe35846b8,0x249de05e,
+0x3ffc0000,0xf5fdeffc,0x162c5d1d,
+0x3ffe0000,0xb17217f7,0xd1cf79aa,
+};
+
+#define douba(k) (*(long double *)&A[3*(k)])
+#define doubb(k) (*(long double *)&B[3*(k)])
+#define MEXP (NXT*16384.0L)
+#ifdef DENORMAL
+#define MNEXP (-NXT*(16384.0L+64.0L))
+#else
+#define MNEXP (-NXT*16382.0L)
+#endif
+static long L[3] = {0x3ffd0000,0xe2a8eca5,0x705fc2ef};
+#define LOG2EA (*(long double *)(&L[0]))
+#endif
+
+
+#define F W
+#define Fa Wa
+#define Fb Wb
+#define G W
+#define Ga Wa
+#define Gb u
+#define H W
+#define Ha Wb
+#define Hb Wb
+
+extern long double MAXNUML;
+static VOLATILE long double z;
+static long double w, W, Wa, Wb, ya, yb, u;
+#ifdef ANSIPROT
+extern long double floorl ( long double );
+extern long double fabsl ( long double );
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double powil ( long double, int );
+extern int isnanl ( long double );
+extern int isfinitel ( long double );
+static long double reducl( long double );
+extern int signbitl ( long double );
+#else
+long double floorl(), fabsl(), frexpl(), ldexpl();
+long double polevll(), p1evll(), powil();
+static long double reducl();
+int isnanl(), isfinitel(), signbitl();
+#endif
+
+#ifdef INFINITIES
+extern long double INFINITYL;
+#else
+#define INFINITYL MAXNUML
+#endif
+
+#ifdef NANS
+extern long double NANL;
+#endif
+#ifdef MINUSZERO
+extern long double NEGZEROL;
+#endif
+
+long double powl( x, y )
+long double x, y;
+{
+/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */
+int i, nflg, iyflg, yoddint;
+long e;
+
+if( y == 0.0L )
+ return( 1.0L );
+
+#ifdef NANS
+if( isnanl(x) )
+ return( x );
+if( isnanl(y) )
+ return( y );
+#endif
+
+if( y == 1.0L )
+ return( x );
+
+#ifdef INFINITIES
+if( !isfinitel(y) && (x == -1.0L || x == 1.0L) )
+ {
+ mtherr( "powl", DOMAIN );
+#ifdef NANS
+ return( NANL );
+#else
+ return( INFINITYL );
+#endif
+ }
+#endif
+
+if( x == 1.0L )
+ return( 1.0L );
+
+if( y >= MAXNUML )
+ {
+#ifdef INFINITIES
+ if( x > 1.0L )
+ return( INFINITYL );
+#else
+ if( x > 1.0L )
+ return( MAXNUML );
+#endif
+ if( x > 0.0L && x < 1.0L )
+ return( 0.0L );
+#ifdef INFINITIES
+ if( x < -1.0L )
+ return( INFINITYL );
+#else
+ if( x < -1.0L )
+ return( MAXNUML );
+#endif
+ if( x > -1.0L && x < 0.0L )
+ return( 0.0L );
+ }
+if( y <= -MAXNUML )
+ {
+ if( x > 1.0L )
+ return( 0.0L );
+#ifdef INFINITIES
+ if( x > 0.0L && x < 1.0L )
+ return( INFINITYL );
+#else
+ if( x > 0.0L && x < 1.0L )
+ return( MAXNUML );
+#endif
+ if( x < -1.0L )
+ return( 0.0L );
+#ifdef INFINITIES
+ if( x > -1.0L && x < 0.0L )
+ return( INFINITYL );
+#else
+ if( x > -1.0L && x < 0.0L )
+ return( MAXNUML );
+#endif
+ }
+if( x >= MAXNUML )
+ {
+#if INFINITIES
+ if( y > 0.0L )
+ return( INFINITYL );
+#else
+ if( y > 0.0L )
+ return( MAXNUML );
+#endif
+ return( 0.0L );
+ }
+
+w = floorl(y);
+/* Set iyflg to 1 if y is an integer. */
+iyflg = 0;
+if( w == y )
+ iyflg = 1;
+
+/* Test for odd integer y. */
+yoddint = 0;
+if( iyflg )
+ {
+ ya = fabsl(y);
+ ya = floorl(0.5L * ya);
+ yb = 0.5L * fabsl(w);
+ if( ya != yb )
+ yoddint = 1;
+ }
+
+if( x <= -MAXNUML )
+ {
+ if( y > 0.0L )
+ {
+#ifdef INFINITIES
+ if( yoddint )
+ return( -INFINITYL );
+ return( INFINITYL );
+#else
+ if( yoddint )
+ return( -MAXNUML );
+ return( MAXNUML );
+#endif
+ }
+ if( y < 0.0L )
+ {
+#ifdef MINUSZERO
+ if( yoddint )
+ return( NEGZEROL );
+#endif
+ return( 0.0 );
+ }
+ }
+
+
+nflg = 0; /* flag = 1 if x<0 raised to integer power */
+if( x <= 0.0L )
+ {
+ if( x == 0.0L )
+ {
+ if( y < 0.0 )
+ {
+#ifdef MINUSZERO
+ if( signbitl(x) && yoddint )
+ return( -INFINITYL );
+#endif
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ return( MAXNUML );
+#endif
+ }
+ if( y > 0.0 )
+ {
+#ifdef MINUSZERO
+ if( signbitl(x) && yoddint )
+ return( NEGZEROL );
+#endif
+ return( 0.0 );
+ }
+ if( y == 0.0L )
+ return( 1.0L ); /* 0**0 */
+ else
+ return( 0.0L ); /* 0**y */
+ }
+ else
+ {
+ if( iyflg == 0 )
+ { /* noninteger power of negative number */
+ mtherr( fname, DOMAIN );
+#ifdef NANS
+ return(NANL);
+#else
+ return(0.0L);
+#endif
+ }
+ nflg = 1;
+ }
+ }
+
+/* Integer power of an integer. */
+
+if( iyflg )
+ {
+ i = w;
+ w = floorl(x);
+ if( (w == x) && (fabsl(y) < 32768.0) )
+ {
+ w = powil( x, (int) y );
+ return( w );
+ }
+ }
+
+
+if( nflg )
+ x = fabsl(x);
+
+/* separate significand from exponent */
+x = frexpl( x, &i );
+e = i;
+
+/* find significand in antilog table A[] */
+i = 1;
+if( x <= douba(17) )
+ i = 17;
+if( x <= douba(i+8) )
+ i += 8;
+if( x <= douba(i+4) )
+ i += 4;
+if( x <= douba(i+2) )
+ i += 2;
+if( x >= douba(1) )
+ i = -1;
+i += 1;
+
+
+/* Find (x - A[i])/A[i]
+ * in order to compute log(x/A[i]):
+ *
+ * log(x) = log( a x/a ) = log(a) + log(x/a)
+ *
+ * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a
+ */
+x -= douba(i);
+x -= doubb(i/2);
+x /= douba(i);
+
+
+/* rational approximation for log(1+v):
+ *
+ * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v)
+ */
+z = x*x;
+w = x * ( z * polevll( x, P, 3 ) / p1evll( x, Q, 3 ) );
+w = w - ldexpl( z, -1 ); /* w - 0.5 * z */
+
+/* Convert to base 2 logarithm:
+ * multiply by log2(e) = 1 + LOG2EA
+ */
+z = LOG2EA * w;
+z += w;
+z += LOG2EA * x;
+z += x;
+
+/* Compute exponent term of the base 2 logarithm. */
+w = -i;
+w = ldexpl( w, -LNXT ); /* divide by NXT */
+w += e;
+/* Now base 2 log of x is w + z. */
+
+/* Multiply base 2 log by y, in extended precision. */
+
+/* separate y into large part ya
+ * and small part yb less than 1/NXT
+ */
+ya = reducl(y);
+yb = y - ya;
+
+/* (w+z)(ya+yb)
+ * = w*ya + w*yb + z*y
+ */
+F = z * y + w * yb;
+Fa = reducl(F);
+Fb = F - Fa;
+
+G = Fa + w * ya;
+Ga = reducl(G);
+Gb = G - Ga;
+
+H = Fb + Gb;
+Ha = reducl(H);
+w = ldexpl( Ga+Ha, LNXT );
+
+/* Test the power of 2 for overflow */
+if( w > MEXP )
+ {
+/* printf( "w = %.4Le ", w ); */
+ mtherr( fname, OVERFLOW );
+ return( MAXNUML );
+ }
+
+if( w < MNEXP )
+ {
+/* printf( "w = %.4Le ", w ); */
+ mtherr( fname, UNDERFLOW );
+ return( 0.0L );
+ }
+
+e = w;
+Hb = H - Ha;
+
+if( Hb > 0.0L )
+ {
+ e += 1;
+ Hb -= (1.0L/NXT); /*0.0625L;*/
+ }
+
+/* Now the product y * log2(x) = Hb + e/NXT.
+ *
+ * Compute base 2 exponential of Hb,
+ * where -0.0625 <= Hb <= 0.
+ */
+z = Hb * polevll( Hb, R, 6 ); /* z = 2**Hb - 1 */
+
+/* Express e/NXT as an integer plus a negative number of (1/NXT)ths.
+ * Find lookup table entry for the fractional power of 2.
+ */
+if( e < 0 )
+ i = 0;
+else
+ i = 1;
+i = e/NXT + i;
+e = NXT*i - e;
+w = douba( e );
+z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */
+z = z + w;
+z = ldexpl( z, i ); /* multiply by integer power of 2 */
+
+if( nflg )
+ {
+/* For negative x,
+ * find out if the integer exponent
+ * is odd or even.
+ */
+ w = ldexpl( y, -1 );
+ w = floorl(w);
+ w = ldexpl( w, 1 );
+ if( w != y )
+ z = -z; /* odd exponent */
+ }
+
+return( z );
+}
+
+
+/* Find a multiple of 1/NXT that is within 1/NXT of x. */
+static long double reducl(x)
+long double x;
+{
+long double t;
+
+t = ldexpl( x, LNXT );
+t = floorl( t );
+t = ldexpl( t, -LNXT );
+return(t);
+}
diff --git a/libm/ldouble/sinhl.c b/libm/ldouble/sinhl.c
new file mode 100644
index 000000000..0533a1c7a
--- /dev/null
+++ b/libm/ldouble/sinhl.c
@@ -0,0 +1,150 @@
+/* sinhl.c
+ *
+ * Hyperbolic sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sinhl();
+ *
+ * y = sinhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic sine of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * The range is partitioned into two segments. If |x| <= 1, a
+ * rational function of the form x + x**3 P(x)/Q(x) is employed.
+ * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -2,2 10000 1.5e-19 3.9e-20
+ * IEEE +-10000 30000 1.1e-19 2.8e-20
+ *
+ */
+
+/*
+Cephes Math Library Release 2.7: January, 1998
+Copyright 1984, 1991, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+ 1.7550769032975377032681E-6L,
+ 4.1680702175874268714539E-4L,
+ 3.0993532520425419002409E-2L,
+ 9.9999999999999999998002E-1L,
+};
+static long double Q[] = {
+ 1.7453965448620151484660E-8L,
+-5.9116673682651952419571E-6L,
+ 1.0599252315677389339530E-3L,
+-1.1403880487744749056675E-1L,
+ 6.0000000000000000000200E0L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0xec6a,0xd942,0xfbb3,0xeb8f,0x3feb, XPD
+0x365e,0xb30a,0xe437,0xda86,0x3ff3, XPD
+0x8890,0x01f6,0x2612,0xfde6,0x3ff9, XPD
+0x0000,0x0000,0x0000,0x8000,0x3fff, XPD
+};
+static short Q[] = {
+0x4edd,0x4c21,0xad09,0x95ed,0x3fe5, XPD
+0x4376,0x9b70,0xd605,0xc65c,0xbfed, XPD
+0xc8ad,0x5d21,0x3069,0x8aed,0x3ff5, XPD
+0x9c32,0x6374,0x2d4b,0xe98d,0xbffb, XPD
+0x0000,0x0000,0x0000,0xc000,0x4001, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0x3feb0000,0xeb8ffbb3,0xd942ec6a,
+0x3ff30000,0xda86e437,0xb30a365e,
+0x3ff90000,0xfde62612,0x01f68890,
+0x3fff0000,0x80000000,0x00000000,
+};
+static long Q[] = {
+0x3fe50000,0x95edad09,0x4c214edd,
+0xbfed0000,0xc65cd605,0x9b704376,
+0x3ff50000,0x8aed3069,0x5d21c8ad,
+0xbffb0000,0xe98d2d4b,0x63749c32,
+0x40010000,0xc0000000,0x00000000,
+};
+#endif
+
+extern long double MAXNUML, MAXLOGL, MINLOGL, LOGE2L;
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double expl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+#else
+long double fabsl(), expl(), polevll(), p1evll();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double sinhl(x)
+long double x;
+{
+long double a;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+a = fabsl(x);
+if( (x > (MAXLOGL + LOGE2L)) || (x > -(MINLOGL-LOGE2L) ) )
+ {
+ mtherr( "sinhl", DOMAIN );
+#ifdef INFINITIES
+ if( x > 0.0L )
+ return( INFINITYL );
+ else
+ return( -INFINITYL );
+#else
+ if( x > 0.0L )
+ return( MAXNUML );
+ else
+ return( -MAXNUML );
+#endif
+ }
+if( a > 1.0L )
+ {
+ if( a >= (MAXLOGL - LOGE2L) )
+ {
+ a = expl(0.5L*a);
+ a = (0.5L * a) * a;
+ if( x < 0.0L )
+ a = -a;
+ return(a);
+ }
+ a = expl(a);
+ a = 0.5L*a - (0.5L/a);
+ if( x < 0.0L )
+ a = -a;
+ return(a);
+ }
+
+a *= a;
+return( x + x * a * (polevll(a,P,3)/polevll(a,Q,4)) );
+}
diff --git a/libm/ldouble/sinl.c b/libm/ldouble/sinl.c
new file mode 100644
index 000000000..dc7d739f9
--- /dev/null
+++ b/libm/ldouble/sinl.c
@@ -0,0 +1,342 @@
+/* sinl.c
+ *
+ * Circular sine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sinl();
+ *
+ * y = sinl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Range reduction is into intervals of pi/4. The reduction
+ * error is nearly eliminated by contriving an extended precision
+ * modular arithmetic.
+ *
+ * Two polynomial approximating functions are employed.
+ * Between 0 and pi/4 the sine is approximated by the Cody
+ * and Waite polynomial form
+ * x + x**3 P(x**2) .
+ * Between pi/4 and pi/2 the cosine is represented as
+ * 1 - .5 x**2 + x**4 Q(x**2) .
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-5.5e11 200,000 1.2e-19 2.9e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sin total loss x > 2**39 0.0
+ *
+ * Loss of precision occurs for x > 2**39 = 5.49755813888e11.
+ * The routine as implemented flags a TLOSS error for
+ * x > 2**39 and returns 0.0.
+ */
+ /* cosl.c
+ *
+ * Circular cosine, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cosl();
+ *
+ * y = cosl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Range reduction is into intervals of pi/4. The reduction
+ * error is nearly eliminated by contriving an extended precision
+ * modular arithmetic.
+ *
+ * Two polynomial approximating functions are employed.
+ * Between 0 and pi/4 the cosine is approximated by
+ * 1 - .5 x**2 + x**4 Q(x**2) .
+ * Between pi/4 and pi/2 the sine is represented by the Cody
+ * and Waite polynomial form
+ * x + x**3 P(x**2) .
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-5.5e11 50000 1.2e-19 2.9e-20
+ */
+
+/* sin.c */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1985, 1990, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double sincof[7] = {
+-7.5785404094842805756289E-13L,
+ 1.6058363167320443249231E-10L,
+-2.5052104881870868784055E-8L,
+ 2.7557319214064922217861E-6L,
+-1.9841269841254799668344E-4L,
+ 8.3333333333333225058715E-3L,
+-1.6666666666666666640255E-1L,
+};
+static long double coscof[7] = {
+ 4.7377507964246204691685E-14L,
+-1.1470284843425359765671E-11L,
+ 2.0876754287081521758361E-9L,
+-2.7557319214999787979814E-7L,
+ 2.4801587301570552304991E-5L,
+-1.3888888888888872993737E-3L,
+ 4.1666666666666666609054E-2L,
+};
+static long double DP1 = 7.853981554508209228515625E-1L;
+static long double DP2 = 7.946627356147928367136046290398E-9L;
+static long double DP3 = 3.061616997868382943065164830688E-17L;
+#endif
+
+#ifdef IBMPC
+static short sincof[] = {
+0x4e27,0xe1d6,0x2389,0xd551,0xbfd6, XPD
+0x64d7,0xe706,0x4623,0xb090,0x3fde, XPD
+0x01b1,0xbf34,0x2946,0xd732,0xbfe5, XPD
+0xc8f7,0x9845,0x1d29,0xb8ef,0x3fec, XPD
+0x6514,0x0c53,0x00d0,0xd00d,0xbff2, XPD
+0x569a,0x8888,0x8888,0x8888,0x3ff8, XPD
+0xaa97,0xaaaa,0xaaaa,0xaaaa,0xbffc, XPD
+};
+static short coscof[] = {
+0x7436,0x6f99,0x8c3a,0xd55e,0x3fd2, XPD
+0x2f37,0x58f4,0x920f,0xc9c9,0xbfda, XPD
+0x5350,0x659e,0xc648,0x8f76,0x3fe2, XPD
+0x4d2b,0xf5c6,0x7dba,0x93f2,0xbfe9, XPD
+0x53ed,0x0c66,0x00d0,0xd00d,0x3fef, XPD
+0x7b67,0x0b60,0x60b6,0xb60b,0xbff5, XPD
+0xaa9a,0xaaaa,0xaaaa,0xaaaa,0x3ffa, XPD
+};
+static short P1[] = {0x0000,0x0000,0xda80,0xc90f,0x3ffe, XPD};
+static short P2[] = {0x0000,0x0000,0xa300,0x8885,0x3fe4, XPD};
+static short P3[] = {0x3707,0xa2e0,0x3198,0x8d31,0x3fc8, XPD};
+#define DP1 *(long double *)P1
+#define DP2 *(long double *)P2
+#define DP3 *(long double *)P3
+#endif
+
+#ifdef MIEEE
+static long sincof[] = {
+0xbfd60000,0xd5512389,0xe1d64e27,
+0x3fde0000,0xb0904623,0xe70664d7,
+0xbfe50000,0xd7322946,0xbf3401b1,
+0x3fec0000,0xb8ef1d29,0x9845c8f7,
+0xbff20000,0xd00d00d0,0x0c536514,
+0x3ff80000,0x88888888,0x8888569a,
+0xbffc0000,0xaaaaaaaa,0xaaaaaa97,
+};
+static long coscof[] = {
+0x3fd20000,0xd55e8c3a,0x6f997436,
+0xbfda0000,0xc9c9920f,0x58f42f37,
+0x3fe20000,0x8f76c648,0x659e5350,
+0xbfe90000,0x93f27dba,0xf5c64d2b,
+0x3fef0000,0xd00d00d0,0x0c6653ed,
+0xbff50000,0xb60b60b6,0x0b607b67,
+0x3ffa0000,0xaaaaaaaa,0xaaaaaa9a,
+};
+static long P1[] = {0x3ffe0000,0xc90fda80,0x00000000};
+static long P2[] = {0x3fe40000,0x8885a300,0x00000000};
+static long P3[] = {0x3fc80000,0x8d313198,0xa2e03707};
+#define DP1 *(long double *)P1
+#define DP2 *(long double *)P2
+#define DP3 *(long double *)P3
+#endif
+
+static long double lossth = 5.49755813888e11L; /* 2^39 */
+extern long double PIO4L;
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double floorl ( long double );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+extern int isfinitel ( long double );
+#else
+long double polevll(), floorl(), ldexpl(), isnanl(), isfinitel();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double sinl(x)
+long double x;
+{
+long double y, z, zz;
+int j, sign;
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+#ifdef NANS
+if( !isfinitel(x) )
+ {
+ mtherr( "sinl", DOMAIN );
+#ifdef NANS
+ return(NANL);
+#else
+ return(0.0L);
+#endif
+ }
+#endif
+/* make argument positive but save the sign */
+sign = 1;
+if( x < 0 )
+ {
+ x = -x;
+ sign = -1;
+ }
+
+if( x > lossth )
+ {
+ mtherr( "sinl", TLOSS );
+ return(0.0L);
+ }
+
+y = floorl( x/PIO4L ); /* integer part of x/PIO4 */
+
+/* strip high bits of integer part to prevent integer overflow */
+z = ldexpl( y, -4 );
+z = floorl(z); /* integer part of y/8 */
+z = y - ldexpl( z, 4 ); /* y - 16 * (y/16) */
+
+j = z; /* convert to integer for tests on the phase angle */
+/* map zeros to origin */
+if( j & 1 )
+ {
+ j += 1;
+ y += 1.0L;
+ }
+j = j & 07; /* octant modulo 360 degrees */
+/* reflect in x axis */
+if( j > 3)
+ {
+ sign = -sign;
+ j -= 4;
+ }
+
+/* Extended precision modular arithmetic */
+z = ((x - y * DP1) - y * DP2) - y * DP3;
+
+zz = z * z;
+if( (j==1) || (j==2) )
+ {
+ y = 1.0L - ldexpl(zz,-1) + zz * zz * polevll( zz, coscof, 6 );
+ }
+else
+ {
+ y = z + z * (zz * polevll( zz, sincof, 6 ));
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
+
+
+
+
+
+long double cosl(x)
+long double x;
+{
+long double y, z, zz;
+long i;
+int j, sign;
+
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( !isfinitel(x) )
+ {
+ mtherr( "cosl", DOMAIN );
+#ifdef NANS
+ return(NANL);
+#else
+ return(0.0L);
+#endif
+ }
+#endif
+
+/* make argument positive */
+sign = 1;
+if( x < 0 )
+ x = -x;
+
+if( x > lossth )
+ {
+ mtherr( "cosl", TLOSS );
+ return(0.0L);
+ }
+
+y = floorl( x/PIO4L );
+z = ldexpl( y, -4 );
+z = floorl(z); /* integer part of y/8 */
+z = y - ldexpl( z, 4 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+i = z;
+if( i & 1 ) /* map zeros to origin */
+ {
+ i += 1;
+ y += 1.0L;
+ }
+j = i & 07;
+if( j > 3)
+ {
+ j -=4;
+ sign = -sign;
+ }
+
+if( j > 1 )
+ sign = -sign;
+
+/* Extended precision modular arithmetic */
+z = ((x - y * DP1) - y * DP2) - y * DP3;
+
+zz = z * z;
+if( (j==1) || (j==2) )
+ {
+ y = z + z * (zz * polevll( zz, sincof, 6 ));
+ }
+else
+ {
+ y = 1.0L - ldexpl(zz,-1) + zz * zz * polevll( zz, coscof, 6 );
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
diff --git a/libm/ldouble/sqrtl.c b/libm/ldouble/sqrtl.c
new file mode 100644
index 000000000..a3b17175f
--- /dev/null
+++ b/libm/ldouble/sqrtl.c
@@ -0,0 +1,172 @@
+/* sqrtl.c
+ *
+ * Square root, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, sqrtl();
+ *
+ * y = sqrtl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the square root of x.
+ *
+ * Range reduction involves isolating the power of two of the
+ * argument and using a polynomial approximation to obtain
+ * a rough value for the square root. Then Heron's iteration
+ * is used three times to converge to an accurate value.
+ *
+ * Note, some arithmetic coprocessors such as the 8087 and
+ * 68881 produce correctly rounded square roots, which this
+ * routine will not.
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,10 30000 8.1e-20 3.1e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sqrt domain x < 0 0.0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.2: December, 1990
+Copyright 1984, 1990 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+#include <math.h>
+
+#define SQRT2 1.4142135623730950488017E0L
+#ifdef ANSIPROT
+extern long double frexpl ( long double, int * );
+extern long double ldexpl ( long double, int );
+#else
+long double frexpl(), ldexpl();
+#endif
+
+long double sqrtl(x)
+long double x;
+{
+int e;
+long double z, w;
+#ifndef UNK
+short *q;
+#endif
+
+if( x <= 0.0 )
+ {
+ if( x < 0.0 )
+ mtherr( "sqrtl", DOMAIN );
+ return( 0.0 );
+ }
+w = x;
+/* separate exponent and significand */
+#ifdef UNK
+z = frexpl( x, &e );
+#endif
+
+/* Note, frexp and ldexp are used in order to
+ * handle denormal numbers properly.
+ */
+#ifdef IBMPC
+z = frexpl( x, &e );
+q = (short *)&x; /* point to the exponent word */
+q += 4;
+/*
+e = ((*q >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x000f;
+*q |= 0x3fe0;
+z = x;
+*/
+#endif
+#ifdef MIEEE
+z = frexpl( x, &e );
+q = (short *)&x;
+/*
+e = ((*q >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x000f;
+*q |= 0x3fe0;
+z = x;
+*/
+#endif
+
+/* approximate square root of number between 0.5 and 1
+ * relative error of linear approximation = 7.47e-3
+ */
+/*
+x = 0.4173075996388649989089L + 0.59016206709064458299663L * z;
+*/
+
+/* quadratic approximation, relative error 6.45e-4 */
+x = ( -0.20440583154734771959904L * z
+ + 0.89019407351052789754347L) * z
+ + 0.31356706742295303132394L;
+
+/* adjust for odd powers of 2 */
+if( (e & 1) != 0 )
+ x *= SQRT2;
+
+/* re-insert exponent */
+#ifdef UNK
+x = ldexpl( x, (e >> 1) );
+#endif
+#ifdef IBMPC
+x = ldexpl( x, (e >> 1) );
+/*
+*q += ((e >>1) & 0x7ff) << 4;
+*q &= 077777;
+*/
+#endif
+#ifdef MIEEE
+x = ldexpl( x, (e >> 1) );
+/*
+*q += ((e >>1) & 0x7ff) << 4;
+*q &= 077777;
+*/
+#endif
+
+/* Newton iterations: */
+#ifdef UNK
+x += w/x;
+x = ldexpl( x, -1 ); /* divide by 2 */
+x += w/x;
+x = ldexpl( x, -1 );
+x += w/x;
+x = ldexpl( x, -1 );
+#endif
+
+/* Note, assume the square root cannot be denormal,
+ * so it is safe to use integer exponent operations here.
+ */
+#ifdef IBMPC
+x += w/x;
+*q -= 1;
+x += w/x;
+*q -= 1;
+x += w/x;
+*q -= 1;
+#endif
+#ifdef MIEEE
+x += w/x;
+*q -= 1;
+x += w/x;
+*q -= 1;
+x += w/x;
+*q -= 1;
+#endif
+
+return(x);
+}
diff --git a/libm/ldouble/stdtrl.c b/libm/ldouble/stdtrl.c
new file mode 100644
index 000000000..4218d4133
--- /dev/null
+++ b/libm/ldouble/stdtrl.c
@@ -0,0 +1,225 @@
+/* stdtrl.c
+ *
+ * Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double p, t, stdtrl();
+ * int k;
+ *
+ * p = stdtrl( k, t );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes the integral from minus infinity to t of the Student
+ * t distribution with integer k > 0 degrees of freedom:
+ *
+ * t
+ * -
+ * | |
+ * - | 2 -(k+1)/2
+ * | ( (k+1)/2 ) | ( x )
+ * ---------------------- | ( 1 + --- ) dx
+ * - | ( k )
+ * sqrt( k pi ) | ( k/2 ) |
+ * | |
+ * -
+ * -inf.
+ *
+ * Relation to incomplete beta integral:
+ *
+ * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z )
+ * where
+ * z = k/(k + t**2).
+ *
+ * For t < -1.6, this is the method of computation. For higher t,
+ * a direct method is derived from integration by parts.
+ * Since the function is symmetric about t=0, the area under the
+ * right tail of the density is found by calling the function
+ * with -t instead of t.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to t.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -100,-1.6 10000 5.7e-18 9.8e-19
+ * IEEE -1.6,100 10000 3.8e-18 1.0e-19
+ */
+
+/* stdtril.c
+ *
+ * Functional inverse of Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double p, t, stdtril();
+ * int k;
+ *
+ * t = stdtril( k, p );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given probability p, finds the argument t such that stdtrl(k,t)
+ * is equal to p.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,1 3500 4.2e-17 4.1e-18
+ */
+
+
+/*
+Cephes Math Library Release 2.3: January, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern long double PIL, MACHEPL, MAXNUML;
+#ifdef ANSIPROT
+extern long double sqrtl ( long double );
+extern long double atanl ( long double );
+extern long double incbetl ( long double, long double, long double );
+extern long double incbil ( long double, long double, long double );
+extern long double fabsl ( long double );
+#else
+long double sqrtl(), atanl(), incbetl(), incbil(), fabsl();
+#endif
+
+long double stdtrl( k, t )
+int k;
+long double t;
+{
+long double x, rk, z, f, tz, p, xsqk;
+int j;
+
+if( k <= 0 )
+ {
+ mtherr( "stdtrl", DOMAIN );
+ return(0.0L);
+ }
+
+if( t == 0.0L )
+ return( 0.5L );
+
+if( t < -1.6L )
+ {
+ rk = k;
+ z = rk / (rk + t * t);
+ p = 0.5L * incbetl( 0.5L*rk, 0.5L, z );
+ return( p );
+ }
+
+/* compute integral from -t to + t */
+
+if( t < 0.0L )
+ x = -t;
+else
+ x = t;
+
+rk = k; /* degrees of freedom */
+z = 1.0L + ( x * x )/rk;
+
+/* test if k is odd or even */
+if( (k & 1) != 0)
+ {
+
+ /* computation for odd k */
+
+ xsqk = x/sqrtl(rk);
+ p = atanl( xsqk );
+ if( k > 1 )
+ {
+ f = 1.0L;
+ tz = 1.0L;
+ j = 3;
+ while( (j<=(k-2)) && ( (tz/f) > MACHEPL ) )
+ {
+ tz *= (j-1)/( z * j );
+ f += tz;
+ j += 2;
+ }
+ p += f * xsqk/z;
+ }
+ p *= 2.0L/PIL;
+ }
+
+
+else
+ {
+
+ /* computation for even k */
+
+ f = 1.0L;
+ tz = 1.0L;
+ j = 2;
+
+ while( ( j <= (k-2) ) && ( (tz/f) > MACHEPL ) )
+ {
+ tz *= (j - 1)/( z * j );
+ f += tz;
+ j += 2;
+ }
+ p = f * x/sqrtl(z*rk);
+ }
+
+/* common exit */
+
+
+if( t < 0.0L )
+ p = -p; /* note destruction of relative accuracy */
+
+ p = 0.5L + 0.5L * p;
+return(p);
+}
+
+
+long double stdtril( k, p )
+int k;
+long double p;
+{
+long double t, rk, z;
+int rflg;
+
+if( k <= 0 || p <= 0.0L || p >= 1.0L )
+ {
+ mtherr( "stdtril", DOMAIN );
+ return(0.0L);
+ }
+
+rk = k;
+
+if( p > 0.25L && p < 0.75L )
+ {
+ if( p == 0.5L )
+ return( 0.0L );
+ z = 1.0L - 2.0L * p;
+ z = incbil( 0.5L, 0.5L*rk, fabsl(z) );
+ t = sqrtl( rk*z/(1.0L-z) );
+ if( p < 0.5L )
+ t = -t;
+ return( t );
+ }
+rflg = -1;
+if( p >= 0.5L)
+ {
+ p = 1.0L - p;
+ rflg = 1;
+ }
+z = incbil( 0.5L*rk, 0.5L, 2.0L*p );
+
+if( MAXNUML * z < rk )
+ return(rflg* MAXNUML);
+t = sqrtl( rk/z - rk );
+return( rflg * t );
+}
diff --git a/libm/ldouble/tanhl.c b/libm/ldouble/tanhl.c
new file mode 100644
index 000000000..42c7133c3
--- /dev/null
+++ b/libm/ldouble/tanhl.c
@@ -0,0 +1,129 @@
+/* tanhl.c
+ *
+ * Hyperbolic tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, tanhl();
+ *
+ * y = tanhl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic tangent of argument in the range MINLOGL to
+ * MAXLOGL.
+ *
+ * A rational function is used for |x| < 0.625. The form
+ * x + x**3 P(x)/Q(x) of Cody _& Waite is employed.
+ * Otherwise,
+ * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -2,2 30000 1.3e-19 2.4e-20
+ *
+ */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1987, 1989, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+-6.8473739392677100872869E-5L,
+-9.5658283111794641589011E-1L,
+-8.4053568599672284488465E1L,
+-1.3080425704712825945553E3L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+ 9.6259501838840336946872E1L,
+ 1.8218117903645559060232E3L,
+ 3.9241277114138477845780E3L,
+};
+#endif
+
+#ifdef IBMPC
+static short P[] = {
+0xd2a4,0x1b0c,0x8f15,0x8f99,0xbff1, XPD
+0x5959,0x9111,0x9cc7,0xf4e2,0xbffe, XPD
+0xb576,0xef5e,0x6d57,0xa81b,0xc005, XPD
+0xe3be,0xbfbd,0x5cbc,0xa381,0xc009, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x687f,0xce24,0xdd6c,0xc084,0x4005, XPD
+0x3793,0xc95f,0xfa2f,0xe3b9,0x4009, XPD
+0xd5a2,0x1f9c,0x0b1b,0xf542,0x400a, XPD
+};
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0xbff10000,0x8f998f15,0x1b0cd2a4,
+0xbffe0000,0xf4e29cc7,0x91115959,
+0xc0050000,0xa81b6d57,0xef5eb576,
+0xc0090000,0xa3815cbc,0xbfbde3be,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40050000,0xc084dd6c,0xce24687f,
+0x40090000,0xe3b9fa2f,0xc95f3793,
+0x400a0000,0xf5420b1b,0x1f9cd5a2,
+};
+#endif
+
+extern long double MAXLOGL;
+#ifdef ANSIPROT
+extern long double fabsl ( long double );
+extern long double expl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+#else
+long double fabsl(), expl(), polevll(), p1evll();
+#endif
+
+long double tanhl(x)
+long double x;
+{
+long double s, z;
+
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+z = fabsl(x);
+if( z > 0.5L * MAXLOGL )
+ {
+ if( x > 0 )
+ return( 1.0L );
+ else
+ return( -1.0L );
+ }
+if( z >= 0.625L )
+ {
+ s = expl(2.0*z);
+ z = 1.0L - 2.0/(s + 1.0L);
+ if( x < 0 )
+ z = -z;
+ }
+else
+ {
+ s = x * x;
+ z = polevll( s, P, 3 )/p1evll(s, Q, 3);
+ z = x * s * z;
+ z = x + z;
+ }
+return( z );
+}
diff --git a/libm/ldouble/tanl.c b/libm/ldouble/tanl.c
new file mode 100644
index 000000000..e546dd664
--- /dev/null
+++ b/libm/ldouble/tanl.c
@@ -0,0 +1,279 @@
+/* tanl.c
+ *
+ * Circular tangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, tanl();
+ *
+ * y = tanl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 1.9e-19 4.8e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tan total loss x > 2^39 0.0
+ *
+ */
+ /* cotl.c
+ *
+ * Circular cotangent, long double precision
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, cotl();
+ *
+ * y = cotl( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 1.9e-19 5.1e-20
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cot total loss x > 2^39 0.0
+ * cot singularity x = 0 INFINITYL
+ *
+ */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1984, 1990, 1998 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static long double P[] = {
+-1.3093693918138377764608E4L,
+ 1.1535166483858741613983E6L,
+-1.7956525197648487798769E7L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+ 1.3681296347069295467845E4L,
+-1.3208923444021096744731E6L,
+ 2.5008380182335791583922E7L,
+-5.3869575592945462988123E7L,
+};
+static long double DP1 = 7.853981554508209228515625E-1L;
+static long double DP2 = 7.946627356147928367136046290398E-9L;
+static long double DP3 = 3.061616997868382943065164830688E-17L;
+#endif
+
+
+#ifdef IBMPC
+static short P[] = {
+0xbc1c,0x79f9,0xc692,0xcc96,0xc00c, XPD
+0xe5b1,0xe4ee,0x652f,0x8ccf,0x4013, XPD
+0xaf9a,0x4c8b,0x5699,0x88ff,0xc017, XPD
+};
+static short Q[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
+0x8ed4,0x9b2b,0x2f75,0xd5c5,0x400c, XPD
+0xadcd,0x55e4,0xe2c1,0xa13d,0xc013, XPD
+0x7adf,0x56c7,0x7e17,0xbecc,0x4017, XPD
+0x86f6,0xf2d1,0x01e5,0xcd7f,0xc018, XPD
+};
+static short P1[] = {0x0000,0x0000,0xda80,0xc90f,0x3ffe, XPD};
+static short P2[] = {0x0000,0x0000,0xa300,0x8885,0x3fe4, XPD};
+static short P3[] = {0x3707,0xa2e0,0x3198,0x8d31,0x3fc8, XPD};
+#define DP1 *(long double *)P1
+#define DP2 *(long double *)P2
+#define DP3 *(long double *)P3
+#endif
+
+#ifdef MIEEE
+static long P[] = {
+0xc00c0000,0xcc96c692,0x79f9bc1c,
+0x40130000,0x8ccf652f,0xe4eee5b1,
+0xc0170000,0x88ff5699,0x4c8baf9a,
+};
+static long Q[] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x400c0000,0xd5c52f75,0x9b2b8ed4,
+0xc0130000,0xa13de2c1,0x55e4adcd,
+0x40170000,0xbecc7e17,0x56c77adf,
+0xc0180000,0xcd7f01e5,0xf2d186f6,
+};
+static long P1[] = {0x3ffe0000,0xc90fda80,0x00000000};
+static long P2[] = {0x3fe40000,0x8885a300,0x00000000};
+static long P3[] = {0x3fc80000,0x8d313198,0xa2e03707};
+#define DP1 *(long double *)P1
+#define DP2 *(long double *)P2
+#define DP3 *(long double *)P3
+#endif
+
+static long double lossth = 5.49755813888e11L; /* 2^39 */
+extern long double PIO4L;
+extern long double MAXNUML;
+
+#ifdef ANSIPROT
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+extern long double floorl ( long double );
+extern long double ldexpl ( long double, int );
+extern int isnanl ( long double );
+extern int isfinitel ( long double );
+static long double tancotl( long double, int );
+#else
+long double polevll(), p1evll(), floorl(), ldexpl(), isnanl(), isfinitel();
+static long double tancotl();
+#endif
+#ifdef INFINITIES
+extern long double INFINITYL;
+#endif
+#ifdef NANS
+extern long double NANL;
+#endif
+
+long double tanl(x)
+long double x;
+{
+
+#ifdef NANS
+if( isnanl(x) )
+ return(x);
+#endif
+#ifdef MINUSZERO
+if( x == 0.0L )
+ return(x);
+#endif
+#ifdef NANS
+if( !isfinitel(x) )
+ {
+ mtherr( "tanl", DOMAIN );
+ return(NANL);
+ }
+#endif
+return( tancotl(x,0) );
+}
+
+
+long double cotl(x)
+long double x;
+{
+
+if( x == 0.0L )
+ {
+ mtherr( "cotl", SING );
+#ifdef INFINITIES
+ return( INFINITYL );
+#else
+ return( MAXNUML );
+#endif
+ }
+return( tancotl(x,1) );
+}
+
+
+static long double tancotl( xx, cotflg )
+long double xx;
+int cotflg;
+{
+long double x, y, z, zz;
+int j, sign;
+
+/* make argument positive but save the sign */
+if( xx < 0.0L )
+ {
+ x = -xx;
+ sign = -1;
+ }
+else
+ {
+ x = xx;
+ sign = 1;
+ }
+
+if( x > lossth )
+ {
+ if( cotflg )
+ mtherr( "cotl", TLOSS );
+ else
+ mtherr( "tanl", TLOSS );
+ return(0.0L);
+ }
+
+/* compute x mod PIO4 */
+y = floorl( x/PIO4L );
+
+/* strip high bits of integer part */
+z = ldexpl( y, -4 );
+z = floorl(z); /* integer part of y/16 */
+z = y - ldexpl( z, 4 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+j = z;
+
+/* map zeros and singularities to origin */
+if( j & 1 )
+ {
+ j += 1;
+ y += 1.0L;
+ }
+
+z = ((x - y * DP1) - y * DP2) - y * DP3;
+
+zz = z * z;
+
+if( zz > 1.0e-20L )
+ y = z + z * (zz * polevll( zz, P, 2 )/p1evll(zz, Q, 4));
+else
+ y = z;
+
+if( j & 2 )
+ {
+ if( cotflg )
+ y = -y;
+ else
+ y = -1.0L/y;
+ }
+else
+ {
+ if( cotflg )
+ y = 1.0L/y;
+ }
+
+if( sign < 0 )
+ y = -y;
+
+return( y );
+}
diff --git a/libm/ldouble/testvect.c b/libm/ldouble/testvect.c
new file mode 100644
index 000000000..1c3ffcb91
--- /dev/null
+++ b/libm/ldouble/testvect.c
@@ -0,0 +1,497 @@
+
+/* Test vectors for math functions.
+ See C9X section F.9.
+
+ On some systems it may be necessary to modify the default exception
+ settings of the floating point arithmetic unit. */
+
+/*
+Cephes Math Library Release 2.7: May, 1998
+Copyright 1998 by Stephen L. Moshier
+*/
+
+#include <stdio.h>
+int isfinitel (long double);
+
+/* Some compilers will not accept these expressions. */
+
+#define ZINF 1
+#define ZMINF 2
+#define ZNANL 3
+#define ZPIL 4
+#define ZPIO2L 4
+
+extern long double INFINITYL, NANL, NEGZEROL;
+long double MINFL;
+extern long double PIL, PIO2L, PIO4L, MACHEPL;
+long double MPIL;
+long double MPIO2L;
+long double MPIO4L;
+long double THPIO4L = 2.35619449019234492884698L;
+long double MTHPIO4L = -2.35619449019234492884698L;
+long double SQRT2L = 1.414213562373095048802E0L;
+long double SQRTHL = 7.071067811865475244008E-1L;
+long double ZEROL = 0.0L;
+long double HALFL = 0.5L;
+long double MHALFL = -0.5L;
+long double ONEL = 1.0L;
+long double MONEL = -1.0L;
+long double TWOL = 2.0L;
+long double MTWOL = -2.0L;
+long double THREEL = 3.0L;
+long double MTHREEL = -3.0L;
+
+/* Functions of one variable. */
+long double logl (long double);
+long double expl (long double);
+long double atanl (long double);
+long double sinl (long double);
+long double cosl (long double);
+long double tanl (long double);
+long double acosl (long double);
+long double asinl (long double);
+long double acoshl (long double);
+long double asinhl (long double);
+long double atanhl (long double);
+long double sinhl (long double);
+long double coshl (long double);
+long double tanhl (long double);
+long double exp2l (long double);
+long double expm1l (long double);
+long double log10l (long double);
+long double log1pl (long double);
+long double log2l (long double);
+long double fabsl (long double);
+long double erfl (long double);
+long double erfcl (long double);
+long double gammal (long double);
+long double lgaml (long double);
+long double floorl (long double);
+long double ceill (long double);
+long double cbrtl (long double);
+
+struct oneargument
+ {
+ char *name; /* Name of the function. */
+ long double (*func) (long double);
+ long double *arg1;
+ long double *answer;
+ int thresh; /* Error report threshold. */
+ };
+
+#if 0
+ {"sinl", sinl, 32767.L, 1.8750655394138942394239E-1L, 0},
+ {"cosl", cosl, 32767.L, 9.8226335176928229845654E-1L, 0},
+ {"tanl", tanl, 32767.L, 1.9089234430221485740826E-1L, 0},
+ {"sinl", sinl, 8388607.L, 9.9234509376961249835628E-1L, 0},
+ {"cosl", cosl, 8388607.L, -1.2349580912475928183718E-1L, 0},
+ {"tanl", tanl, 8388607.L, -8.0354556223613614748329E0L, 0},
+ {"sinl", sinl, 2147483647.L, -7.2491655514455639054829E-1L, 0},
+ {"cosl", cosl, 2147483647.L, -6.8883669187794383467976E-1L, 0},
+ {"tanl", tanl, 2147483647.L, 1.0523779637351339136698E0L, 0},
+ {"sinl", sinl, PIO4L, 7.0710678118654752440084E-1L, 0},
+ {"cosl", cosl, PIO2L, -2.50827880633416613471e-20L, 0},
+#endif
+
+struct oneargument test1[] =
+{
+ {"atanl", atanl, &ONEL, &PIO4L, 0},
+ {"sinl", sinl, &PIO2L, &ONEL, 0},
+ {"cosl", cosl, &PIO4L, &SQRTHL, 0},
+ {"acosl", acosl, &NANL, &NANL, 0},
+ {"acosl", acosl, &ONEL, &ZEROL, 0},
+ {"acosl", acosl, &TWOL, &NANL, 0},
+ {"acosl", acosl, &MTWOL, &NANL, 0},
+ {"asinl", asinl, &NANL, &NANL, 0},
+ {"asinl", asinl, &ZEROL, &ZEROL, 0},
+ {"asinl", asinl, &NEGZEROL, &NEGZEROL, 0},
+ {"asinl", asinl, &TWOL, &NANL, 0},
+ {"asinl", asinl, &MTWOL, &NANL, 0},
+ {"atanl", atanl, &NANL, &NANL, 0},
+ {"atanl", atanl, &ZEROL, &ZEROL, 0},
+ {"atanl", atanl, &NEGZEROL, &NEGZEROL, 0},
+ {"atanl", atanl, &INFINITYL, &PIO2L, 0},
+ {"atanl", atanl, &MINFL, &MPIO2L, 0},
+ {"cosl", cosl, &NANL, &NANL, 0},
+ {"cosl", cosl, &ZEROL, &ONEL, 0},
+ {"cosl", cosl, &NEGZEROL, &ONEL, 0},
+ {"cosl", cosl, &INFINITYL, &NANL, 0},
+ {"cosl", cosl, &MINFL, &NANL, 0},
+ {"sinl", sinl, &NANL, &NANL, 0},
+ {"sinl", sinl, &NEGZEROL, &NEGZEROL, 0},
+ {"sinl", sinl, &ZEROL, &ZEROL, 0},
+ {"sinl", sinl, &INFINITYL, &NANL, 0},
+ {"sinl", sinl, &MINFL, &NANL, 0},
+ {"tanl", tanl, &NANL, &NANL, 0},
+ {"tanl", tanl, &ZEROL, &ZEROL, 0},
+ {"tanl", tanl, &NEGZEROL, &NEGZEROL, 0},
+ {"tanl", tanl, &INFINITYL, &NANL, 0},
+ {"tanl", tanl, &MINFL, &NANL, 0},
+ {"acoshl", acoshl, &NANL, &NANL, 0},
+ {"acoshl", acoshl, &ONEL, &ZEROL, 0},
+ {"acoshl", acoshl, &INFINITYL, &INFINITYL, 0},
+ {"acoshl", acoshl, &HALFL, &NANL, 0},
+ {"acoshl", acoshl, &MONEL, &NANL, 0},
+ {"asinhl", asinhl, &NANL, &NANL, 0},
+ {"asinhl", asinhl, &ZEROL, &ZEROL, 0},
+ {"asinhl", asinhl, &NEGZEROL, &NEGZEROL, 0},
+ {"asinhl", asinhl, &INFINITYL, &INFINITYL, 0},
+ {"asinhl", asinhl, &MINFL, &MINFL, 0},
+ {"atanhl", atanhl, &NANL, &NANL, 0},
+ {"atanhl", atanhl, &ZEROL, &ZEROL, 0},
+ {"atanhl", atanhl, &NEGZEROL, &NEGZEROL, 0},
+ {"atanhl", atanhl, &ONEL, &INFINITYL, 0},
+ {"atanhl", atanhl, &MONEL, &MINFL, 0},
+ {"atanhl", atanhl, &TWOL, &NANL, 0},
+ {"atanhl", atanhl, &MTWOL, &NANL, 0},
+ {"coshl", coshl, &NANL, &NANL, 0},
+ {"coshl", coshl, &ZEROL, &ONEL, 0},
+ {"coshl", coshl, &NEGZEROL, &ONEL, 0},
+ {"coshl", coshl, &INFINITYL, &INFINITYL, 0},
+ {"coshl", coshl, &MINFL, &INFINITYL, 0},
+ {"sinhl", sinhl, &NANL, &NANL, 0},
+ {"sinhl", sinhl, &ZEROL, &ZEROL, 0},
+ {"sinhl", sinhl, &NEGZEROL, &NEGZEROL, 0},
+ {"sinhl", sinhl, &INFINITYL, &INFINITYL, 0},
+ {"sinhl", sinhl, &MINFL, &MINFL, 0},
+ {"tanhl", tanhl, &NANL, &NANL, 0},
+ {"tanhl", tanhl, &ZEROL, &ZEROL, 0},
+ {"tanhl", tanhl, &NEGZEROL, &NEGZEROL, 0},
+ {"tanhl", tanhl, &INFINITYL, &ONEL, 0},
+ {"tanhl", tanhl, &MINFL, &MONEL, 0},
+ {"expl", expl, &NANL, &NANL, 0},
+ {"expl", expl, &ZEROL, &ONEL, 0},
+ {"expl", expl, &NEGZEROL, &ONEL, 0},
+ {"expl", expl, &INFINITYL, &INFINITYL, 0},
+ {"expl", expl, &MINFL, &ZEROL, 0},
+ {"exp2l", exp2l, &NANL, &NANL, 0},
+ {"exp2l", exp2l, &ZEROL, &ONEL, 0},
+ {"exp2l", exp2l, &NEGZEROL, &ONEL, 0},
+ {"exp2l", exp2l, &INFINITYL, &INFINITYL, 0},
+ {"exp2l", exp2l, &MINFL, &ZEROL, 0},
+ {"expm1l", expm1l, &NANL, &NANL, 0},
+ {"expm1l", expm1l, &ZEROL, &ZEROL, 0},
+ {"expm1l", expm1l, &NEGZEROL, &NEGZEROL, 0},
+ {"expm1l", expm1l, &INFINITYL, &INFINITYL, 0},
+ {"expm1l", expm1l, &MINFL, &MONEL, 0},
+ {"logl", logl, &NANL, &NANL, 0},
+ {"logl", logl, &ZEROL, &MINFL, 0},
+ {"logl", logl, &NEGZEROL, &MINFL, 0},
+ {"logl", logl, &ONEL, &ZEROL, 0},
+ {"logl", logl, &MONEL, &NANL, 0},
+ {"logl", logl, &INFINITYL, &INFINITYL, 0},
+ {"log10l", log10l, &NANL, &NANL, 0},
+ {"log10l", log10l, &ZEROL, &MINFL, 0},
+ {"log10l", log10l, &NEGZEROL, &MINFL, 0},
+ {"log10l", log10l, &ONEL, &ZEROL, 0},
+ {"log10l", log10l, &MONEL, &NANL, 0},
+ {"log10l", log10l, &INFINITYL, &INFINITYL, 0},
+ {"log1pl", log1pl, &NANL, &NANL, 0},
+ {"log1pl", log1pl, &ZEROL, &ZEROL, 0},
+ {"log1pl", log1pl, &NEGZEROL, &NEGZEROL, 0},
+ {"log1pl", log1pl, &MONEL, &MINFL, 0},
+ {"log1pl", log1pl, &MTWOL, &NANL, 0},
+ {"log1pl", log1pl, &INFINITYL, &INFINITYL, 0},
+ {"log2l", log2l, &NANL, &NANL, 0},
+ {"log2l", log2l, &ZEROL, &MINFL, 0},
+ {"log2l", log2l, &NEGZEROL, &MINFL, 0},
+ {"log2l", log2l, &MONEL, &NANL, 0},
+ {"log2l", log2l, &INFINITYL, &INFINITYL, 0},
+ /* {"fabsl", fabsl, &NANL, &NANL, 0}, */
+ {"fabsl", fabsl, &ONEL, &ONEL, 0},
+ {"fabsl", fabsl, &MONEL, &ONEL, 0},
+ {"fabsl", fabsl, &ZEROL, &ZEROL, 0},
+ {"fabsl", fabsl, &NEGZEROL, &ZEROL, 0},
+ {"fabsl", fabsl, &INFINITYL, &INFINITYL, 0},
+ {"fabsl", fabsl, &MINFL, &INFINITYL, 0},
+ {"cbrtl", cbrtl, &NANL, &NANL, 0},
+ {"cbrtl", cbrtl, &ZEROL, &ZEROL, 0},
+ {"cbrtl", cbrtl, &NEGZEROL, &NEGZEROL, 0},
+ {"cbrtl", cbrtl, &INFINITYL, &INFINITYL, 0},
+ {"cbrtl", cbrtl, &MINFL, &MINFL, 0},
+ {"erfl", erfl, &NANL, &NANL, 0},
+ {"erfl", erfl, &ZEROL, &ZEROL, 0},
+ {"erfl", erfl, &NEGZEROL, &NEGZEROL, 0},
+ {"erfl", erfl, &INFINITYL, &ONEL, 0},
+ {"erfl", erfl, &MINFL, &MONEL, 0},
+ {"erfcl", erfcl, &NANL, &NANL, 0},
+ {"erfcl", erfcl, &INFINITYL, &ZEROL, 0},
+ {"erfcl", erfcl, &MINFL, &TWOL, 0},
+ {"gammal", gammal, &NANL, &NANL, 0},
+ {"gammal", gammal, &INFINITYL, &INFINITYL, 0},
+ {"gammal", gammal, &MONEL, &NANL, 0},
+ {"gammal", gammal, &ZEROL, &NANL, 0},
+ {"gammal", gammal, &MINFL, &NANL, 0},
+ {"lgaml", lgaml, &NANL, &NANL, 0},
+ {"lgaml", lgaml, &INFINITYL, &INFINITYL, 0},
+ {"lgaml", lgaml, &MONEL, &INFINITYL, 0},
+ {"lgaml", lgaml, &ZEROL, &INFINITYL, 0},
+ {"lgaml", lgaml, &MINFL, &INFINITYL, 0},
+ {"ceill", ceill, &NANL, &NANL, 0},
+ {"ceill", ceill, &ZEROL, &ZEROL, 0},
+ {"ceill", ceill, &NEGZEROL, &NEGZEROL, 0},
+ {"ceill", ceill, &INFINITYL, &INFINITYL, 0},
+ {"ceill", ceill, &MINFL, &MINFL, 0},
+ {"floorl", floorl, &NANL, &NANL, 0},
+ {"floorl", floorl, &ZEROL, &ZEROL, 0},
+ {"floorl", floorl, &NEGZEROL, &NEGZEROL, 0},
+ {"floorl", floorl, &INFINITYL, &INFINITYL, 0},
+ {"floorl", floorl, &MINFL, &MINFL, 0},
+ {"null", NULL, &ZEROL, &ZEROL, 0},
+};
+
+/* Functions of two variables. */
+long double atan2l (long double, long double);
+long double powl (long double, long double);
+
+struct twoarguments
+ {
+ char *name; /* Name of the function. */
+ long double (*func) (long double, long double);
+ long double *arg1;
+ long double *arg2;
+ long double *answer;
+ int thresh;
+ };
+
+struct twoarguments test2[] =
+{
+ {"atan2l", atan2l, &ZEROL, &ONEL, &ZEROL, 0},
+ {"atan2l", atan2l, &NEGZEROL, &ONEL,&NEGZEROL, 0},
+ {"atan2l", atan2l, &ZEROL, &ZEROL, &ZEROL, 0},
+ {"atan2l", atan2l, &NEGZEROL, &ZEROL, &NEGZEROL, 0},
+ {"atan2l", atan2l, &ZEROL, &MONEL, &PIL, 0},
+ {"atan2l", atan2l, &NEGZEROL, &MONEL, &MPIL, 0},
+ {"atan2l", atan2l, &ZEROL, &NEGZEROL, &PIL, 0},
+ {"atan2l", atan2l, &NEGZEROL, &NEGZEROL, &MPIL, 0},
+ {"atan2l", atan2l, &ONEL, &ZEROL, &PIO2L, 0},
+ {"atan2l", atan2l, &ONEL, &NEGZEROL, &PIO2L, 0},
+ {"atan2l", atan2l, &MONEL, &ZEROL, &MPIO2L, 0},
+ {"atan2l", atan2l, &MONEL, &NEGZEROL, &MPIO2L, 0},
+ {"atan2l", atan2l, &ONEL, &INFINITYL, &ZEROL, 0},
+ {"atan2l", atan2l, &MONEL, &INFINITYL, &NEGZEROL, 0},
+ {"atan2l", atan2l, &INFINITYL, &ONEL, &PIO2L, 0},
+ {"atan2l", atan2l, &INFINITYL, &MONEL, &PIO2L, 0},
+ {"atan2l", atan2l, &MINFL, &ONEL, &MPIO2L, 0},
+ {"atan2l", atan2l, &MINFL, &MONEL, &MPIO2L, 0},
+ {"atan2l", atan2l, &ONEL, &MINFL, &PIL, 0},
+ {"atan2l", atan2l, &MONEL, &MINFL, &MPIL, 0},
+ {"atan2l", atan2l, &INFINITYL, &INFINITYL, &PIO4L, 0},
+ {"atan2l", atan2l, &MINFL, &INFINITYL, &MPIO4L, 0},
+ {"atan2l", atan2l, &INFINITYL, &MINFL, &THPIO4L, 0},
+ {"atan2l", atan2l, &MINFL, &MINFL, &MTHPIO4L, 0},
+ {"atan2l", atan2l, &ONEL, &ONEL, &PIO4L, 0},
+ {"atan2l", atan2l, &NANL, &ONEL, &NANL, 0},
+ {"atan2l", atan2l, &ONEL, &NANL, &NANL, 0},
+ {"atan2l", atan2l, &NANL, &NANL, &NANL, 0},
+ {"powl", powl, &ONEL, &ZEROL, &ONEL, 0},
+ {"powl", powl, &ONEL, &NEGZEROL, &ONEL, 0},
+ {"powl", powl, &MONEL, &ZEROL, &ONEL, 0},
+ {"powl", powl, &MONEL, &NEGZEROL, &ONEL, 0},
+ {"powl", powl, &INFINITYL, &ZEROL, &ONEL, 0},
+ {"powl", powl, &INFINITYL, &NEGZEROL, &ONEL, 0},
+ {"powl", powl, &NANL, &ZEROL, &ONEL, 0},
+ {"powl", powl, &NANL, &NEGZEROL, &ONEL, 0},
+ {"powl", powl, &TWOL, &INFINITYL, &INFINITYL, 0},
+ {"powl", powl, &MTWOL, &INFINITYL, &INFINITYL, 0},
+ {"powl", powl, &HALFL, &INFINITYL, &ZEROL, 0},
+ {"powl", powl, &MHALFL, &INFINITYL, &ZEROL, 0},
+ {"powl", powl, &TWOL, &MINFL, &ZEROL, 0},
+ {"powl", powl, &MTWOL, &MINFL, &ZEROL, 0},
+ {"powl", powl, &HALFL, &MINFL, &INFINITYL, 0},
+ {"powl", powl, &MHALFL, &MINFL, &INFINITYL, 0},
+ {"powl", powl, &INFINITYL, &HALFL, &INFINITYL, 0},
+ {"powl", powl, &INFINITYL, &TWOL, &INFINITYL, 0},
+ {"powl", powl, &INFINITYL, &MHALFL, &ZEROL, 0},
+ {"powl", powl, &INFINITYL, &MTWOL, &ZEROL, 0},
+ {"powl", powl, &MINFL, &THREEL, &MINFL, 0},
+ {"powl", powl, &MINFL, &TWOL, &INFINITYL, 0},
+ {"powl", powl, &MINFL, &MTHREEL, &NEGZEROL, 0},
+ {"powl", powl, &MINFL, &MTWOL, &ZEROL, 0},
+ {"powl", powl, &NANL, &ONEL, &NANL, 0},
+ {"powl", powl, &ONEL, &NANL, &NANL, 0},
+ {"powl", powl, &NANL, &NANL, &NANL, 0},
+ {"powl", powl, &ONEL, &INFINITYL, &NANL, 0},
+ {"powl", powl, &MONEL, &INFINITYL, &NANL, 0},
+ {"powl", powl, &ONEL, &MINFL, &NANL, 0},
+ {"powl", powl, &MONEL, &MINFL, &NANL, 0},
+ {"powl", powl, &MTWOL, &HALFL, &NANL, 0},
+ {"powl", powl, &ZEROL, &MTHREEL, &INFINITYL, 0},
+ {"powl", powl, &NEGZEROL, &MTHREEL, &MINFL, 0},
+ {"powl", powl, &ZEROL, &MHALFL, &INFINITYL, 0},
+ {"powl", powl, &NEGZEROL, &MHALFL, &INFINITYL, 0},
+ {"powl", powl, &ZEROL, &THREEL, &ZEROL, 0},
+ {"powl", powl, &NEGZEROL, &THREEL, &NEGZEROL, 0},
+ {"powl", powl, &ZEROL, &HALFL, &ZEROL, 0},
+ {"powl", powl, &NEGZEROL, &HALFL, &ZEROL, 0},
+ {"null", NULL, &ZEROL, &ZEROL, &ZEROL, 0},
+};
+
+/* Integer functions of one variable. */
+
+int isnanl (long double);
+int signbitl (long double);
+
+struct intans
+ {
+ char *name; /* Name of the function. */
+ int (*func) (long double);
+ long double *arg1;
+ int ianswer;
+ };
+
+struct intans test3[] =
+{
+ {"isfinitel", isfinitel, &ZEROL, 1},
+ {"isfinitel", isfinitel, &INFINITYL, 0},
+ {"isfinitel", isfinitel, &MINFL, 0},
+ {"isnanl", isnanl, &NANL, 1},
+ {"isnanl", isnanl, &INFINITYL, 0},
+ {"isnanl", isnanl, &ZEROL, 0},
+ {"isnanl", isnanl, &NEGZEROL, 0},
+ {"signbitl", signbitl, &NEGZEROL, 1},
+ {"signbitl", signbitl, &MONEL, 1},
+ {"signbitl", signbitl, &ZEROL, 0},
+ {"signbitl", signbitl, &ONEL, 0},
+ {"signbitl", signbitl, &MINFL, 1},
+ {"signbitl", signbitl, &INFINITYL, 0},
+ {"null", NULL, &ZEROL, 0},
+};
+
+static volatile long double x1;
+static volatile long double x2;
+static volatile long double y;
+static volatile long double answer;
+
+int
+main ()
+{
+ int i, nerrors, k, ianswer, ntests;
+ long double (*fun1) (long double);
+ long double (*fun2) (long double, long double);
+ int (*fun3) (long double);
+ long double e;
+ union
+ {
+ long double d;
+ char c[12];
+ } u, v;
+
+ /* This masks off fpu exceptions on i386. */
+ /* setfpu(0x137f); */
+ nerrors = 0;
+ ntests = 0;
+ MINFL = -INFINITYL;
+ MPIL = -PIL;
+ MPIO2L = -PIO2L;
+ MPIO4L = -PIO4L;
+ i = 0;
+ for (;;)
+ {
+ fun1 = test1[i].func;
+ if (fun1 == NULL)
+ break;
+ x1 = *(test1[i].arg1);
+ y = (*(fun1)) (x1);
+ answer = *(test1[i].answer);
+ if (test1[i].thresh == 0)
+ {
+ v.d = answer;
+ u.d = y;
+ if (memcmp(u.c, v.c, 10) != 0)
+ {
+ /* O.K. if both are NaNs of some sort. */
+ if (isnanl(v.d) && isnanl(u.d))
+ goto nxttest1;
+ goto wrongone;
+ }
+ else
+ goto nxttest1;
+ }
+ if (y != answer)
+ {
+ e = y - answer;
+ if (answer != 0.0L)
+ e = e / answer;
+ if (e < 0)
+ e = -e;
+ if (e > test1[i].thresh * MACHEPL)
+ {
+wrongone:
+ printf ("%s (%.20Le) = %.20Le\n should be %.20Le\n",
+ test1[i].name, x1, y, answer);
+ nerrors += 1;
+ }
+ }
+nxttest1:
+ ntests += 1;
+ i += 1;
+ }
+
+ i = 0;
+ for (;;)
+ {
+ fun2 = test2[i].func;
+ if (fun2 == NULL)
+ break;
+ x1 = *(test2[i].arg1);
+ x2 = *(test2[i].arg2);
+ y = (*(fun2)) (x1, x2);
+ answer = *(test2[i].answer);
+ if (test2[i].thresh == 0)
+ {
+ v.d = answer;
+ u.d = y;
+ if (memcmp(u.c, v.c, 10) != 0)
+ {
+ /* O.K. if both are NaNs of some sort. */
+ if (isnanl(v.d) && isnanl(u.d))
+ goto nxttest2;
+ goto wrongtwo;
+ }
+ else
+ goto nxttest2;
+ }
+ if (y != answer)
+ {
+ e = y - answer;
+ if (answer != 0.0L)
+ e = e / answer;
+ if (e < 0)
+ e = -e;
+ if (e > test2[i].thresh * MACHEPL)
+ {
+wrongtwo:
+ printf ("%s (%.20Le, %.20Le) = %.20Le\n should be %.20Le\n",
+ test2[i].name, x1, x2, y, answer);
+ nerrors += 1;
+ }
+ }
+nxttest2:
+ ntests += 1;
+ i += 1;
+ }
+
+
+ i = 0;
+ for (;;)
+ {
+ fun3 = test3[i].func;
+ if (fun3 == NULL)
+ break;
+ x1 = *(test3[i].arg1);
+ k = (*(fun3)) (x1);
+ ianswer = test3[i].ianswer;
+ if (k != ianswer)
+ {
+ printf ("%s (%.20Le) = %d\n should be. %d\n",
+ test3[i].name, x1, k, ianswer);
+ nerrors += 1;
+ }
+ ntests += 1;
+ i += 1;
+ }
+
+ printf ("testvect: %d errors in %d tests\n", nerrors, ntests);
+ exit (0);
+}
diff --git a/libm/ldouble/unityl.c b/libm/ldouble/unityl.c
new file mode 100644
index 000000000..10670ce3a
--- /dev/null
+++ b/libm/ldouble/unityl.c
@@ -0,0 +1,128 @@
+/* unityl.c
+ *
+ * Relative error approximations for function arguments near
+ * unity.
+ *
+ * log1p(x) = log(1+x)
+ * expm1(x) = exp(x) - 1
+ * cosm1(x) = cos(x) - 1
+ *
+ */
+
+
+/* log1p(x) = log(1 + x)
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2 30000 1.4e-19 4.1e-20
+ *
+ */
+
+#include <math.h>
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 2.32e-20
+ */
+static long double LP[] = {
+ 4.5270000862445199635215E-5L,
+ 4.9854102823193375972212E-1L,
+ 6.5787325942061044846969E0L,
+ 2.9911919328553073277375E1L,
+ 6.0949667980987787057556E1L,
+ 5.7112963590585538103336E1L,
+ 2.0039553499201281259648E1L,
+};
+static long double LQ[] = {
+/* 1.0000000000000000000000E0L,*/
+ 1.5062909083469192043167E1L,
+ 8.3047565967967209469434E1L,
+ 2.2176239823732856465394E2L,
+ 3.0909872225312059774938E2L,
+ 2.1642788614495947685003E2L,
+ 6.0118660497603843919306E1L,
+};
+
+#define SQRTH 0.70710678118654752440L
+#define SQRT2 1.41421356237309504880L
+#ifdef ANSIPROT
+extern long double logl ( long double );
+extern long double expl ( long double );
+extern long double cosl ( long double );
+extern long double polevll ( long double, void *, int );
+extern long double p1evll ( long double, void *, int );
+#else
+long double logl(), expl(), cosl(), polevll(), p1evll();
+#endif
+
+long double log1pl(x)
+long double x;
+{
+long double z;
+
+z = 1.0L + x;
+if( (z < SQRTH) || (z > SQRT2) )
+ return( logl(z) );
+z = x*x;
+z = -0.5L * z + x * ( z * polevll( x, LP, 6 ) / p1evll( x, LQ, 6 ) );
+return (x + z);
+}
+
+
+
+/* expm1(x) = exp(x) - 1 */
+
+/* e^x = 1 + 2x P(x^2)/( Q(x^2) - P(x^2) )
+ * -0.5 <= x <= 0.5
+ */
+
+static long double EP[3] = {
+ 1.2617719307481059087798E-4L,
+ 3.0299440770744196129956E-2L,
+ 9.9999999999999999991025E-1L,
+};
+static long double EQ[4] = {
+ 3.0019850513866445504159E-6L,
+ 2.5244834034968410419224E-3L,
+ 2.2726554820815502876593E-1L,
+ 2.0000000000000000000897E0L,
+};
+
+long double expm1l(x)
+long double x;
+{
+long double r, xx;
+
+if( (x < -0.5L) || (x > 0.5L) )
+ return( expl(x) - 1.0L );
+xx = x * x;
+r = x * polevll( xx, EP, 2 );
+r = r/( polevll( xx, EQ, 3 ) - r );
+return (r + r);
+}
+
+
+
+/* cosm1(x) = cos(x) - 1 */
+
+static long double coscof[7] = {
+ 4.7377507964246204691685E-14L,
+-1.1470284843425359765671E-11L,
+ 2.0876754287081521758361E-9L,
+-2.7557319214999787979814E-7L,
+ 2.4801587301570552304991E-5L,
+-1.3888888888888872993737E-3L,
+ 4.1666666666666666609054E-2L,
+};
+
+extern long double PIO4L;
+
+long double cosm1l(x)
+long double x;
+{
+long double xx;
+
+if( (x < -PIO4L) || (x > PIO4L) )
+ return( cosl(x) - 1.0L );
+xx = x * x;
+xx = -0.5L*xx + xx * xx * polevll( xx, coscof, 6 );
+return xx;
+}
diff --git a/libm/ldouble/wronkl.c b/libm/ldouble/wronkl.c
new file mode 100644
index 000000000..bec958f01
--- /dev/null
+++ b/libm/ldouble/wronkl.c
@@ -0,0 +1,67 @@
+/* Wronksian test for Bessel functions. */
+
+long double jnl (), ynl (), floorl ();
+#define PI 3.14159265358979323846L
+
+long double y, Jn, Jnp1, Jmn, Jmnp1, Yn, Ynp1;
+long double w1, w2, err1, max1, err2, max2;
+void wronk ();
+
+main ()
+{
+ long double x, delta;
+ int n, i, j;
+
+ max1 = 0.0L;
+ max2 = 0.0L;
+ delta = 0.6 / PI;
+ for (n = -30; n <= 30; n++)
+ {
+ x = -30.0;
+ while (x < 30.0)
+ {
+ wronk (n, x);
+ x += delta;
+ }
+ delta += .00123456;
+ }
+}
+
+void
+wronk (n, x)
+ int n;
+ long double x;
+{
+
+ Jnp1 = jnl (n + 1, x);
+ Jmn = jnl (-n, x);
+ Jn = jnl (n, x);
+ Jmnp1 = jnl (-(n + 1), x);
+ /* This should be trivially zero. */
+ err1 = Jnp1 * Jmn + Jn * Jmnp1;
+ if (err1 < 0.0)
+ err1 = -err1;
+ if (err1 > max1)
+ {
+ max1 = err1;
+ printf ("1 %3d %.5Le %.3Le\n", n, x, max1);
+ }
+ if (x < 0.0)
+ {
+ x = -x;
+ Jn = jnl (n, x);
+ Jnp1 = jnl (n + 1, x);
+ }
+ Yn = ynl (n, x);
+ Ynp1 = ynl (n + 1, x);
+ /* The Wronksian. */
+ w1 = Jnp1 * Yn - Jn * Ynp1;
+ /* What the Wronksian should be. */
+ w2 = 2.0 / (PI * x);
+ err2 = w1 - w2;
+ if (err2 > max2)
+ {
+ max2 = err2;
+ printf ("2 %3d %.5Le %.3Le\n", n, x, max2);
+ }
+}
diff --git a/libm/ldouble/ynl.c b/libm/ldouble/ynl.c
new file mode 100644
index 000000000..444792850
--- /dev/null
+++ b/libm/ldouble/ynl.c
@@ -0,0 +1,113 @@
+/* ynl.c
+ *
+ * Bessel function of second kind of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, ynl();
+ * int n;
+ *
+ * y = ynl( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The function is evaluated by forward recurrence on
+ * n, starting with values computed by the routines
+ * y0l() and y1l().
+ *
+ * If n = 0 or 1 the routine for y0l or y1l is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * Absolute error, except relative error when y > 1.
+ * x >= 0, -30 <= n <= +30.
+ * arithmetic domain # trials peak rms
+ * IEEE -30, 30 10000 1.3e-18 1.8e-19
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ynl singularity x = 0 MAXNUML
+ * ynl overflow MAXNUML
+ *
+ * Spot checked against tables for x, n between 0 and 100.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.1: December, 1988
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include <math.h>
+extern long double MAXNUML;
+#ifdef ANSIPROT
+extern long double y0l ( long double );
+extern long double y1l ( long double );
+#else
+long double y0l(), y1l();
+#endif
+
+long double ynl( n, x )
+int n;
+long double x;
+{
+long double an, anm1, anm2, r;
+int k, sign;
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+
+if( n == 0 )
+ return( sign * y0l(x) );
+if( n == 1 )
+ return( sign * y1l(x) );
+
+/* test for overflow */
+if( x <= 0.0L )
+ {
+ mtherr( "ynl", SING );
+ return( -MAXNUML );
+ }
+
+/* forward recurrence on n */
+
+anm2 = y0l(x);
+anm1 = y1l(x);
+k = 1;
+r = 2 * k;
+do
+ {
+ an = r * anm1 / x - anm2;
+ anm2 = anm1;
+ anm1 = an;
+ r += 2.0L;
+ ++k;
+ }
+while( k < n );
+
+
+return( sign * an );
+}