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