1/*-
2 * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
3 *
4 * Permission to use, copy, modify, and distribute this software for any
5 * purpose with or without fee is hereby granted, provided that the above
6 * copyright notice and this permission notice appear in all copies.
7 *
8 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15 */
16
17#include <sys/cdefs.h>
18__FBSDID("$FreeBSD: stable/11/lib/msun/ld80/e_powl.c 336767 2018-07-27 17:39:36Z dim $");
19
20#include <math.h>
21
22#include "math_private.h"
23
24/*
25 * Polynomial evaluator:
26 *  P[0] x^n  +  P[1] x^(n-1)  +  ...  +  P[n]
27 */
28static inline long double
29__polevll(long double x, long double *PP, int n)
30{
31	long double y;
32	long double *P;
33
34	P = PP;
35	y = *P++;
36	do {
37		y = y * x + *P++;
38	} while (--n);
39
40	return (y);
41}
42
43/*
44 * Polynomial evaluator:
45 *  x^n  +  P[0] x^(n-1)  +  P[1] x^(n-2)  +  ...  +  P[n]
46 */
47static inline long double
48__p1evll(long double x, long double *PP, int n)
49{
50	long double y;
51	long double *P;
52
53	P = PP;
54	n -= 1;
55	y = x + *P++;
56	do {
57		y = y * x + *P++;
58	} while (--n);
59
60	return (y);
61}
62
63/*							powl.c
64 *
65 *	Power function, long double precision
66 *
67 *
68 *
69 * SYNOPSIS:
70 *
71 * long double x, y, z, powl();
72 *
73 * z = powl( x, y );
74 *
75 *
76 *
77 * DESCRIPTION:
78 *
79 * Computes x raised to the yth power.  Analytically,
80 *
81 *      x**y  =  exp( y log(x) ).
82 *
83 * Following Cody and Waite, this program uses a lookup table
84 * of 2**-i/32 and pseudo extended precision arithmetic to
85 * obtain several extra bits of accuracy in both the logarithm
86 * and the exponential.
87 *
88 *
89 *
90 * ACCURACY:
91 *
92 * The relative error of pow(x,y) can be estimated
93 * by   y dl ln(2),   where dl is the absolute error of
94 * the internally computed base 2 logarithm.  At the ends
95 * of the approximation interval the logarithm equal 1/32
96 * and its relative error is about 1 lsb = 1.1e-19.  Hence
97 * the predicted relative error in the result is 2.3e-21 y .
98 *
99 *                      Relative error:
100 * arithmetic   domain     # trials      peak         rms
101 *
102 *    IEEE     +-1000       40000      2.8e-18      3.7e-19
103 * .001 < x < 1000, with log(x) uniformly distributed.
104 * -1000 < y < 1000, y uniformly distributed.
105 *
106 *    IEEE     0,8700       60000      6.5e-18      1.0e-18
107 * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
108 *
109 *
110 * ERROR MESSAGES:
111 *
112 *   message         condition      value returned
113 * pow overflow     x**y > MAXNUM      INFINITY
114 * pow underflow   x**y < 1/MAXNUM       0.0
115 * pow domain      x<0 and y noninteger  0.0
116 *
117 */
118
119#include <sys/cdefs.h>
120__FBSDID("$FreeBSD: stable/11/lib/msun/ld80/e_powl.c 336767 2018-07-27 17:39:36Z dim $");
121
122#include <float.h>
123#include <math.h>
124
125#include "math_private.h"
126
127/* Table size */
128#define NXT 32
129/* log2(Table size) */
130#define LNXT 5
131
132/* log(1+x) =  x - .5x^2 + x^3 *  P(z)/Q(z)
133 * on the domain  2^(-1/32) - 1  <=  x  <=  2^(1/32) - 1
134 */
135static long double P[] = {
136 8.3319510773868690346226E-4L,
137 4.9000050881978028599627E-1L,
138 1.7500123722550302671919E0L,
139 1.4000100839971580279335E0L,
140};
141static long double Q[] = {
142/* 1.0000000000000000000000E0L,*/
143 5.2500282295834889175431E0L,
144 8.4000598057587009834666E0L,
145 4.2000302519914740834728E0L,
146};
147/* A[i] = 2^(-i/32), rounded to IEEE long double precision.
148 * If i is even, A[i] + B[i/2] gives additional accuracy.
149 */
150static long double A[33] = {
151 1.0000000000000000000000E0L,
152 9.7857206208770013448287E-1L,
153 9.5760328069857364691013E-1L,
154 9.3708381705514995065011E-1L,
155 9.1700404320467123175367E-1L,
156 8.9735453750155359320742E-1L,
157 8.7812608018664974155474E-1L,
158 8.5930964906123895780165E-1L,
159 8.4089641525371454301892E-1L,
160 8.2287773907698242225554E-1L,
161 8.0524516597462715409607E-1L,
162 7.8799042255394324325455E-1L,
163 7.7110541270397041179298E-1L,
164 7.5458221379671136985669E-1L,
165 7.3841307296974965571198E-1L,
166 7.2259040348852331001267E-1L,
167 7.0710678118654752438189E-1L,
168 6.9195494098191597746178E-1L,
169 6.7712777346844636413344E-1L,
170 6.6261832157987064729696E-1L,
171 6.4841977732550483296079E-1L,
172 6.3452547859586661129850E-1L,
173 6.2092890603674202431705E-1L,
174 6.0762367999023443907803E-1L,
175 5.9460355750136053334378E-1L,
176 5.8186242938878875689693E-1L,
177 5.6939431737834582684856E-1L,
178 5.5719337129794626814472E-1L,
179 5.4525386633262882960438E-1L,
180 5.3357020033841180906486E-1L,
181 5.2213689121370692017331E-1L,
182 5.1094857432705833910408E-1L,
183 5.0000000000000000000000E-1L,
184};
185static long double B[17] = {
186 0.0000000000000000000000E0L,
187 2.6176170809902549338711E-20L,
188-1.0126791927256478897086E-20L,
189 1.3438228172316276937655E-21L,
190 1.2207982955417546912101E-20L,
191-6.3084814358060867200133E-21L,
192 1.3164426894366316434230E-20L,
193-1.8527916071632873716786E-20L,
194 1.8950325588932570796551E-20L,
195 1.5564775779538780478155E-20L,
196 6.0859793637556860974380E-21L,
197-2.0208749253662532228949E-20L,
198 1.4966292219224761844552E-20L,
199 3.3540909728056476875639E-21L,
200-8.6987564101742849540743E-22L,
201-1.2327176863327626135542E-20L,
202 0.0000000000000000000000E0L,
203};
204
205/* 2^x = 1 + x P(x),
206 * on the interval -1/32 <= x <= 0
207 */
208static long double R[] = {
209 1.5089970579127659901157E-5L,
210 1.5402715328927013076125E-4L,
211 1.3333556028915671091390E-3L,
212 9.6181291046036762031786E-3L,
213 5.5504108664798463044015E-2L,
214 2.4022650695910062854352E-1L,
215 6.9314718055994530931447E-1L,
216};
217
218#define douba(k) A[k]
219#define doubb(k) B[k]
220#define MEXP (NXT*16384.0L)
221/* The following if denormal numbers are supported, else -MEXP: */
222#define MNEXP (-NXT*(16384.0L+64.0L))
223/* log2(e) - 1 */
224#define LOG2EA 0.44269504088896340735992L
225
226#define F W
227#define Fa Wa
228#define Fb Wb
229#define G W
230#define Ga Wa
231#define Gb u
232#define H W
233#define Ha Wb
234#define Hb Wb
235
236static const long double MAXLOGL = 1.1356523406294143949492E4L;
237static const long double MINLOGL = -1.13994985314888605586758E4L;
238static const long double LOGE2L = 6.9314718055994530941723E-1L;
239static volatile long double z;
240static long double w, W, Wa, Wb, ya, yb, u;
241static const long double huge = 0x1p10000L;
242#if 0 /* XXX Prevent gcc from erroneously constant folding this. */
243static const long double twom10000 = 0x1p-10000L;
244#else
245static volatile long double twom10000 = 0x1p-10000L;
246#endif
247
248static long double reducl( long double );
249static long double powil ( long double, int );
250
251long double
252powl(long double x, long double y)
253{
254/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */
255int i, nflg, iyflg, yoddint;
256long e;
257
258if( y == 0.0L )
259	return( 1.0L );
260
261if( x == 1.0L )
262	return( 1.0L );
263
264if( isnan(x) )
265	return( x );
266if( isnan(y) )
267	return( y );
268
269if( y == 1.0L )
270	return( x );
271
272if( !isfinite(y) && x == -1.0L )
273	return( 1.0L );
274
275if( y >= LDBL_MAX )
276	{
277	if( x > 1.0L )
278		return( INFINITY );
279	if( x > 0.0L && x < 1.0L )
280		return( 0.0L );
281	if( x < -1.0L )
282		return( INFINITY );
283	if( x > -1.0L && x < 0.0L )
284		return( 0.0L );
285	}
286if( y <= -LDBL_MAX )
287	{
288	if( x > 1.0L )
289		return( 0.0L );
290	if( x > 0.0L && x < 1.0L )
291		return( INFINITY );
292	if( x < -1.0L )
293		return( 0.0L );
294	if( x > -1.0L && x < 0.0L )
295		return( INFINITY );
296	}
297if( x >= LDBL_MAX )
298	{
299	if( y > 0.0L )
300		return( INFINITY );
301	return( 0.0L );
302	}
303
304w = floorl(y);
305/* Set iyflg to 1 if y is an integer.  */
306iyflg = 0;
307if( w == y )
308	iyflg = 1;
309
310/* Test for odd integer y.  */
311yoddint = 0;
312if( iyflg )
313	{
314	ya = fabsl(y);
315	ya = floorl(0.5L * ya);
316	yb = 0.5L * fabsl(w);
317	if( ya != yb )
318		yoddint = 1;
319	}
320
321if( x <= -LDBL_MAX )
322	{
323	if( y > 0.0L )
324		{
325		if( yoddint )
326			return( -INFINITY );
327		return( INFINITY );
328		}
329	if( y < 0.0L )
330		{
331		if( yoddint )
332			return( -0.0L );
333		return( 0.0 );
334		}
335	}
336
337
338nflg = 0;	/* flag = 1 if x<0 raised to integer power */
339if( x <= 0.0L )
340	{
341	if( x == 0.0L )
342		{
343		if( y < 0.0 )
344			{
345			if( signbit(x) && yoddint )
346				return( -INFINITY );
347			return( INFINITY );
348			}
349		if( y > 0.0 )
350			{
351			if( signbit(x) && yoddint )
352				return( -0.0L );
353			return( 0.0 );
354			}
355		if( y == 0.0L )
356			return( 1.0L );  /*   0**0   */
357		else
358			return( 0.0L );  /*   0**y   */
359		}
360	else
361		{
362		if( iyflg == 0 )
363			return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */
364		nflg = 1;
365		}
366	}
367
368/* Integer power of an integer.  */
369
370if( iyflg )
371	{
372	i = w;
373	w = floorl(x);
374	if( (w == x) && (fabsl(y) < 32768.0) )
375		{
376		w = powil( x, (int) y );
377		return( w );
378		}
379	}
380
381
382if( nflg )
383	x = fabsl(x);
384
385/* separate significand from exponent */
386x = frexpl( x, &i );
387e = i;
388
389/* find significand in antilog table A[] */
390i = 1;
391if( x <= douba(17) )
392	i = 17;
393if( x <= douba(i+8) )
394	i += 8;
395if( x <= douba(i+4) )
396	i += 4;
397if( x <= douba(i+2) )
398	i += 2;
399if( x >= douba(1) )
400	i = -1;
401i += 1;
402
403
404/* Find (x - A[i])/A[i]
405 * in order to compute log(x/A[i]):
406 *
407 * log(x) = log( a x/a ) = log(a) + log(x/a)
408 *
409 * log(x/a) = log(1+v),  v = x/a - 1 = (x-a)/a
410 */
411x -= douba(i);
412x -= doubb(i/2);
413x /= douba(i);
414
415
416/* rational approximation for log(1+v):
417 *
418 * log(1+v)  =  v  -  v**2/2  +  v**3 P(v) / Q(v)
419 */
420z = x*x;
421w = x * ( z * __polevll( x, P, 3 ) / __p1evll( x, Q, 3 ) );
422w = w - ldexpl( z, -1 );   /*  w - 0.5 * z  */
423
424/* Convert to base 2 logarithm:
425 * multiply by log2(e) = 1 + LOG2EA
426 */
427z = LOG2EA * w;
428z += w;
429z += LOG2EA * x;
430z += x;
431
432/* Compute exponent term of the base 2 logarithm. */
433w = -i;
434w = ldexpl( w, -LNXT );	/* divide by NXT */
435w += e;
436/* Now base 2 log of x is w + z. */
437
438/* Multiply base 2 log by y, in extended precision. */
439
440/* separate y into large part ya
441 * and small part yb less than 1/NXT
442 */
443ya = reducl(y);
444yb = y - ya;
445
446/* (w+z)(ya+yb)
447 * = w*ya + w*yb + z*y
448 */
449F = z * y  +  w * yb;
450Fa = reducl(F);
451Fb = F - Fa;
452
453G = Fa + w * ya;
454Ga = reducl(G);
455Gb = G - Ga;
456
457H = Fb + Gb;
458Ha = reducl(H);
459w = ldexpl( Ga+Ha, LNXT );
460
461/* Test the power of 2 for overflow */
462if( w > MEXP )
463	return (huge * huge);		/* overflow */
464
465if( w < MNEXP )
466	return (twom10000 * twom10000);	/* underflow */
467
468e = w;
469Hb = H - Ha;
470
471if( Hb > 0.0L )
472	{
473	e += 1;
474	Hb -= (1.0L/NXT);  /*0.0625L;*/
475	}
476
477/* Now the product y * log2(x)  =  Hb + e/NXT.
478 *
479 * Compute base 2 exponential of Hb,
480 * where -0.0625 <= Hb <= 0.
481 */
482z = Hb * __polevll( Hb, R, 6 );  /*    z  =  2**Hb - 1    */
483
484/* Express e/NXT as an integer plus a negative number of (1/NXT)ths.
485 * Find lookup table entry for the fractional power of 2.
486 */
487if( e < 0 )
488	i = 0;
489else
490	i = 1;
491i = e/NXT + i;
492e = NXT*i - e;
493w = douba( e );
494z = w * z;      /*    2**-e * ( 1 + (2**Hb-1) )    */
495z = z + w;
496z = ldexpl( z, i );  /* multiply by integer power of 2 */
497
498if( nflg )
499	{
500/* For negative x,
501 * find out if the integer exponent
502 * is odd or even.
503 */
504	w = ldexpl( y, -1 );
505	w = floorl(w);
506	w = ldexpl( w, 1 );
507	if( w != y )
508		z = -z; /* odd exponent */
509	}
510
511return( z );
512}
513
514
515/* Find a multiple of 1/NXT that is within 1/NXT of x. */
516static inline long double
517reducl(long double x)
518{
519long double t;
520
521t = ldexpl( x, LNXT );
522t = floorl( t );
523t = ldexpl( t, -LNXT );
524return(t);
525}
526
527/*							powil.c
528 *
529 *	Real raised to integer power, long double precision
530 *
531 *
532 *
533 * SYNOPSIS:
534 *
535 * long double x, y, powil();
536 * int n;
537 *
538 * y = powil( x, n );
539 *
540 *
541 *
542 * DESCRIPTION:
543 *
544 * Returns argument x raised to the nth power.
545 * The routine efficiently decomposes n as a sum of powers of
546 * two. The desired power is a product of two-to-the-kth
547 * powers of x.  Thus to compute the 32767 power of x requires
548 * 28 multiplications instead of 32767 multiplications.
549 *
550 *
551 *
552 * ACCURACY:
553 *
554 *
555 *                      Relative error:
556 * arithmetic   x domain   n domain  # trials      peak         rms
557 *    IEEE     .001,1000  -1022,1023  50000       4.3e-17     7.8e-18
558 *    IEEE        1,2     -1022,1023  20000       3.9e-17     7.6e-18
559 *    IEEE     .99,1.01     0,8700    10000       3.6e-16     7.2e-17
560 *
561 * Returns MAXNUM on overflow, zero on underflow.
562 *
563 */
564
565static long double
566powil(long double x, int nn)
567{
568long double ww, y;
569long double s;
570int n, e, sign, asign, lx;
571
572if( x == 0.0L )
573	{
574	if( nn == 0 )
575		return( 1.0L );
576	else if( nn < 0 )
577		return( LDBL_MAX );
578	else
579		return( 0.0L );
580	}
581
582if( nn == 0 )
583	return( 1.0L );
584
585
586if( x < 0.0L )
587	{
588	asign = -1;
589	x = -x;
590	}
591else
592	asign = 0;
593
594
595if( nn < 0 )
596	{
597	sign = -1;
598	n = -nn;
599	}
600else
601	{
602	sign = 1;
603	n = nn;
604	}
605
606/* Overflow detection */
607
608/* Calculate approximate logarithm of answer */
609s = x;
610s = frexpl( s, &lx );
611e = (lx - 1)*n;
612if( (e == 0) || (e > 64) || (e < -64) )
613	{
614	s = (s - 7.0710678118654752e-1L) / (s +  7.0710678118654752e-1L);
615	s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L;
616	}
617else
618	{
619	s = LOGE2L * e;
620	}
621
622if( s > MAXLOGL )
623	return (huge * huge);		/* overflow */
624
625if( s < MINLOGL )
626	return (twom10000 * twom10000);	/* underflow */
627/* Handle tiny denormal answer, but with less accuracy
628 * since roundoff error in 1.0/x will be amplified.
629 * The precise demarcation should be the gradual underflow threshold.
630 */
631if( s < (-MAXLOGL+2.0L) )
632	{
633	x = 1.0L/x;
634	sign = -sign;
635	}
636
637/* First bit of the power */
638if( n & 1 )
639	y = x;
640
641else
642	{
643	y = 1.0L;
644	asign = 0;
645	}
646
647ww = x;
648n >>= 1;
649while( n )
650	{
651	ww = ww * ww;	/* arg to the 2-to-the-kth power */
652	if( n & 1 )	/* if that bit is set, then include in product */
653		y *= ww;
654	n >>= 1;
655	}
656
657if( asign )
658	y = -y; /* odd power of negative number */
659if( sign < 0 )
660	y = 1.0L/y;
661return(y);
662}
663