Home | History | Annotate | Line # | Download | only in import
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