Home | History | Annotate | Line # | Download | only in noieee_src
n_pow.c revision 1.11
      1  1.11    martin /*      $NetBSD: n_pow.c,v 1.11 2014/10/11 07:19:27 martin Exp $ */
      2   1.1     ragge /*
      3   1.1     ragge  * Copyright (c) 1985, 1993
      4   1.1     ragge  *	The Regents of the University of California.  All rights reserved.
      5   1.1     ragge  *
      6   1.1     ragge  * Redistribution and use in source and binary forms, with or without
      7   1.1     ragge  * modification, are permitted provided that the following conditions
      8   1.1     ragge  * are met:
      9   1.1     ragge  * 1. Redistributions of source code must retain the above copyright
     10   1.1     ragge  *    notice, this list of conditions and the following disclaimer.
     11   1.1     ragge  * 2. Redistributions in binary form must reproduce the above copyright
     12   1.1     ragge  *    notice, this list of conditions and the following disclaimer in the
     13   1.1     ragge  *    documentation and/or other materials provided with the distribution.
     14   1.7       agc  * 3. Neither the name of the University nor the names of its contributors
     15   1.1     ragge  *    may be used to endorse or promote products derived from this software
     16   1.1     ragge  *    without specific prior written permission.
     17   1.1     ragge  *
     18   1.1     ragge  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
     19   1.1     ragge  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
     20   1.1     ragge  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
     21   1.1     ragge  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
     22   1.1     ragge  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
     23   1.1     ragge  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
     24   1.1     ragge  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
     25   1.1     ragge  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
     26   1.1     ragge  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
     27   1.1     ragge  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
     28   1.1     ragge  * SUCH DAMAGE.
     29   1.1     ragge  */
     30   1.1     ragge 
     31   1.1     ragge #ifndef lint
     32   1.2     ragge #if 0
     33   1.1     ragge static char sccsid[] = "@(#)pow.c	8.1 (Berkeley) 6/4/93";
     34   1.2     ragge #endif
     35   1.1     ragge #endif /* not lint */
     36   1.1     ragge 
     37   1.4    simonb /* POW(X,Y)
     38   1.4    simonb  * RETURN X**Y
     39   1.1     ragge  * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
     40   1.4    simonb  * CODED IN C BY K.C. NG, 1/8/85;
     41   1.1     ragge  * REVISED BY K.C. NG on 7/10/85.
     42   1.1     ragge  * KERNEL pow_P() REPLACED BY P. McILROY 7/22/92.
     43   1.1     ragge  * Required system supported functions:
     44   1.4    simonb  *      scalb(x,n)
     45   1.4    simonb  *      logb(x)
     46   1.4    simonb  *	copysign(x,y)
     47   1.4    simonb  *	finite(x)
     48   1.1     ragge  *	drem(x,y)
     49   1.1     ragge  *
     50   1.1     ragge  * Required kernel functions:
     51   1.1     ragge  *	exp__D(a,c)			exp(a + c) for |a| << |c|
     52   1.1     ragge  *	struct d_double dlog(x)		r.a + r.b, |r.b| < |r.a|
     53   1.1     ragge  *
     54   1.1     ragge  * Method
     55   1.1     ragge  *	1. Compute and return log(x) in three pieces:
     56   1.1     ragge  *		log(x) = n*ln2 + hi + lo,
     57   1.1     ragge  *	   where n is an integer.
     58   1.4    simonb  *	2. Perform y*log(x) by simulating muti-precision arithmetic and
     59   1.1     ragge  *	   return the answer in three pieces:
     60   1.1     ragge  *		y*log(x) = m*ln2 + hi + lo,
     61   1.1     ragge  *	   where m is an integer.
     62   1.1     ragge  *	3. Return x**y = exp(y*log(x))
     63   1.1     ragge  *		= 2^m * ( exp(hi+lo) ).
     64   1.1     ragge  *
     65   1.1     ragge  * Special cases:
     66   1.1     ragge  *	(anything) ** 0  is 1 ;
     67   1.1     ragge  *	(anything) ** 1  is itself;
     68   1.1     ragge  *	(anything) ** NaN is NaN;
     69   1.1     ragge  *	NaN ** (anything except 0) is NaN;
     70   1.1     ragge  *	+(anything > 1) ** +INF is +INF;
     71   1.1     ragge  *	-(anything > 1) ** +INF is NaN;
     72   1.1     ragge  *	+-(anything > 1) ** -INF is +0;
     73   1.1     ragge  *	+-(anything < 1) ** +INF is +0;
     74   1.1     ragge  *	+(anything < 1) ** -INF is +INF;
     75   1.1     ragge  *	-(anything < 1) ** -INF is NaN;
     76   1.1     ragge  *	+-1 ** +-INF is NaN and signal INVALID;
     77   1.1     ragge  *	+0 ** +(anything except 0, NaN)  is +0;
     78   1.1     ragge  *	-0 ** +(anything except 0, NaN, odd integer)  is +0;
     79   1.1     ragge  *	+0 ** -(anything except 0, NaN)  is +INF and signal DIV-BY-ZERO;
     80   1.1     ragge  *	-0 ** -(anything except 0, NaN, odd integer)  is +INF with signal;
     81   1.1     ragge  *	-0 ** (odd integer) = -( +0 ** (odd integer) );
     82   1.1     ragge  *	+INF ** +(anything except 0,NaN) is +INF;
     83   1.1     ragge  *	+INF ** -(anything except 0,NaN) is +0;
     84   1.1     ragge  *	-INF ** (odd integer) = -( +INF ** (odd integer) );
     85   1.1     ragge  *	-INF ** (even integer) = ( +INF ** (even integer) );
     86   1.1     ragge  *	-INF ** -(anything except integer,NaN) is NaN with signal;
     87   1.1     ragge  *	-(x=anything) ** (k=integer) is (-1)**k * (x ** k);
     88   1.1     ragge  *	-(anything except 0) ** (non-integer) is NaN with signal;
     89   1.1     ragge  *
     90   1.1     ragge  * Accuracy:
     91   1.1     ragge  *	pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
     92   1.1     ragge  *	and a Zilog Z8000,
     93   1.1     ragge  *			pow(integer,integer)
     94   1.1     ragge  *	always returns the correct integer provided it is representable.
     95   1.1     ragge  *	In a test run with 100,000 random arguments with 0 < x, y < 20.0
     96   1.4    simonb  *	on a VAX, the maximum observed error was 1.79 ulps (units in the
     97   1.1     ragge  *	last place).
     98   1.1     ragge  *
     99   1.1     ragge  * Constants :
    100   1.1     ragge  * The hexadecimal values are the intended ones for the following constants.
    101   1.1     ragge  * The decimal values may be used, provided that the compiler will convert
    102   1.1     ragge  * from decimal to binary accurately enough to produce the hexadecimal values
    103   1.1     ragge  * shown.
    104   1.1     ragge  */
    105   1.1     ragge 
    106   1.1     ragge #include <errno.h>
    107   1.1     ragge #include <math.h>
    108   1.1     ragge 
    109   1.1     ragge #include "mathimpl.h"
    110   1.1     ragge 
    111   1.3      matt #if (defined(__vax__) || defined(tahoe))
    112   1.1     ragge #define TRUNC(x)	x = (double) (float) x
    113   1.1     ragge #define _IEEE		0
    114   1.1     ragge #else
    115   1.1     ragge #define _IEEE		1
    116   1.1     ragge #define endian		(((*(int *) &one)) ? 1 : 0)
    117   1.1     ragge #define TRUNC(x) 	*(((int *) &x)+endian) &= 0xf8000000
    118   1.1     ragge #define infnan(x)	0.0
    119   1.3      matt #endif		/* __vax__ or tahoe */
    120   1.1     ragge 
    121   1.6      matt static const double zero=0.0, one=1.0, two=2.0, negone= -1.0;
    122   1.1     ragge 
    123   1.6      matt static double pow_P (double, double);
    124   1.5      matt 
    125  1.10    martin #ifdef __weak_alias
    126  1.10    martin __weak_alias(_powf, powf);
    127  1.10    martin __weak_alias(_pow, pow);
    128  1.10    martin __weak_alias(_powl, pow);
    129  1.11    martin __weak_alias(powl, pow);
    130  1.10    martin #endif
    131  1.10    martin 
    132   1.6      matt float
    133   1.6      matt powf(float x, float y)
    134   1.5      matt {
    135   1.5      matt    return pow((double) x, (double) (y));
    136   1.5      matt }
    137   1.1     ragge 
    138   1.6      matt double
    139   1.6      matt pow(double x, double y)
    140   1.1     ragge {
    141   1.1     ragge 	double t;
    142   1.1     ragge 	if (y==zero)
    143   1.1     ragge 		return (one);
    144   1.1     ragge 	else if (y==one || (_IEEE && x != x))
    145   1.1     ragge 		return (x);		/* if x is NaN or y=1 */
    146   1.1     ragge 	else if (_IEEE && y!=y)		/* if y is NaN */
    147   1.1     ragge 		return (y);
    148   1.1     ragge 	else if (!finite(y))		/* if y is INF */
    149   1.1     ragge 		if ((t=fabs(x))==one)	/* +-1 ** +-INF is NaN */
    150   1.1     ragge 			return (y - y);
    151   1.1     ragge 		else if (t>one)
    152   1.1     ragge 			return ((y<0)? zero : ((x<zero)? y-y : y));
    153   1.1     ragge 		else
    154   1.1     ragge 			return ((y>0)? zero : ((x<0)? y-y : -y));
    155   1.1     ragge 	else if (y==two)
    156   1.1     ragge 		return (x*x);
    157   1.1     ragge 	else if (y==negone)
    158   1.1     ragge 		return (one/x);
    159   1.1     ragge     /* x > 0, x == +0 */
    160   1.1     ragge 	else if (copysign(one, x) == one)
    161   1.1     ragge 		return (pow_P(x, y));
    162   1.1     ragge 
    163   1.1     ragge     /* sign(x)= -1 */
    164   1.1     ragge 	/* if y is an even integer */
    165   1.1     ragge 	else if ( (t=drem(y,two)) == zero)
    166   1.1     ragge 		return (pow_P(-x, y));
    167   1.1     ragge 
    168   1.1     ragge 	/* if y is an odd integer */
    169   1.1     ragge 	else if (copysign(t,one) == one)
    170   1.1     ragge 		return (-pow_P(-x, y));
    171   1.1     ragge 
    172   1.1     ragge 	/* Henceforth y is not an integer */
    173   1.1     ragge 	else if (x==zero)	/* x is -0 */
    174   1.1     ragge 		return ((y>zero)? -x : one/(-x));
    175   1.1     ragge 	else if (_IEEE)
    176   1.1     ragge 		return (zero/zero);
    177   1.1     ragge 	else
    178   1.1     ragge 		return (infnan(EDOM));
    179   1.1     ragge }
    180   1.6      matt 
    181   1.1     ragge /* kernel function for x >= 0 */
    182   1.1     ragge static double
    183   1.1     ragge pow_P(double x, double y)
    184   1.1     ragge {
    185   1.2     ragge 	struct Double s, t;
    186   1.8  christos 	double  huge = _HUGE, tiny = _TINY;
    187   1.1     ragge 
    188   1.3      matt 	if (x == zero) {
    189   1.1     ragge 		if (y > zero)
    190   1.1     ragge 			return (zero);
    191   1.1     ragge 		else if (_IEEE)
    192   1.1     ragge 			return (huge*huge);
    193   1.1     ragge 		else
    194   1.1     ragge 			return (infnan(ERANGE));
    195   1.3      matt 	}
    196   1.1     ragge 	if (x == one)
    197   1.1     ragge 		return (one);
    198   1.3      matt 	if (!finite(x)) {
    199   1.1     ragge 		if (y < zero)
    200   1.1     ragge 			return (zero);
    201   1.1     ragge 		else if (_IEEE)
    202   1.1     ragge 			return (huge*huge);
    203   1.1     ragge 		else
    204   1.1     ragge 			return (infnan(ERANGE));
    205   1.3      matt 	}
    206   1.4    simonb 	if (y >= 7e18) {	/* infinity */
    207   1.1     ragge 		if (x < 1)
    208   1.1     ragge 			return(tiny*tiny);
    209   1.1     ragge 		else if (_IEEE)
    210   1.1     ragge 			return (huge*huge);
    211   1.1     ragge 		else
    212   1.1     ragge 			return (infnan(ERANGE));
    213   1.3      matt 	}
    214   1.1     ragge 
    215   1.1     ragge 	/* Return exp(y*log(x)), using simulated extended */
    216   1.1     ragge 	/* precision for the log and the multiply.	  */
    217   1.1     ragge 
    218   1.1     ragge 	s = __log__D(x);
    219   1.1     ragge 	t.a = y;
    220   1.1     ragge 	TRUNC(t.a);
    221   1.1     ragge 	t.b = y - t.a;
    222   1.1     ragge 	t.b = s.b*y + t.b*s.a;
    223   1.1     ragge 	t.a *= s.a;
    224   1.1     ragge 	s.a = t.a + t.b;
    225   1.1     ragge 	s.b = (t.a - s.a) + t.b;
    226   1.1     ragge 	return (__exp__D(s.a, s.b));
    227   1.1     ragge }
    228