libgfortran/config/fpu-glibc.h

   1 /* FPU-related code for systems with GNU libc.
   2    Copyright (C) 2005-2017 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 #ifdef HAVE_FENV_H
  31 #include <fenv.h>
  32 #endif
  33
  34
  35 /* Check we can actually store the FPU state in the allocated size.  */
  36 _Static_assert (sizeof(fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE,
  37                 "GFC_FPE_STATE_BUFFER_SIZE is too small");
  38
  39
  40 void set_fpu_trap_exceptions (int trap, int notrap)
  41 {
  42 #ifdef FE_INVALID
  43   if (trap & GFC_FPE_INVALID)
  44     feenableexcept (FE_INVALID);
  45   if (notrap & GFC_FPE_INVALID)
  46     fedisableexcept (FE_INVALID);
  47 #endif
  48
  49 /* Some glibc targets (like alpha) have FE_DENORMAL, but not many.  */
  50 #ifdef FE_DENORMAL
  51   if (trap & GFC_FPE_DENORMAL)
  52     feenableexcept (FE_DENORMAL);
  53   if (notrap & GFC_FPE_DENORMAL)
  54     fedisableexcept (FE_DENORMAL);
  55 #endif
  56
  57 #ifdef FE_DIVBYZERO
  58   if (trap & GFC_FPE_ZERO)
  59     feenableexcept (FE_DIVBYZERO);
  60   if (notrap & GFC_FPE_ZERO)
  61     fedisableexcept (FE_DIVBYZERO);
  62 #endif
  63
  64 #ifdef FE_OVERFLOW
  65   if (trap & GFC_FPE_OVERFLOW)
  66     feenableexcept (FE_OVERFLOW);
  67   if (notrap & GFC_FPE_OVERFLOW)
  68     fedisableexcept (FE_OVERFLOW);
  69 #endif
  70
  71 #ifdef FE_UNDERFLOW
  72   if (trap & GFC_FPE_UNDERFLOW)
  73     feenableexcept (FE_UNDERFLOW);
  74   if (notrap & GFC_FPE_UNDERFLOW)
  75     fedisableexcept (FE_UNDERFLOW);
  76 #endif
  77
  78 #ifdef FE_INEXACT
  79   if (trap & GFC_FPE_INEXACT)
  80     feenableexcept (FE_INEXACT);
  81   if (notrap & GFC_FPE_INEXACT)
  82     fedisableexcept (FE_INEXACT);
  83 #endif
  84 }
  85
  86
  87 int
  88 get_fpu_trap_exceptions (void)
  89 {
  90   int exceptions = fegetexcept ();
  91   int res = 0;
  92
  93 #ifdef FE_INVALID
  94   if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
  95 #endif
  96
  97 #ifdef FE_DENORMAL
  98   if (exceptions & FE_DENORMAL) res |= GFC_FPE_DENORMAL;
  99 #endif
 100
 101 #ifdef FE_DIVBYZERO
 102   if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
 103 #endif
 104
 105 #ifdef FE_OVERFLOW
 106   if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
 107 #endif
 108
 109 #ifdef FE_UNDERFLOW
 110   if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
 111 #endif
 112
 113 #ifdef FE_INEXACT
 114   if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
 115 #endif
 116
 117   return res;
 118 }
 119
 120
 121 int
 122 support_fpu_trap (int flag)
 123 {
 124   int exceptions = 0;
 125   int old;
 126
 127   if (!support_fpu_flag (flag))
 128     return 0;
 129
 130 #ifdef FE_INVALID
 131   if (flag & GFC_FPE_INVALID) exceptions |= FE_INVALID;
 132 #endif
 133
 134 #ifdef FE_DIVBYZERO
 135   if (flag & GFC_FPE_ZERO) exceptions |= FE_DIVBYZERO;
 136 #endif
 137
 138 #ifdef FE_OVERFLOW
 139   if (flag & GFC_FPE_OVERFLOW) exceptions |= FE_OVERFLOW;
 140 #endif
 141
 142 #ifdef FE_UNDERFLOW
 143   if (flag & GFC_FPE_UNDERFLOW) exceptions |= FE_UNDERFLOW;
 144 #endif
 145
 146 #ifdef FE_DENORMAL
 147   if (flag & GFC_FPE_DENORMAL) exceptions |= FE_DENORMAL;
 148 #endif
 149
 150 #ifdef FE_INEXACT
 151   if (flag & GFC_FPE_INEXACT) exceptions |= FE_INEXACT;
 152 #endif
 153
 154   old = feenableexcept (exceptions);
 155   if (old == -1)
 156     return 0;
 157   fedisableexcept (exceptions & ~old);
 158   return 1;
 159 }
 160
 161
 162 void set_fpu (void)
 163 {
 164 #ifndef FE_INVALID
 165   if (options.fpe & GFC_FPE_INVALID)
 166     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
 167                 "exception not supported.\n");
 168 #endif
 169
 170 #ifndef FE_DENORMAL
 171   if (options.fpe & GFC_FPE_DENORMAL)
 172     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 173                 "exception not supported.\n");
 174 #endif
 175
 176 #ifndef FE_DIVBYZERO
 177   if (options.fpe & GFC_FPE_ZERO)
 178     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 179                 "exception not supported.\n");
 180 #endif
 181
 182 #ifndef FE_OVERFLOW
 183   if (options.fpe & GFC_FPE_OVERFLOW)
 184     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 185                 "exception not supported.\n");
 186 #endif
 187
 188 #ifndef FE_UNDERFLOW
 189   if (options.fpe & GFC_FPE_UNDERFLOW)
 190     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 191                 "exception not supported.\n");
 192 #endif
 193
 194 #ifndef FE_INEXACT
 195   if (options.fpe & GFC_FPE_INEXACT)
 196     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 197                 "exception not supported.\n");
 198 #endif
 199
 200   set_fpu_trap_exceptions (options.fpe, 0);
 201 }
 202
 203
 204 int
 205 get_fpu_except_flags (void)
 206 {
 207   int result, set_excepts;
 208
 209   result = 0;
 210   set_excepts = fetestexcept (FE_ALL_EXCEPT);
 211
 212 #ifdef FE_INVALID
 213   if (set_excepts & FE_INVALID)
 214     result |= GFC_FPE_INVALID;
 215 #endif
 216
 217 #ifdef FE_DIVBYZERO
 218   if (set_excepts & FE_DIVBYZERO)
 219     result |= GFC_FPE_ZERO;
 220 #endif
 221
 222 #ifdef FE_OVERFLOW
 223   if (set_excepts & FE_OVERFLOW)
 224     result |= GFC_FPE_OVERFLOW;
 225 #endif
 226
 227 #ifdef FE_UNDERFLOW
 228   if (set_excepts & FE_UNDERFLOW)
 229     result |= GFC_FPE_UNDERFLOW;
 230 #endif
 231
 232 #ifdef FE_DENORMAL
 233   if (set_excepts & FE_DENORMAL)
 234     result |= GFC_FPE_DENORMAL;
 235 #endif
 236
 237 #ifdef FE_INEXACT
 238   if (set_excepts & FE_INEXACT)
 239     result |= GFC_FPE_INEXACT;
 240 #endif
 241
 242   return result;
 243 }
 244
 245
 246 void
 247 set_fpu_except_flags (int set, int clear)
 248 {
 249   int exc_set = 0, exc_clr = 0;
 250
 251 #ifdef FE_INVALID
 252   if (set & GFC_FPE_INVALID)
 253     exc_set |= FE_INVALID;
 254   else if (clear & GFC_FPE_INVALID)
 255     exc_clr |= FE_INVALID;
 256 #endif
 257
 258 #ifdef FE_DIVBYZERO
 259   if (set & GFC_FPE_ZERO)
 260     exc_set |= FE_DIVBYZERO;
 261   else if (clear & GFC_FPE_ZERO)
 262     exc_clr |= FE_DIVBYZERO;
 263 #endif
 264
 265 #ifdef FE_OVERFLOW
 266   if (set & GFC_FPE_OVERFLOW)
 267     exc_set |= FE_OVERFLOW;
 268   else if (clear & GFC_FPE_OVERFLOW)
 269     exc_clr |= FE_OVERFLOW;
 270 #endif
 271
 272 #ifdef FE_UNDERFLOW
 273   if (set & GFC_FPE_UNDERFLOW)
 274     exc_set |= FE_UNDERFLOW;
 275   else if (clear & GFC_FPE_UNDERFLOW)
 276     exc_clr |= FE_UNDERFLOW;
 277 #endif
 278
 279 #ifdef FE_DENORMAL
 280   if (set & GFC_FPE_DENORMAL)
 281     exc_set |= FE_DENORMAL;
 282   else if (clear & GFC_FPE_DENORMAL)
 283     exc_clr |= FE_DENORMAL;
 284 #endif
 285
 286 #ifdef FE_INEXACT
 287   if (set & GFC_FPE_INEXACT)
 288     exc_set |= FE_INEXACT;
 289   else if (clear & GFC_FPE_INEXACT)
 290     exc_clr |= FE_INEXACT;
 291 #endif
 292
 293   feclearexcept (exc_clr);
 294   feraiseexcept (exc_set);
 295 }
 296
 297
 298 int
 299 support_fpu_flag (int flag)
 300 {
 301   if (flag & GFC_FPE_INVALID)
 302   {
 303 #ifndef FE_INVALID
 304     return 0;
 305 #endif
 306   }
 307   else if (flag & GFC_FPE_ZERO)
 308   {
 309 #ifndef FE_DIVBYZERO
 310     return 0;
 311 #endif
 312   }
 313   else if (flag & GFC_FPE_OVERFLOW)
 314   {
 315 #ifndef FE_OVERFLOW
 316     return 0;
 317 #endif
 318   }
 319   else if (flag & GFC_FPE_UNDERFLOW)
 320   {
 321 #ifndef FE_UNDERFLOW
 322     return 0;
 323 #endif
 324   }
 325   else if (flag & GFC_FPE_DENORMAL)
 326   {
 327 #ifndef FE_DENORMAL
 328     return 0;
 329 #endif
 330   }
 331   else if (flag & GFC_FPE_INEXACT)
 332   {
 333 #ifndef FE_INEXACT
 334     return 0;
 335 #endif
 336   }
 337
 338   return 1;
 339 }
 340
 341
 342 int
 343 get_fpu_rounding_mode (void)
 344 {
 345   int rnd_mode;
 346
 347   rnd_mode = fegetround ();
 348
 349   switch (rnd_mode)
 350     {
 351 #ifdef FE_TONEAREST
 352       case FE_TONEAREST:
 353         return GFC_FPE_TONEAREST;
 354 #endif
 355
 356 #ifdef FE_UPWARD
 357       case FE_UPWARD:
 358         return GFC_FPE_UPWARD;
 359 #endif
 360
 361 #ifdef FE_DOWNWARD
 362       case FE_DOWNWARD:
 363         return GFC_FPE_DOWNWARD;
 364 #endif
 365
 366 #ifdef FE_TOWARDZERO
 367       case FE_TOWARDZERO:
 368         return GFC_FPE_TOWARDZERO;
 369 #endif
 370
 371       default:
 372         return 0; /* Should be unreachable.  */
 373     }
 374 }
 375
 376
 377 void
 378 set_fpu_rounding_mode (int mode)
 379 {
 380   int rnd_mode;
 381
 382   switch (mode)
 383     {
 384 #ifdef FE_TONEAREST
 385       case GFC_FPE_TONEAREST:
 386         rnd_mode = FE_TONEAREST;
 387         break;
 388 #endif
 389
 390 #ifdef FE_UPWARD
 391       case GFC_FPE_UPWARD:
 392         rnd_mode = FE_UPWARD;
 393         break;
 394 #endif
 395
 396 #ifdef FE_DOWNWARD
 397       case GFC_FPE_DOWNWARD:
 398         rnd_mode = FE_DOWNWARD;
 399         break;
 400 #endif
 401
 402 #ifdef FE_TOWARDZERO
 403       case GFC_FPE_TOWARDZERO:
 404         rnd_mode = FE_TOWARDZERO;
 405         break;
 406 #endif
 407
 408       default:
 409         return; /* Should be unreachable.  */
 410     }
 411
 412   fesetround (rnd_mode);
 413 }
 414
 415
 416 int
 417 support_fpu_rounding_mode (int mode)
 418 {
 419   switch (mode)
 420     {
 421       case GFC_FPE_TONEAREST:
 422 #ifdef FE_TONEAREST
 423         return 1;
 424 #else
 425         return 0;
 426 #endif
 427
 428       case GFC_FPE_UPWARD:
 429 #ifdef FE_UPWARD
 430         return 1;
 431 #else
 432         return 0;
 433 #endif
 434
 435       case GFC_FPE_DOWNWARD:
 436 #ifdef FE_DOWNWARD
 437         return 1;
 438 #else
 439         return 0;
 440 #endif
 441
 442       case GFC_FPE_TOWARDZERO:
 443 #ifdef FE_TOWARDZERO
 444         return 1;
 445 #else
 446         return 0;
 447 #endif
 448
 449       default:
 450         return 0; /* Should be unreachable.  */
 451     }
 452 }
 453
 454
 455 void
 456 get_fpu_state (void *state)
 457 {
 458   fegetenv (state);
 459 }
 460
 461
 462 void
 463 set_fpu_state (void *state)
 464 {
 465   fesetenv (state);
 466 }
 467
 468
 469 /* Underflow in glibc is currently only supported on alpha, through
 470    the FE_MAP_UMZ macro and __ieee_set_fp_control() function call.  */
 471
 472 int
 473 support_fpu_underflow_control (int kind __attribute__((unused)))
 474 {
 475 #if defined(__alpha__) && defined(FE_MAP_UMZ)
 476   return (kind == 4 || kind == 8) ? 1 : 0;
 477 #else
 478   return 0;
 479 #endif
 480 }
 481
 482
 483 int
 484 get_fpu_underflow_mode (void)
 485 {
 486 #if defined(__alpha__) && defined(FE_MAP_UMZ)
 487
 488   fenv_t state = __ieee_get_fp_control ();
 489
 490   /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow.  */
 491   return (state & FE_MAP_UMZ) ? 0 : 1;
 492
 493 #else
 494
 495   return 0;
 496
 497 #endif
 498 }
 499
 500
 501 void
 502 set_fpu_underflow_mode (int gradual __attribute__((unused)))
 503 {
 504 #if defined(__alpha__) && defined(FE_MAP_UMZ)
 505
 506   fenv_t state = __ieee_get_fp_control ();
 507
 508   if (gradual)
 509     state &= ~FE_MAP_UMZ;
 510   else
 511     state |= FE_MAP_UMZ;
 512
 513   __ieee_set_fp_control (state);
 514
 515 #endif
 516 }
 517