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__ == __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__ == __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__ == 31)
 141
 142 /* Long double is 128-bit IBM extended type.  */
 143
 144 static inline int
 145 __issignalingl (long double x)
 146 {
 147   union { long double value; double parts[2]; } u;
 148
 149   u.value = x;
 150   return __issignaling (u.parts[0]);
 151 }
 152
 153 #elif (__LDBL_DIG__ == 33) && __LDBL_IS_IEC_60559__
 154
 155 /* Long double is 128-bit type.  */
 156
 157 typedef union
 158 {
 159   long double value;
 160   struct
 161   {
 162 #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__
 163     uint64_t msw;
 164     uint64_t lsw;
 165 #elif __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__
 166     uint64_t lsw;
 167     uint64_t msw;
 168 #endif
 169   } parts64;
 170 } ieee854_long_double_shape_type;
 171
 172 static inline int
 173 __issignalingl (long double x)
 174 {
 175   uint64_t hxi, lxi;
 176   ieee854_long_double_shape_type u;
 177
 178   u.value = x;
 179   hxi = u.parts64.msw;
 180   lxi = u.parts64.lsw;
 181
 182   hxi ^= UINT64_C (0x0000800000000000);
 183   hxi |= (lxi | -lxi) >> 63;
 184   return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
 185 }
 186
 187 #else
 188
 189 static inline int
 190 __issignalingl (long double x)
 191 {
 192   return 0;
 193 }
 194
 195 #endif
 196
 197
 198 #if defined(GFC_REAL_16_IS_FLOAT128)
 199
 200 /* We have a _Float128 type.  */
 201
 202 typedef union
 203 {
 204   _Float128 value;
 205   struct
 206   {
 207 #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__
 208     uint64_t msw;
 209     uint64_t lsw;
 210 #elif __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__
 211     uint64_t lsw;
 212     uint64_t msw;
 213 #endif
 214   } parts64;
 215 } ieee854_float128_shape_type;
 216
 217 static inline int
 218 __issignalingf128 (_Float128 x)
 219 {
 220   uint64_t hxi, lxi;
 221   ieee854_float128_shape_type u;
 222
 223   u.value = x;
 224   hxi = u.parts64.msw;
 225   lxi = u.parts64.lsw;
 226
 227   hxi ^= UINT64_C (0x0000800000000000);
 228   hxi |= (lxi | -lxi) >> 63;
 229   return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
 230 }
 231
 232 #endif
 233
 234
 235 /* Define the type-generic macro based on the functions above.  */
 236
 237 #if defined(GFC_REAL_16_IS_FLOAT128)
 238 # define issignaling(X) \
 239   _Generic ((X), \
 240             _Float128: __issignalingf128, \
 241             float: __issignalingf, \
 242             double: __issignaling, \
 243             long double: __issignalingl)(X)
 244 #else
 245 # define issignaling(X) \
 246   _Generic ((X), \
 247             float: __issignalingf, \
 248             double: __issignaling, \
 249             long double: __issignalingl)(X)
 250 #endif
 251