ack/lang/pc/libpc/exp.c

125 lines
2 KiB
C
Raw Permalink Normal View History

1984-07-20 10:44:57 +00:00
/*
* (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
1984-07-20 10:44:57 +00:00
1994-06-24 14:02:31 +00:00
/* $Id$ */
1988-07-25 11:40:57 +00:00
#define __NO_DEFS
#include <math.h>
2018-06-17 20:30:27 +00:00
#include "pc.h"
1984-07-20 10:44:57 +00:00
1990-11-06 13:02:55 +00:00
#if __STDC__
#include <float.h>
2018-06-17 14:11:29 +00:00
#define M_MIN_D DBL_MIN
#define M_MAX_D DBL_MAX
1991-09-17 16:38:16 +00:00
#define M_DMINEXP DBL_MIN_EXP
1990-11-06 13:02:55 +00:00
#endif
1991-03-20 11:30:35 +00:00
#undef HUGE
2018-06-17 14:11:29 +00:00
#define HUGE 1e1000
1990-11-06 13:02:55 +00:00
2018-06-17 20:30:27 +00:00
static double Ldexp(double fl, int exp)
1989-07-19 14:51:19 +00:00
{
int sign = 1;
int currexp;
2018-06-17 14:11:29 +00:00
if (fl < 0)
{
1989-07-19 14:51:19 +00:00
fl = -fl;
sign = -1;
}
2018-06-17 14:11:29 +00:00
fl = _fef(fl, &currexp);
1989-07-19 14:51:19 +00:00
exp += currexp;
2018-06-17 14:11:29 +00:00
if (exp > 0)
{
while (exp > 30)
{
fl *= (double)(1L << 30);
1989-07-19 14:51:19 +00:00
exp -= 30;
}
2018-06-17 14:11:29 +00:00
fl *= (double)(1L << exp);
1989-07-19 14:51:19 +00:00
}
2018-06-17 14:11:29 +00:00
else
{
while (exp < -30)
{
fl /= (double)(1L << 30);
1989-07-19 14:51:19 +00:00
exp += 30;
}
2018-06-17 14:11:29 +00:00
fl /= (double)(1L << -exp);
1989-07-19 14:51:19 +00:00
}
return sign * fl;
}
2018-06-17 20:30:27 +00:00
double _exp(double x)
1984-07-20 10:44:57 +00:00
{
1989-06-19 16:22:23 +00:00
/* Algorithm and coefficients from:
"Software manual for the elementary functions"
by W.J. Cody and W. Waite, Prentice-Hall, 1980
*/
1989-06-19 16:22:23 +00:00
static double p[] = {
2018-06-17 14:11:29 +00:00
0.25000000000000000000e+0,
0.75753180159422776666e-2,
1989-06-19 16:22:23 +00:00
0.31555192765684646356e-4
};
1989-06-19 16:22:23 +00:00
static double q[] = {
2018-06-17 14:11:29 +00:00
0.50000000000000000000e+0,
0.56817302698551221787e-1,
0.63121894374398503557e-3,
1989-06-19 16:22:23 +00:00
0.75104028399870046114e-6
};
2018-06-17 14:11:29 +00:00
double xn, g;
int n;
int negative = x < 0;
2018-06-17 14:11:29 +00:00
if (x <= M_LN_MIN_D)
{
g = M_MIN_D / 4.0;
1991-03-20 11:30:35 +00:00
2018-06-17 14:11:29 +00:00
if (g != 0.0)
{
1991-03-20 11:30:35 +00:00
/* unnormalized numbers apparently exist */
2018-06-17 14:11:29 +00:00
if (x < (M_LN2 * (M_DMINEXP - 53)))
return 0.0;
1991-03-20 11:30:35 +00:00
}
2018-06-17 14:11:29 +00:00
else
{
if (x < M_LN_MIN_D)
return 0.0;
1991-03-20 11:30:35 +00:00
return M_MIN_D;
}
}
2018-06-17 14:11:29 +00:00
if (x >= M_LN_MAX_D)
{
if (x > M_LN_MAX_D)
{
_trp(EEXP);
return HUGE;
}
return M_MAX_D;
}
2018-06-17 14:11:29 +00:00
if (negative)
x = -x;
2018-06-17 14:11:29 +00:00
n = x * M_LOG2E + 0.5; /* 1/ln(2) = log2(e), 0.5 added for rounding */
1989-06-19 16:22:23 +00:00
xn = n;
{
2018-06-17 14:11:29 +00:00
double x1 = (long)x;
double x2 = x - x1;
1989-06-19 16:22:23 +00:00
2018-06-17 14:11:29 +00:00
g = ((x1 - xn * 0.693359375) + x2) - xn * (-2.1219444005469058277e-4);
}
2018-06-17 14:11:29 +00:00
if (negative)
{
1989-06-19 16:22:23 +00:00
g = -g;
n = -n;
1984-07-20 10:44:57 +00:00
}
1989-06-19 16:22:23 +00:00
xn = g * g;
x = g * POLYNOM2(xn, p);
n += 1;
2018-06-17 14:11:29 +00:00
return (Ldexp(0.5 + x / (POLYNOM3(xn, q) - x), n));
1984-07-20 10:44:57 +00:00
}