libgfortran/config/fpu-glibc.h

   1 /* FPU-related code for systems with GNU libc.
   2    Copyright (C) 2005-2014 Free Software Foundation, Inc.
   3    Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
   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 /* FPU-related code for systems with the GNU libc, providing the
  27    feenableexcept function in fenv.h to set individual exceptions
  28    (there's nothing to do that in C99).  */
  29
  30 #include <assert.h>
  31
  32 #ifdef HAVE_FENV_H
  33 #include <fenv.h>
  34 #endif
  35
  36
  37 void set_fpu_trap_exceptions (int trap, int notrap)
  38 {
  39 #ifdef FE_INVALID
  40   if (trap & GFC_FPE_INVALID)
  41     feenableexcept (FE_INVALID);
  42   if (notrap & GFC_FPE_INVALID)
  43     fedisableexcept (FE_INVALID);
  44 #endif
  45
  46 /* Some glibc targets (like alpha) have FE_DENORMAL, but not many.  */
  47 #ifdef FE_DENORMAL
  48   if (trap & GFC_FPE_DENORMAL)
  49     feenableexcept (FE_DENORMAL);
  50   if (notrap & GFC_FPE_DENORMAL)
  51     fedisableexcept (FE_DENORMAL);
  52 #endif
  53
  54 #ifdef FE_DIVBYZERO
  55   if (trap & GFC_FPE_ZERO)
  56     feenableexcept (FE_DIVBYZERO);
  57   if (notrap & GFC_FPE_ZERO)
  58     fedisableexcept (FE_DIVBYZERO);
  59 #endif
  60
  61 #ifdef FE_OVERFLOW
  62   if (trap & GFC_FPE_OVERFLOW)
  63     feenableexcept (FE_OVERFLOW);
  64   if (notrap & GFC_FPE_OVERFLOW)
  65     fedisableexcept (FE_OVERFLOW);
  66 #endif
  67
  68 #ifdef FE_UNDERFLOW
  69   if (trap & GFC_FPE_UNDERFLOW)
  70     feenableexcept (FE_UNDERFLOW);
  71   if (notrap & GFC_FPE_UNDERFLOW)
  72     fedisableexcept (FE_UNDERFLOW);
  73 #endif
  74
  75 #ifdef FE_INEXACT
  76   if (trap & GFC_FPE_INEXACT)
  77     feenableexcept (FE_INEXACT);
  78   if (notrap & GFC_FPE_INEXACT)
  79     fedisableexcept (FE_INEXACT);
  80 #endif
  81 }
  82
  83
  84 int
  85 get_fpu_trap_exceptions (void)
  86 {
  87   int exceptions = fegetexcept ();
  88   int res = 0;
  89
  90 #ifdef FE_INVALID
  91   if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
  92 #endif
  93
  94 #ifdef FE_DENORMAL
  95   if (exceptions & FE_DENORMAL) res |= GFC_FPE_DENORMAL;
  96 #endif
  97
  98 #ifdef FE_DIVBYZERO
  99   if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
 100 #endif
 101
 102 #ifdef FE_OVERFLOW
 103   if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
 104 #endif
 105
 106 #ifdef FE_UNDERFLOW
 107   if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
 108 #endif
 109
 110 #ifdef FE_INEXACT
 111   if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
 112 #endif
 113
 114   return res;
 115 }
 116
 117
 118 int
 119 support_fpu_trap (int flag)
 120 {
 121   return support_fpu_flag (flag);
 122 }
 123
 124
 125 void set_fpu (void)
 126 {
 127 #ifndef FE_INVALID
 128   if (options.fpe & GFC_FPE_INVALID)
 129     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
 130                 "exception not supported.\n");
 131 #endif
 132
 133 #ifndef FE_DENORMAL
 134   if (options.fpe & GFC_FPE_DENORMAL)
 135     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 136                 "exception not supported.\n");
 137 #endif
 138
 139 #ifndef FE_DIVBYZERO
 140   if (options.fpe & GFC_FPE_ZERO)
 141     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 142                 "exception not supported.\n");
 143 #endif
 144
 145 #ifndef FE_OVERFLOW
 146   if (options.fpe & GFC_FPE_OVERFLOW)
 147     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 148                 "exception not supported.\n");
 149 #endif
 150
 151 #ifndef FE_UNDERFLOW
 152   if (options.fpe & GFC_FPE_UNDERFLOW)
 153     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 154                 "exception not supported.\n");
 155 #endif
 156
 157 #ifndef FE_INEXACT
 158   if (options.fpe & GFC_FPE_INEXACT)
 159     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 160                 "exception not supported.\n");
 161 #endif
 162
 163   set_fpu_trap_exceptions (options.fpe, 0);
 164 }
 165
 166
 167 int
 168 get_fpu_except_flags (void)
 169 {
 170   int result, set_excepts;
 171
 172   result = 0;
 173   set_excepts = fetestexcept (FE_ALL_EXCEPT);
 174
 175 #ifdef FE_INVALID
 176   if (set_excepts & FE_INVALID)
 177     result |= GFC_FPE_INVALID;
 178 #endif
 179
 180 #ifdef FE_DIVBYZERO
 181   if (set_excepts & FE_DIVBYZERO)
 182     result |= GFC_FPE_ZERO;
 183 #endif
 184
 185 #ifdef FE_OVERFLOW
 186   if (set_excepts & FE_OVERFLOW)
 187     result |= GFC_FPE_OVERFLOW;
 188 #endif
 189
 190 #ifdef FE_UNDERFLOW
 191   if (set_excepts & FE_UNDERFLOW)
 192     result |= GFC_FPE_UNDERFLOW;
 193 #endif
 194
 195 #ifdef FE_DENORMAL
 196   if (set_excepts & FE_DENORMAL)
 197     result |= GFC_FPE_DENORMAL;
 198 #endif
 199
 200 #ifdef FE_INEXACT
 201   if (set_excepts & FE_INEXACT)
 202     result |= GFC_FPE_INEXACT;
 203 #endif
 204
 205   return result;
 206 }
 207
 208
 209 void
 210 set_fpu_except_flags (int set, int clear)
 211 {
 212   int exc_set = 0, exc_clr = 0;
 213
 214 #ifdef FE_INVALID
 215   if (set & GFC_FPE_INVALID)
 216     exc_set |= FE_INVALID;
 217   else if (clear & GFC_FPE_INVALID)
 218     exc_clr |= FE_INVALID;
 219 #endif
 220
 221 #ifdef FE_DIVBYZERO
 222   if (set & GFC_FPE_ZERO)
 223     exc_set |= FE_DIVBYZERO;
 224   else if (clear & GFC_FPE_ZERO)
 225     exc_clr |= FE_DIVBYZERO;
 226 #endif
 227
 228 #ifdef FE_OVERFLOW
 229   if (set & GFC_FPE_OVERFLOW)
 230     exc_set |= FE_OVERFLOW;
 231   else if (clear & GFC_FPE_OVERFLOW)
 232     exc_clr |= FE_OVERFLOW;
 233 #endif
 234
 235 #ifdef FE_UNDERFLOW
 236   if (set & GFC_FPE_UNDERFLOW)
 237     exc_set |= FE_UNDERFLOW;
 238   else if (clear & GFC_FPE_UNDERFLOW)
 239     exc_clr |= FE_UNDERFLOW;
 240 #endif
 241
 242 #ifdef FE_DENORMAL
 243   if (set & GFC_FPE_DENORMAL)
 244     exc_set |= FE_DENORMAL;
 245   else if (clear & GFC_FPE_DENORMAL)
 246     exc_clr |= FE_DENORMAL;
 247 #endif
 248
 249 #ifdef FE_INEXACT
 250   if (set & GFC_FPE_INEXACT)
 251     exc_set |= FE_INEXACT;
 252   else if (clear & GFC_FPE_INEXACT)
 253     exc_clr |= FE_INEXACT;
 254 #endif
 255
 256   feclearexcept (exc_clr);
 257   feraiseexcept (exc_set);
 258 }
 259
 260
 261 int
 262 support_fpu_flag (int flag)
 263 {
 264   if (flag & GFC_FPE_INVALID)
 265   {
 266 #ifndef FE_INVALID
 267     return 0;
 268 #endif
 269   }
 270   else if (flag & GFC_FPE_ZERO)
 271   {
 272 #ifndef FE_DIVBYZERO
 273     return 0;
 274 #endif
 275   }
 276   else if (flag & GFC_FPE_OVERFLOW)
 277   {
 278 #ifndef FE_OVERFLOW
 279     return 0;
 280 #endif
 281   }
 282   else if (flag & GFC_FPE_UNDERFLOW)
 283   {
 284 #ifndef FE_UNDERFLOW
 285     return 0;
 286 #endif
 287   }
 288   else if (flag & GFC_FPE_DENORMAL)
 289   {
 290 #ifndef FE_DENORMAL
 291     return 0;
 292 #endif
 293   }
 294   else if (flag & GFC_FPE_INEXACT)
 295   {
 296 #ifndef FE_INEXACT
 297     return 0;
 298 #endif
 299   }
 300
 301   return 1;
 302 }
 303
 304
 305 int
 306 get_fpu_rounding_mode (void)
 307 {
 308   int rnd_mode;
 309
 310   rnd_mode = fegetround ();
 311
 312   switch (rnd_mode)
 313     {
 314 #ifdef FE_TONEAREST
 315       case FE_TONEAREST:
 316         return GFC_FPE_TONEAREST;
 317 #endif
 318
 319 #ifdef FE_UPWARD
 320       case FE_UPWARD:
 321         return GFC_FPE_UPWARD;
 322 #endif
 323
 324 #ifdef FE_DOWNWARD
 325       case FE_DOWNWARD:
 326         return GFC_FPE_DOWNWARD;
 327 #endif
 328
 329 #ifdef FE_TOWARDZERO
 330       case FE_TOWARDZERO:
 331         return GFC_FPE_TOWARDZERO;
 332 #endif
 333       default:
 334         return GFC_FPE_INVALID;
 335     }
 336 }
 337
 338
 339 void
 340 set_fpu_rounding_mode (int mode)
 341 {
 342   int rnd_mode;
 343
 344   switch (mode)
 345     {
 346 #ifdef FE_TONEAREST
 347       case GFC_FPE_TONEAREST:
 348         rnd_mode = FE_TONEAREST;
 349         break;
 350 #endif
 351
 352 #ifdef FE_UPWARD
 353       case GFC_FPE_UPWARD:
 354         rnd_mode = FE_UPWARD;
 355         break;
 356 #endif
 357
 358 #ifdef FE_DOWNWARD
 359       case GFC_FPE_DOWNWARD:
 360         rnd_mode = FE_DOWNWARD;
 361         break;
 362 #endif
 363
 364 #ifdef FE_TOWARDZERO
 365       case GFC_FPE_TOWARDZERO:
 366         rnd_mode = FE_TOWARDZERO;
 367         break;
 368 #endif
 369       default:
 370         return;
 371     }
 372
 373   fesetround (rnd_mode);
 374 }
 375
 376
 377 int
 378 support_fpu_rounding_mode (int mode)
 379 {
 380   switch (mode)
 381     {
 382       case GFC_FPE_TONEAREST:
 383 #ifdef FE_TONEAREST
 384         return 1;
 385 #else
 386         return 0;
 387 #endif
 388
 389       case GFC_FPE_UPWARD:
 390 #ifdef FE_UPWARD
 391         return 1;
 392 #else
 393         return 0;
 394 #endif
 395
 396       case GFC_FPE_DOWNWARD:
 397 #ifdef FE_DOWNWARD
 398         return 1;
 399 #else
 400         return 0;
 401 #endif
 402
 403       case GFC_FPE_TOWARDZERO:
 404 #ifdef FE_TOWARDZERO
 405         return 1;
 406 #else
 407         return 0;
 408 #endif
 409
 410       default:
 411         return 0;
 412     }
 413 }
 414
 415
 416 void
 417 get_fpu_state (void *state)
 418 {
 419   /* Check we can actually store the FPU state in the allocated size.  */
 420   assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 421
 422   fegetenv (state);
 423 }
 424
 425
 426 void
 427 set_fpu_state (void *state)
 428 {
 429   /* Check we can actually store the FPU state in the allocated size.  */
 430   assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 431
 432   fesetenv (state);
 433 }
 434