libgfortran/ieee/issignaling_fallback.h

   1 /* Fallback implementation of issignaling macro.
   2    Copyright (C) 2022 Free Software Foundation, Inc.
   3    Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 3 of the License, or (at your option) any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #include "libgfortran.h"
  27
  28 /* This header provides an implementation of the type-generic issignaling macro.
  29    Some points of note:
  30
  31      - This header is only included if the issignaling macro is not defined.
  32      - All targets for which Fortran IEEE modules are supported currently have
  33        the high-order bit of the NaN mantissa clear for signaling (and set
  34        for quiet), as recommended by IEEE.
  35      - We use the __*_IS_IEC_60559__ macros to make sure we only deal with formats
  36        we know. For other floating-point formats, we consider all NaNs as quiet.
  37
  38  */
  39
  40 typedef union
  41 {
  42   float value;
  43   uint32_t word;
  44 } ieee_float_shape_type;
  45
  46 static inline int
  47 __issignalingf (float x)
  48 {
  49 #if __FLT_IS_IEC_60559__
  50   uint32_t xi;
  51   ieee_float_shape_type u;
  52
  53   u.value = x;
  54   xi = u.word;
  55
  56   xi ^= 0x00400000;
  57   return (xi & 0x7fffffff) > 0x7fc00000;
  58 #else
  59   return 0;
  60 #endif
  61 }
  62
  63
  64 typedef union
  65 {
  66   double value;
  67   uint64_t word;
  68 } ieee_double_shape_type;
  69
  70 static inline int
  71 __issignaling (double x)
  72 {
  73 #if __DBL_IS_IEC_60559__
  74   ieee_double_shape_type u;
  75   uint64_t xi;
  76
  77   u.value = x;
  78   xi = u.word;
  79
  80   xi ^= UINT64_C (0x0008000000000000);
  81   return (xi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7ff8000000000000);
  82 #else
  83   return 0;
  84 #endif
  85 }
  86
  87
  88 #if __LDBL_DIG__ == __DBL_DIG__
  89
  90 /* Long double is the same as double.  */
  91 static inline int
  92 __issignalingl (long double x)
  93 {
  94   return __issignaling (x);
  95 }
  96
  97 #elif (__LDBL_DIG__ == 18) && __LDBL_IS_IEC_60559__
  98
  99 /* Long double is x86 extended type.  */
 100
 101 typedef union
 102 {
 103   long double value;
 104   struct
 105   {
 106 #if __FLOAT_WORD_ORDER == __BIG_ENDIAN
 107     int sign_exponent:16;
 108     unsigned int empty:16;
 109     uint32_t msw;
 110     uint32_t lsw;
 111 #elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN
 112     uint32_t lsw;
 113     uint32_t msw;
 114     int sign_exponent:16;
 115     unsigned int empty:16;
 116 #endif
 117   } parts;
 118 } ieee_long_double_shape_type;
 119
 120 static inline int
 121 __issignalingl (long double x)
 122 {
 123   int ret;
 124   uint32_t exi, hxi, lxi;
 125   ieee_long_double_shape_type u;
 126
 127   u.value = x;
 128   exi = u.parts.sign_exponent;
 129   hxi = u.parts.msw;
 130   lxi = u.parts.lsw;
 131
 132   /* Pseudo numbers on x86 are always signaling.  */
 133   ret = (exi & 0x7fff) && ((hxi & 0x80000000) == 0);
 134
 135   hxi ^= 0x40000000;
 136   hxi |= (lxi | -lxi) >> 31;
 137   return ret || (((exi & 0x7fff) == 0x7fff) && (hxi > 0xc0000000));
 138 }
 139
 140 #elif (__LDBL_DIG__ = 33) && __LDBL_IS_IEC_60559__
 141
 142 /* Long double is 128-bit type.  */
 143
 144 typedef union
 145 {
 146   long double value;
 147   struct
 148   {
 149 #if __FLOAT_WORD_ORDER == __BIG_ENDIAN
 150     uint64_t msw;
 151     uint64_t lsw;
 152 #elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN
 153     uint64_t lsw;
 154     uint64_t msw;
 155 #endif
 156   } parts64;
 157 } ieee854_long_double_shape_type;
 158
 159 static inline int
 160 __issignalingl (long double x)
 161 {
 162   uint64_t hxi, lxi;
 163   ieee854_long_double_shape_type u;
 164
 165   u.value = x;
 166   hxi = u.parts64.msw;
 167   lxi = u.parts64.lsw;
 168
 169   hxi ^= UINT64_C (0x0000800000000000);
 170   hxi |= (lxi | -lxi) >> 63;
 171   return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
 172 }
 173
 174 #else
 175
 176 static inline int
 177 __issignalingl (long double x)
 178 {
 179   return 0;
 180 }
 181
 182 #endif
 183
 184
 185 #if __FLT128_IS_IEC_60559__
 186
 187 /* We have a _Float128 type.  */
 188
 189 typedef union
 190 {
 191   __float128 value;
 192   struct
 193   {
 194 #if __FLOAT_WORD_ORDER == __BIG_ENDIAN
 195     uint64_t msw;
 196     uint64_t lsw;
 197 #elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN
 198     uint64_t lsw;
 199     uint64_t msw;
 200 #endif
 201   } parts64;
 202 } ieee854_float128_shape_type;
 203
 204 static inline int
 205 __issignalingf128 (__float128 x)
 206 {
 207   uint64_t hxi, lxi;
 208   ieee854_float128_shape_type u;
 209
 210   u.value = x;
 211   hxi = u.parts64.msw;
 212   lxi = u.parts64.lsw;
 213
 214   hxi ^= UINT64_C (0x0000800000000000);
 215   hxi |= (lxi | -lxi) >> 63;
 216   return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
 217 }
 218
 219 #endif
 220
 221
 222 /* Define the type-generic macro based on the functions above.  */
 223
 224 #if __FLT128_IS_IEC_60559__
 225 # define issignaling(X) \
 226   _Generic ((X), \
 227             __float128: __issignalingf128, \
 228             float: __issignalingf, \
 229             double: __issignaling, \
 230             long double: __issignalingl)(X)
 231 #else
 232 # define issignaling(X) \
 233   _Generic ((X), \
 234             float: __issignalingf, \
 235             double: __issignaling, \
 236             long double: __issignalingl)(X)
 237 #endif
 238