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