xref: /dflybsd-src/contrib/openbsd_libm/src/s_fma.c (revision 4382f29d99a100bd77a81697c2f699c11f6a472a)
1*05a0b428SJohn Marino /*	$OpenBSD: s_fma.c,v 1.6 2013/11/12 19:00:38 martynas Exp $	*/
2*05a0b428SJohn Marino 
3*05a0b428SJohn Marino /*-
4*05a0b428SJohn Marino  * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG>
5*05a0b428SJohn Marino  * All rights reserved.
6*05a0b428SJohn Marino  *
7*05a0b428SJohn Marino  * Redistribution and use in source and binary forms, with or without
8*05a0b428SJohn Marino  * modification, are permitted provided that the following conditions
9*05a0b428SJohn Marino  * are met:
10*05a0b428SJohn Marino  * 1. Redistributions of source code must retain the above copyright
11*05a0b428SJohn Marino  *    notice, this list of conditions and the following disclaimer.
12*05a0b428SJohn Marino  * 2. Redistributions in binary form must reproduce the above copyright
13*05a0b428SJohn Marino  *    notice, this list of conditions and the following disclaimer in the
14*05a0b428SJohn Marino  *    documentation and/or other materials provided with the distribution.
15*05a0b428SJohn Marino  *
16*05a0b428SJohn Marino  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
17*05a0b428SJohn Marino  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18*05a0b428SJohn Marino  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19*05a0b428SJohn Marino  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
20*05a0b428SJohn Marino  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21*05a0b428SJohn Marino  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
22*05a0b428SJohn Marino  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
23*05a0b428SJohn Marino  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
24*05a0b428SJohn Marino  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
25*05a0b428SJohn Marino  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
26*05a0b428SJohn Marino  * SUCH DAMAGE.
27*05a0b428SJohn Marino  */
28*05a0b428SJohn Marino 
29*05a0b428SJohn Marino #include <fenv.h>
30*05a0b428SJohn Marino #include <float.h>
31*05a0b428SJohn Marino #include <math.h>
32*05a0b428SJohn Marino 
33*05a0b428SJohn Marino /*
34*05a0b428SJohn Marino  * Fused multiply-add: Compute x * y + z with a single rounding error.
35*05a0b428SJohn Marino  *
36*05a0b428SJohn Marino  * We use scaling to avoid overflow/underflow, along with the
37*05a0b428SJohn Marino  * canonical precision-doubling technique adapted from:
38*05a0b428SJohn Marino  *
39*05a0b428SJohn Marino  *	Dekker, T.  A Floating-Point Technique for Extending the
40*05a0b428SJohn Marino  *	Available Precision.  Numer. Math. 18, 224-242 (1971).
41*05a0b428SJohn Marino  *
42*05a0b428SJohn Marino  * This algorithm is sensitive to the rounding precision.  FPUs such
43*05a0b428SJohn Marino  * as the i387 must be set in double-precision mode if variables are
44*05a0b428SJohn Marino  * to be stored in FP registers in order to avoid incorrect results.
45*05a0b428SJohn Marino  * This is the default on FreeBSD, but not on many other systems.
46*05a0b428SJohn Marino  *
47*05a0b428SJohn Marino  * Hardware instructions should be used on architectures that support it,
48*05a0b428SJohn Marino  * since this implementation will likely be several times slower.
49*05a0b428SJohn Marino  */
50*05a0b428SJohn Marino #if LDBL_MANT_DIG != 113
51*05a0b428SJohn Marino double
fma(double x,double y,double z)52*05a0b428SJohn Marino fma(double x, double y, double z)
53*05a0b428SJohn Marino {
54*05a0b428SJohn Marino 	static const double split = 0x1p27 + 1.0;
55*05a0b428SJohn Marino 	double xs, ys, zs;
56*05a0b428SJohn Marino 	double c, cc, hx, hy, p, q, tx, ty;
57*05a0b428SJohn Marino 	double r, rr, s;
58*05a0b428SJohn Marino 	int oround;
59*05a0b428SJohn Marino 	int ex, ey, ez;
60*05a0b428SJohn Marino 	int spread;
61*05a0b428SJohn Marino 
62*05a0b428SJohn Marino 	/*
63*05a0b428SJohn Marino 	 * Handle special cases. The order of operations and the particular
64*05a0b428SJohn Marino 	 * return values here are crucial in handling special cases involving
65*05a0b428SJohn Marino 	 * infinities, NaNs, overflows, and signed zeroes correctly.
66*05a0b428SJohn Marino 	 */
67*05a0b428SJohn Marino 	if (x == 0.0 || y == 0.0)
68*05a0b428SJohn Marino 		return (x * y + z);
69*05a0b428SJohn Marino 	if (z == 0.0)
70*05a0b428SJohn Marino 		return (x * y);
71*05a0b428SJohn Marino 	if (!isfinite(x) || !isfinite(y))
72*05a0b428SJohn Marino 		return (x * y + z);
73*05a0b428SJohn Marino 	if (!isfinite(z))
74*05a0b428SJohn Marino 		return (z);
75*05a0b428SJohn Marino 
76*05a0b428SJohn Marino 	xs = frexp(x, &ex);
77*05a0b428SJohn Marino 	ys = frexp(y, &ey);
78*05a0b428SJohn Marino 	zs = frexp(z, &ez);
79*05a0b428SJohn Marino 	oround = fegetround();
80*05a0b428SJohn Marino 	spread = ex + ey - ez;
81*05a0b428SJohn Marino 
82*05a0b428SJohn Marino 	/*
83*05a0b428SJohn Marino 	 * If x * y and z are many orders of magnitude apart, the scaling
84*05a0b428SJohn Marino 	 * will overflow, so we handle these cases specially.  Rounding
85*05a0b428SJohn Marino 	 * modes other than FE_TONEAREST are painful.
86*05a0b428SJohn Marino 	 */
87*05a0b428SJohn Marino 	if (spread > DBL_MANT_DIG * 2) {
88*05a0b428SJohn Marino 		fenv_t env;
89*05a0b428SJohn Marino 		feraiseexcept(FE_INEXACT);
90*05a0b428SJohn Marino 		switch(oround) {
91*05a0b428SJohn Marino 		case FE_TONEAREST:
92*05a0b428SJohn Marino 			return (x * y);
93*05a0b428SJohn Marino 		case FE_TOWARDZERO:
94*05a0b428SJohn Marino 			if ((x > 0.0) ^ (y < 0.0) ^ (z < 0.0))
95*05a0b428SJohn Marino 				return (x * y);
96*05a0b428SJohn Marino 			feholdexcept(&env);
97*05a0b428SJohn Marino 			r = x * y;
98*05a0b428SJohn Marino 			if (!fetestexcept(FE_INEXACT))
99*05a0b428SJohn Marino 				r = nextafter(r, 0);
100*05a0b428SJohn Marino 			feupdateenv(&env);
101*05a0b428SJohn Marino 			return (r);
102*05a0b428SJohn Marino 		case FE_DOWNWARD:
103*05a0b428SJohn Marino 			if (z > 0.0)
104*05a0b428SJohn Marino 				return (x * y);
105*05a0b428SJohn Marino 			feholdexcept(&env);
106*05a0b428SJohn Marino 			r = x * y;
107*05a0b428SJohn Marino 			if (!fetestexcept(FE_INEXACT))
108*05a0b428SJohn Marino 				r = nextafter(r, -INFINITY);
109*05a0b428SJohn Marino 			feupdateenv(&env);
110*05a0b428SJohn Marino 			return (r);
111*05a0b428SJohn Marino 		default:	/* FE_UPWARD */
112*05a0b428SJohn Marino 			if (z < 0.0)
113*05a0b428SJohn Marino 				return (x * y);
114*05a0b428SJohn Marino 			feholdexcept(&env);
115*05a0b428SJohn Marino 			r = x * y;
116*05a0b428SJohn Marino 			if (!fetestexcept(FE_INEXACT))
117*05a0b428SJohn Marino 				r = nextafter(r, INFINITY);
118*05a0b428SJohn Marino 			feupdateenv(&env);
119*05a0b428SJohn Marino 			return (r);
120*05a0b428SJohn Marino 		}
121*05a0b428SJohn Marino 	}
122*05a0b428SJohn Marino 	if (spread < -DBL_MANT_DIG) {
123*05a0b428SJohn Marino 		feraiseexcept(FE_INEXACT);
124*05a0b428SJohn Marino 		if (!isnormal(z))
125*05a0b428SJohn Marino 			feraiseexcept(FE_UNDERFLOW);
126*05a0b428SJohn Marino 		switch (oround) {
127*05a0b428SJohn Marino 		case FE_TONEAREST:
128*05a0b428SJohn Marino 			return (z);
129*05a0b428SJohn Marino 		case FE_TOWARDZERO:
130*05a0b428SJohn Marino 			if ((x > 0.0) ^ (y < 0.0) ^ (z < 0.0))
131*05a0b428SJohn Marino 				return (z);
132*05a0b428SJohn Marino 			else
133*05a0b428SJohn Marino 				return (nextafter(z, 0));
134*05a0b428SJohn Marino 		case FE_DOWNWARD:
135*05a0b428SJohn Marino 			if ((x > 0.0) ^ (y < 0.0))
136*05a0b428SJohn Marino 				return (z);
137*05a0b428SJohn Marino 			else
138*05a0b428SJohn Marino 				return (nextafter(z, -INFINITY));
139*05a0b428SJohn Marino 		default:	/* FE_UPWARD */
140*05a0b428SJohn Marino 			if ((x > 0.0) ^ (y < 0.0))
141*05a0b428SJohn Marino 				return (nextafter(z, INFINITY));
142*05a0b428SJohn Marino 			else
143*05a0b428SJohn Marino 				return (z);
144*05a0b428SJohn Marino 		}
145*05a0b428SJohn Marino 	}
146*05a0b428SJohn Marino 
147*05a0b428SJohn Marino 	/*
148*05a0b428SJohn Marino 	 * Use Dekker's algorithm to perform the multiplication and
149*05a0b428SJohn Marino 	 * subsequent addition in twice the machine precision.
150*05a0b428SJohn Marino 	 * Arrange so that x * y = c + cc, and x * y + z = r + rr.
151*05a0b428SJohn Marino 	 */
152*05a0b428SJohn Marino 	fesetround(FE_TONEAREST);
153*05a0b428SJohn Marino 
154*05a0b428SJohn Marino 	p = xs * split;
155*05a0b428SJohn Marino 	hx = xs - p;
156*05a0b428SJohn Marino 	hx += p;
157*05a0b428SJohn Marino 	tx = xs - hx;
158*05a0b428SJohn Marino 
159*05a0b428SJohn Marino 	p = ys * split;
160*05a0b428SJohn Marino 	hy = ys - p;
161*05a0b428SJohn Marino 	hy += p;
162*05a0b428SJohn Marino 	ty = ys - hy;
163*05a0b428SJohn Marino 
164*05a0b428SJohn Marino 	p = hx * hy;
165*05a0b428SJohn Marino 	q = hx * ty + tx * hy;
166*05a0b428SJohn Marino 	c = p + q;
167*05a0b428SJohn Marino 	cc = p - c + q + tx * ty;
168*05a0b428SJohn Marino 
169*05a0b428SJohn Marino 	zs = ldexp(zs, -spread);
170*05a0b428SJohn Marino 	r = c + zs;
171*05a0b428SJohn Marino 	s = r - c;
172*05a0b428SJohn Marino 	rr = (c - (r - s)) + (zs - s) + cc;
173*05a0b428SJohn Marino 
174*05a0b428SJohn Marino 	spread = ex + ey;
175*05a0b428SJohn Marino 	if (spread + ilogb(r) > -1023) {
176*05a0b428SJohn Marino 		fesetround(oround);
177*05a0b428SJohn Marino 		r = r + rr;
178*05a0b428SJohn Marino 	} else {
179*05a0b428SJohn Marino 		/*
180*05a0b428SJohn Marino 		 * The result is subnormal, so we round before scaling to
181*05a0b428SJohn Marino 		 * avoid double rounding.
182*05a0b428SJohn Marino 		 */
183*05a0b428SJohn Marino 		p = ldexp(copysign(0x1p-1022, r), -spread);
184*05a0b428SJohn Marino 		c = r + p;
185*05a0b428SJohn Marino 		s = c - r;
186*05a0b428SJohn Marino 		cc = (r - (c - s)) + (p - s) + rr;
187*05a0b428SJohn Marino 		fesetround(oround);
188*05a0b428SJohn Marino 		r = (c + cc) - p;
189*05a0b428SJohn Marino 	}
190*05a0b428SJohn Marino 	return (ldexp(r, spread));
191*05a0b428SJohn Marino }
192*05a0b428SJohn Marino #else	/* LDBL_MANT_DIG == 113 */
193*05a0b428SJohn Marino /*
194*05a0b428SJohn Marino  * 113 bits of precision is more than twice the precision of a double,
195*05a0b428SJohn Marino  * so it is enough to represent the intermediate product exactly.
196*05a0b428SJohn Marino  */
197*05a0b428SJohn Marino double
fma(double x,double y,double z)198*05a0b428SJohn Marino fma(double x, double y, double z)
199*05a0b428SJohn Marino {
200*05a0b428SJohn Marino 	return ((long double)x * y + z);
201*05a0b428SJohn Marino }
202*05a0b428SJohn Marino #endif	/* LDBL_MANT_DIG != 113 */
203*05a0b428SJohn Marino 
204*05a0b428SJohn Marino #if	LDBL_MANT_DIG == DBL_MANT_DIG
205*05a0b428SJohn Marino __strong_alias(fmal, fma);
206*05a0b428SJohn Marino #endif	/* LDBL_MANT_DIG == DBL_MANT_DIG */
207