1 1.1 christos /* Split a double into fraction and mantissa. 2 1.1.1.2 christos Copyright (C) 2007-2022 Free Software Foundation, Inc. 3 1.1 christos 4 1.1.1.2 christos This file is free software: you can redistribute it and/or modify 5 1.1.1.2 christos it under the terms of the GNU Lesser General Public License as 6 1.1.1.2 christos published by the Free Software Foundation; either version 2.1 of the 7 1.1.1.2 christos License, or (at your option) any later version. 8 1.1 christos 9 1.1.1.2 christos This file 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.1.2 christos GNU Lesser General Public License for more details. 13 1.1 christos 14 1.1.1.2 christos You should have received a copy of the GNU Lesser 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