1 /* $OpenBSD: s_expm1l.c,v 1.2 2016/09/12 19:47:02 guenther Exp $ */ 2 3 /* 4 * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> 5 * 6 * Permission to use, copy, modify, and distribute this software for any 7 * purpose with or without fee is hereby granted, provided that the above 8 * copyright notice and this permission notice appear in all copies. 9 * 10 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 */ 18 19 /* expm1l.c 20 * 21 * Exponential function, minus 1 22 * 128-bit long double precision 23 * 24 * 25 * 26 * SYNOPSIS: 27 * 28 * long double x, y, expm1l(); 29 * 30 * y = expm1l( x ); 31 * 32 * 33 * 34 * DESCRIPTION: 35 * 36 * Returns e (2.71828...) raised to the x power, minus one. 37 * 38 * Range reduction is accomplished by separating the argument 39 * into an integer k and fraction f such that 40 * 41 * x k f 42 * e = 2 e. 43 * 44 * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1 45 * in the basic range [-0.5 ln 2, 0.5 ln 2]. 46 * 47 * 48 * ACCURACY: 49 * 50 * Relative error: 51 * arithmetic domain # trials peak rms 52 * IEEE -79,+MAXLOG 100,000 1.7e-34 4.5e-35 53 * 54 */ 55 56 #include <errno.h> 57 #include <math.h> 58 59 #include "math_private.h" 60 61 /* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x) 62 -.5 ln 2 < x < .5 ln 2 63 Theoretical peak relative error = 8.1e-36 */ 64 65 static const long double 66 P0 = 2.943520915569954073888921213330863757240E8L, 67 P1 = -5.722847283900608941516165725053359168840E7L, 68 P2 = 8.944630806357575461578107295909719817253E6L, 69 P3 = -7.212432713558031519943281748462837065308E5L, 70 P4 = 4.578962475841642634225390068461943438441E4L, 71 P5 = -1.716772506388927649032068540558788106762E3L, 72 P6 = 4.401308817383362136048032038528753151144E1L, 73 P7 = -4.888737542888633647784737721812546636240E-1L, 74 Q0 = 1.766112549341972444333352727998584753865E9L, 75 Q1 = -7.848989743695296475743081255027098295771E8L, 76 Q2 = 1.615869009634292424463780387327037251069E8L, 77 Q3 = -2.019684072836541751428967854947019415698E7L, 78 Q4 = 1.682912729190313538934190635536631941751E6L, 79 Q5 = -9.615511549171441430850103489315371768998E4L, 80 Q6 = 3.697714952261803935521187272204485251835E3L, 81 Q7 = -8.802340681794263968892934703309274564037E1L, 82 /* Q8 = 1.000000000000000000000000000000000000000E0 */ 83 /* C1 + C2 = ln 2 */ 84 85 C1 = 6.93145751953125E-1L, 86 C2 = 1.428606820309417232121458176568075500134E-6L, 87 /* ln (2^16384 * (1 - 2^-113)) */ 88 maxlog = 1.1356523406294143949491931077970764891253E4L, 89 /* ln 2^-114 */ 90 minarg = -7.9018778583833765273564461846232128760607E1L, big = 1e4932L; 91 92 93 long double 94 expm1l(long double x) 95 { 96 long double px, qx, xx; 97 int32_t ix, sign; 98 ieee_quad_shape_type u; 99 int k; 100 101 /* Detect infinity and NaN. */ 102 u.value = x; 103 ix = u.parts32.mswhi; 104 sign = ix & 0x80000000; 105 ix &= 0x7fffffff; 106 if (ix >= 0x7fff0000) 107 { 108 /* Infinity. */ 109 if (((ix & 0xffff) | u.parts32.mswlo | u.parts32.lswhi | 110 u.parts32.lswlo) == 0) 111 { 112 if (sign) 113 return -1.0L; 114 else 115 return x; 116 } 117 /* NaN. No invalid exception. */ 118 return x; 119 } 120 121 /* expm1(+- 0) = +- 0. */ 122 if ((ix == 0) && (u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) 123 return x; 124 125 /* Overflow. */ 126 if (x > maxlog) 127 return (big * big); 128 129 /* Minimum value. */ 130 if (x < minarg) 131 return (4.0/big - 1.0L); 132 133 /* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */ 134 xx = C1 + C2; /* ln 2. */ 135 px = floorl (0.5 + x / xx); 136 k = px; 137 /* remainder times ln 2 */ 138 x -= px * C1; 139 x -= px * C2; 140 141 /* Approximate exp(remainder ln 2). */ 142 px = (((((((P7 * x 143 + P6) * x 144 + P5) * x + P4) * x + P3) * x + P2) * x + P1) * x + P0) * x; 145 146 qx = (((((((x 147 + Q7) * x 148 + Q6) * x + Q5) * x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0; 149 150 xx = x * x; 151 qx = x + (0.5 * xx + xx * px / qx); 152 153 /* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2). 154 155 We have qx = exp(remainder ln 2) - 1, so 156 exp(x) - 1 = 2^k (qx + 1) - 1 157 = 2^k qx + 2^k - 1. */ 158 159 px = ldexpl (1.0L, k); 160 x = px * qx + (px - 1.0); 161 return x; 162 } 163 DEF_STD(expm1l); 164