summaryrefslogtreecommitdiff
path: root/libm/ldouble
diff options
context:
space:
mode:
authorEric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
committerEric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
commit7ce331c01ce6eb7b3f5c715a38a24359da9c6ee2 (patch)
tree3a7e8476e868ae15f4da1b7ce26b2db6f434468c /libm/ldouble
parentc117dd5fb183afb1a4790a6f6110d88704be6bf8 (diff)
Totally rework the math library, this time based on the MacOs X
math library (which is itself based on the math lib from FreeBSD). -Erik
Diffstat (limited to 'libm/ldouble')
-rw-r--r--libm/ldouble/Makefile122
-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, 0 insertions, 27633 deletions
diff --git a/libm/ldouble/Makefile b/libm/ldouble/Makefile
deleted file mode 100644
index dad448840..000000000
--- a/libm/ldouble/Makefile
+++ /dev/null
@@ -1,122 +0,0 @@
-# Makefile for uClibc's math library
-# Copyright (C) 2001 by Lineo, inc.
-#
-# This math library is derived primarily from the Cephes Math Library,
-# copyright by Stephen L. Moshier <moshier@world.std.com>
-#
-# 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
-#
-
-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) $(TARGET_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)
- $(TARGET_CC) $(TARGET_CFLAGS) -o mtstl mtstl.o libml.a $(LIBS)
-
-mtstl.o: mtstl.c
-
-lparanoi: libml.a lparanoi.o setprec.o ieee.o econst.o $(OBJS)
- $(TARGET_CC) $(TARGET_CFLAGS) -o lparanoi lparanoi.o setprec.o ieee.o econst.o libml.a $(LIBS)
-
-lparanoi.o: lparanoi.c
- $(TARGET_CC) $(TARGET_CFLAGS) -Wno-implicit -c lparanoi.c
-
-econst.o: econst.c ehead.h
-
-lcalc: libml.a lcalc.o ieee.o econst.o $(OBJS)
- $(TARGET_CC) $(TARGET_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
- $(TARGET_CC) $(TARGET_CFLAGS) -o fltestl fltestl.c libml.a
-
-fltestl.o: fltestl.c
-
-flrtstl: flrtstl.c libml.a
- $(TARGET_CC) $(TARGET_CFLAGS) -o flrtstl flrtstl.c libml.a
-
-flrtstl.o: flrtstl.c
-
-nantst: nantst.c libml.a
- $(TARGET_CC) $(TARGET_CFLAGS) -o nantst nantst.c libml.a
-
-nantst.o: nantst.c
-
-testvect: testvect.o libml.a
- $(TARGET_CC) $(TARGET_CFLAGS) -o testvect testvect.o libml.a
-
-testvect.o: testvect.c
- $(TARGET_CC) -g -c -o testvect.o testvect.c
-
-monotl: monotl.o libml.a
- $(TARGET_CC) $(TARGET_CFLAGS) -o monotl monotl.o libml.a
-
-monotl.o: monotl.c
- $(TARGET_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
deleted file mode 100644
index 30fcaad36..000000000
--- a/libm/ldouble/README.txt
+++ /dev/null
@@ -1,3502 +0,0 @@
-/* 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
deleted file mode 100644
index 96c46bf22..000000000
--- a/libm/ldouble/acoshl.c
+++ /dev/null
@@ -1,167 +0,0 @@
-/* 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
deleted file mode 100644
index 952f027c6..000000000
--- a/libm/ldouble/arcdotl.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/* 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
deleted file mode 100644
index 025dfc29d..000000000
--- a/libm/ldouble/asinhl.c
+++ /dev/null
@@ -1,156 +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
- *
- */
-
-
-/*
-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
deleted file mode 100644
index 163f01055..000000000
--- a/libm/ldouble/asinl.c
+++ /dev/null
@@ -1,249 +0,0 @@
-/* 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
deleted file mode 100644
index 3dc7bd2eb..000000000
--- a/libm/ldouble/atanhl.c
+++ /dev/null
@@ -1,163 +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
- *
- */
-
-
-
-/*
-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
deleted file mode 100644
index 9e6d9af3c..000000000
--- a/libm/ldouble/atanl.c
+++ /dev/null
@@ -1,376 +0,0 @@
-/* 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
deleted file mode 100644
index aca9577d1..000000000
--- a/libm/ldouble/bdtrl.c
+++ /dev/null
@@ -1,260 +0,0 @@
-/* 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
deleted file mode 100644
index cbc4515da..000000000
--- a/libm/ldouble/btdtrl.c
+++ /dev/null
@@ -1,68 +0,0 @@
-
-/* 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
deleted file mode 100644
index 89ed11a06..000000000
--- a/libm/ldouble/cbrtl.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/* 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
deleted file mode 100644
index e55361e1f..000000000
--- a/libm/ldouble/chdtrl.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/* 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
deleted file mode 100644
index b3e6b25fb..000000000
--- a/libm/ldouble/clogl.c
+++ /dev/null
@@ -1,720 +0,0 @@
-/* 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
deleted file mode 100644
index ef130618d..000000000
--- a/libm/ldouble/cmplxl.c
+++ /dev/null
@@ -1,461 +0,0 @@
-/* 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
deleted file mode 100644
index 46212ae44..000000000
--- a/libm/ldouble/coshl.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/* 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
deleted file mode 100644
index cfddbe3e2..000000000
--- a/libm/ldouble/econst.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/* 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
deleted file mode 100644
index 785396dce..000000000
--- a/libm/ldouble/ehead.h
+++ /dev/null
@@ -1,45 +0,0 @@
-
-/* 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
deleted file mode 100644
index 851914454..000000000
--- a/libm/ldouble/elliel.c
+++ /dev/null
@@ -1,146 +0,0 @@
-/* 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
deleted file mode 100644
index 4eeffe0f5..000000000
--- a/libm/ldouble/ellikl.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/* 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
deleted file mode 100644
index 6965db066..000000000
--- a/libm/ldouble/ellpel.c
+++ /dev/null
@@ -1,173 +0,0 @@
-/* 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
deleted file mode 100644
index bb57fe6a1..000000000
--- a/libm/ldouble/ellpjl.c
+++ /dev/null
@@ -1,164 +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.
- *
- */
-
-/*
-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
deleted file mode 100644
index dd42ac861..000000000
--- a/libm/ldouble/ellpkl.c
+++ /dev/null
@@ -1,203 +0,0 @@
-/* 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
deleted file mode 100644
index b837571b4..000000000
--- a/libm/ldouble/exp10l.c
+++ /dev/null
@@ -1,192 +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
- *
- */
-
-/*
-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
deleted file mode 100644
index 076f8bca5..000000000
--- a/libm/ldouble/exp2l.c
+++ /dev/null
@@ -1,166 +0,0 @@
-/* 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
deleted file mode 100644
index 524246987..000000000
--- a/libm/ldouble/expl.c
+++ /dev/null
@@ -1,183 +0,0 @@
-/* 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
deleted file mode 100644
index da2f8910a..000000000
--- a/libm/ldouble/fdtrl.c
+++ /dev/null
@@ -1,237 +0,0 @@
-/* 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
deleted file mode 100644
index 1abdfb2cd..000000000
--- a/libm/ldouble/floorl.c
+++ /dev/null
@@ -1,432 +0,0 @@
-/* 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
deleted file mode 100644
index 77a389324..000000000
--- a/libm/ldouble/flrtstl.c
+++ /dev/null
@@ -1,104 +0,0 @@
-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
deleted file mode 100644
index 963e92467..000000000
--- a/libm/ldouble/fltestl.c
+++ /dev/null
@@ -1,265 +0,0 @@
-/* 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
deleted file mode 100644
index de7ed89a2..000000000
--- a/libm/ldouble/gammal.c
+++ /dev/null
@@ -1,764 +0,0 @@
-/* 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
deleted file mode 100644
index 9a41790cb..000000000
--- a/libm/ldouble/gdtrl.c
+++ /dev/null
@@ -1,130 +0,0 @@
-/* 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
deleted file mode 100644
index d66ad55e9..000000000
--- a/libm/ldouble/gelsl.c
+++ /dev/null
@@ -1,240 +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
-*/
-
-#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
deleted file mode 100644
index 584329b0c..000000000
--- a/libm/ldouble/ieee.c
+++ /dev/null
@@ -1,4182 +0,0 @@
-/* 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
deleted file mode 100644
index 1abe503e9..000000000
--- a/libm/ldouble/igamil.c
+++ /dev/null
@@ -1,193 +0,0 @@
-/* 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
deleted file mode 100644
index 0e59c5404..000000000
--- a/libm/ldouble/igaml.c
+++ /dev/null
@@ -1,220 +0,0 @@
-/* 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
deleted file mode 100644
index fc85ead4c..000000000
--- a/libm/ldouble/incbetl.c
+++ /dev/null
@@ -1,406 +0,0 @@
-/* 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
deleted file mode 100644
index b7610706b..000000000
--- a/libm/ldouble/incbil.c
+++ /dev/null
@@ -1,305 +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
- */
-
-
-/*
-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
deleted file mode 100644
index 44158ecc7..000000000
--- a/libm/ldouble/isnanl.c
+++ /dev/null
@@ -1,186 +0,0 @@
-/* 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
deleted file mode 100644
index a30a65a4f..000000000
--- a/libm/ldouble/j0l.c
+++ /dev/null
@@ -1,541 +0,0 @@
-/* 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
deleted file mode 100644
index 83428473e..000000000
--- a/libm/ldouble/j1l.c
+++ /dev/null
@@ -1,551 +0,0 @@
-/* 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
deleted file mode 100644
index 1b24c50c7..000000000
--- a/libm/ldouble/jnl.c
+++ /dev/null
@@ -1,130 +0,0 @@
-/* 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
deleted file mode 100644
index 87250952f..000000000
--- a/libm/ldouble/lcalc.c
+++ /dev/null
@@ -1,1484 +0,0 @@
-/* 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
deleted file mode 100644
index 7be51d79e..000000000
--- a/libm/ldouble/lcalc.h
+++ /dev/null
@@ -1,79 +0,0 @@
-/* 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
deleted file mode 100644
index 892b465df..000000000
--- a/libm/ldouble/ldrand.c
+++ /dev/null
@@ -1,175 +0,0 @@
-/* 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
deleted file mode 100644
index fa13ff3a2..000000000
--- a/libm/ldouble/log10l.c
+++ /dev/null
@@ -1,319 +0,0 @@
-/* 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
deleted file mode 100644
index 220b881ae..000000000
--- a/libm/ldouble/log2l.c
+++ /dev/null
@@ -1,302 +0,0 @@
-/* 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
deleted file mode 100644
index d6367eb19..000000000
--- a/libm/ldouble/logl.c
+++ /dev/null
@@ -1,292 +0,0 @@
-/* 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
deleted file mode 100644
index eb8fd25c7..000000000
--- a/libm/ldouble/lparanoi.c
+++ /dev/null
@@ -1,2348 +0,0 @@
-/* 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
deleted file mode 100644
index 86b85eca1..000000000
--- a/libm/ldouble/monotl.c
+++ /dev/null
@@ -1,307 +0,0 @@
-
-/* 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
deleted file mode 100644
index 17d0485d2..000000000
--- a/libm/ldouble/mtherr.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/* 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
deleted file mode 100644
index 0cd6eed16..000000000
--- a/libm/ldouble/mtstl.c
+++ /dev/null
@@ -1,521 +0,0 @@
-/* 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
deleted file mode 100644
index 855a43b5a..000000000
--- a/libm/ldouble/nantst.c
+++ /dev/null
@@ -1,61 +0,0 @@
-#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
deleted file mode 100644
index 91593f544..000000000
--- a/libm/ldouble/nbdtrl.c
+++ /dev/null
@@ -1,197 +0,0 @@
-/* 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
deleted file mode 100644
index b1a15cedf..000000000
--- a/libm/ldouble/ndtril.c
+++ /dev/null
@@ -1,416 +0,0 @@
-/* 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
deleted file mode 100644
index 2c53314a5..000000000
--- a/libm/ldouble/ndtrl.c
+++ /dev/null
@@ -1,473 +0,0 @@
-/* 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
deleted file mode 100644
index 861b1d9ae..000000000
--- a/libm/ldouble/pdtrl.c
+++ /dev/null
@@ -1,184 +0,0 @@
-/* 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
deleted file mode 100644
index ce37c6d9d..000000000
--- a/libm/ldouble/polevll.c
+++ /dev/null
@@ -1,182 +0,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.
- *
- */
-
-
-/*
-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
deleted file mode 100644
index d36c7854e..000000000
--- a/libm/ldouble/powil.c
+++ /dev/null
@@ -1,164 +0,0 @@
-/* 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
deleted file mode 100644
index bad380696..000000000
--- a/libm/ldouble/powl.c
+++ /dev/null
@@ -1,739 +0,0 @@
-/* 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
deleted file mode 100644
index 0533a1c7a..000000000
--- a/libm/ldouble/sinhl.c
+++ /dev/null
@@ -1,150 +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
- *
- */
-
-/*
-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
deleted file mode 100644
index dc7d739f9..000000000
--- a/libm/ldouble/sinl.c
+++ /dev/null
@@ -1,342 +0,0 @@
-/* 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
deleted file mode 100644
index a3b17175f..000000000
--- a/libm/ldouble/sqrtl.c
+++ /dev/null
@@ -1,172 +0,0 @@
-/* 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
deleted file mode 100644
index 4218d4133..000000000
--- a/libm/ldouble/stdtrl.c
+++ /dev/null
@@ -1,225 +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
- */
-
-
-/*
-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
deleted file mode 100644
index 42c7133c3..000000000
--- a/libm/ldouble/tanhl.c
+++ /dev/null
@@ -1,129 +0,0 @@
-/* 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
deleted file mode 100644
index e546dd664..000000000
--- a/libm/ldouble/tanl.c
+++ /dev/null
@@ -1,279 +0,0 @@
-/* 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
deleted file mode 100644
index 1c3ffcb91..000000000
--- a/libm/ldouble/testvect.c
+++ /dev/null
@@ -1,497 +0,0 @@
-
-/* 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
deleted file mode 100644
index 10670ce3a..000000000
--- a/libm/ldouble/unityl.c
+++ /dev/null
@@ -1,128 +0,0 @@
-/* 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
deleted file mode 100644
index bec958f01..000000000
--- a/libm/ldouble/wronkl.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/* 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
deleted file mode 100644
index 444792850..000000000
--- a/libm/ldouble/ynl.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/* 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 );
-}