frexp.c revision 1.1 1 1.1 christos /* Split a double into fraction and mantissa.
2 1.1 christos Copyright (C) 2007-2020 Free Software Foundation, Inc.
3 1.1 christos
4 1.1 christos This program is free software: you can redistribute it and/or modify
5 1.1 christos it under the terms of the GNU General Public License as published by
6 1.1 christos the Free Software Foundation; either version 3 of the License, or
7 1.1 christos (at your option) any later version.
8 1.1 christos
9 1.1 christos This program is distributed in the hope that it will be useful,
10 1.1 christos but WITHOUT ANY WARRANTY; without even the implied warranty of
11 1.1 christos MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 1.1 christos GNU General Public License for more details.
13 1.1 christos
14 1.1 christos You should have received a copy of the GNU General Public License
15 1.1 christos along with this program. If not, see <https://www.gnu.org/licenses/>. */
16 1.1 christos
17 1.1 christos /* Written by Paolo Bonzini <bonzini (at) gnu.org>, 2003, and
18 1.1 christos Bruno Haible <bruno (at) clisp.org>, 2007. */
19 1.1 christos
20 1.1 christos #if ! defined USE_LONG_DOUBLE
21 1.1 christos # include <config.h>
22 1.1 christos #endif
23 1.1 christos
24 1.1 christos /* Specification. */
25 1.1 christos #include <math.h>
26 1.1 christos
27 1.1 christos #include <float.h>
28 1.1 christos #ifdef USE_LONG_DOUBLE
29 1.1 christos # include "isnanl-nolibm.h"
30 1.1 christos # include "fpucw.h"
31 1.1 christos #else
32 1.1 christos # include "isnand-nolibm.h"
33 1.1 christos #endif
34 1.1 christos
35 1.1 christos /* This file assumes FLT_RADIX = 2. If FLT_RADIX is a power of 2 greater
36 1.1 christos than 2, or not even a power of 2, some rounding errors can occur, so that
37 1.1 christos then the returned mantissa is only guaranteed to be <= 1.0, not < 1.0. */
38 1.1 christos
39 1.1 christos #ifdef USE_LONG_DOUBLE
40 1.1 christos # define FUNC frexpl
41 1.1 christos # define DOUBLE long double
42 1.1 christos # define ISNAN isnanl
43 1.1 christos # define DECL_ROUNDING DECL_LONG_DOUBLE_ROUNDING
44 1.1 christos # define BEGIN_ROUNDING() BEGIN_LONG_DOUBLE_ROUNDING ()
45 1.1 christos # define END_ROUNDING() END_LONG_DOUBLE_ROUNDING ()
46 1.1 christos # define L_(literal) literal##L
47 1.1 christos #else
48 1.1 christos # define FUNC frexp
49 1.1 christos # define DOUBLE double
50 1.1 christos # define ISNAN isnand
51 1.1 christos # define DECL_ROUNDING
52 1.1 christos # define BEGIN_ROUNDING()
53 1.1 christos # define END_ROUNDING()
54 1.1 christos # define L_(literal) literal
55 1.1 christos #endif
56 1.1 christos
57 1.1 christos DOUBLE
58 1.1 christos FUNC (DOUBLE x, int *expptr)
59 1.1 christos {
60 1.1 christos int sign;
61 1.1 christos int exponent;
62 1.1 christos DECL_ROUNDING
63 1.1 christos
64 1.1 christos /* Test for NaN, infinity, and zero. */
65 1.1 christos if (ISNAN (x) || x + x == x)
66 1.1 christos {
67 1.1 christos *expptr = 0;
68 1.1 christos return x;
69 1.1 christos }
70 1.1 christos
71 1.1 christos sign = 0;
72 1.1 christos if (x < 0)
73 1.1 christos {
74 1.1 christos x = - x;
75 1.1 christos sign = -1;
76 1.1 christos }
77 1.1 christos
78 1.1 christos BEGIN_ROUNDING ();
79 1.1 christos
80 1.1 christos {
81 1.1 christos /* Since the exponent is an 'int', it fits in 64 bits. Therefore the
82 1.1 christos loops are executed no more than 64 times. */
83 1.1 christos DOUBLE pow2[64]; /* pow2[i] = 2^2^i */
84 1.1 christos DOUBLE powh[64]; /* powh[i] = 2^-2^i */
85 1.1 christos int i;
86 1.1 christos
87 1.1 christos exponent = 0;
88 1.1 christos if (x >= L_(1.0))
89 1.1 christos {
90 1.1 christos /* A positive exponent. */
91 1.1 christos DOUBLE pow2_i; /* = pow2[i] */
92 1.1 christos DOUBLE powh_i; /* = powh[i] */
93 1.1 christos
94 1.1 christos /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i,
95 1.1 christos x * 2^exponent = argument, x >= 1.0. */
96 1.1 christos for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5);
97 1.1 christos ;
98 1.1 christos i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i)
99 1.1 christos {
100 1.1 christos if (x >= pow2_i)
101 1.1 christos {
102 1.1 christos exponent += (1 << i);
103 1.1 christos x *= powh_i;
104 1.1 christos }
105 1.1 christos else
106 1.1 christos break;
107 1.1 christos
108 1.1 christos pow2[i] = pow2_i;
109 1.1 christos powh[i] = powh_i;
110 1.1 christos }
111 1.1 christos /* Avoid making x too small, as it could become a denormalized
112 1.1 christos number and thus lose precision. */
113 1.1 christos while (i > 0 && x < pow2[i - 1])
114 1.1 christos {
115 1.1 christos i--;
116 1.1 christos powh_i = powh[i];
117 1.1 christos }
118 1.1 christos exponent += (1 << i);
119 1.1 christos x *= powh_i;
120 1.1 christos /* Here 2^-2^i <= x < 1.0. */
121 1.1 christos }
122 1.1 christos else
123 1.1 christos {
124 1.1 christos /* A negative or zero exponent. */
125 1.1 christos DOUBLE pow2_i; /* = pow2[i] */
126 1.1 christos DOUBLE powh_i; /* = powh[i] */
127 1.1 christos
128 1.1 christos /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i,
129 1.1 christos x * 2^exponent = argument, x < 1.0. */
130 1.1 christos for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5);
131 1.1 christos ;
132 1.1 christos i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i)
133 1.1 christos {
134 1.1 christos if (x < powh_i)
135 1.1 christos {
136 1.1 christos exponent -= (1 << i);
137 1.1 christos x *= pow2_i;
138 1.1 christos }
139 1.1 christos else
140 1.1 christos break;
141 1.1 christos
142 1.1 christos pow2[i] = pow2_i;
143 1.1 christos powh[i] = powh_i;
144 1.1 christos }
145 1.1 christos /* Here 2^-2^i <= x < 1.0. */
146 1.1 christos }
147 1.1 christos
148 1.1 christos /* Invariants: x * 2^exponent = argument, and 2^-2^i <= x < 1.0. */
149 1.1 christos while (i > 0)
150 1.1 christos {
151 1.1 christos i--;
152 1.1 christos if (x < powh[i])
153 1.1 christos {
154 1.1 christos exponent -= (1 << i);
155 1.1 christos x *= pow2[i];
156 1.1 christos }
157 1.1 christos }
158 1.1 christos /* Here 0.5 <= x < 1.0. */
159 1.1 christos }
160 1.1 christos
161 1.1 christos if (sign < 0)
162 1.1 christos x = - x;
163 1.1 christos
164 1.1 christos END_ROUNDING ();
165 1.1 christos
166 1.1 christos *expptr = exponent;
167 1.1 christos return x;
168 1.1 christos }
169