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 /* glibc does never have a FE_DENORMAL.  */
  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 /* glibc does never have a FE_DENORMAL.  */
 134 #ifndef FE_DENORMAL
 135   if (options.fpe & GFC_FPE_DENORMAL)
 136     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 137                 "exception not supported.\n");
 138 #endif
 139
 140 #ifndef FE_DIVBYZERO
 141   if (options.fpe & GFC_FPE_ZERO)
 142     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 143                 "exception not supported.\n");
 144 #endif
 145
 146 #ifndef FE_OVERFLOW
 147   if (options.fpe & GFC_FPE_OVERFLOW)
 148     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 149                 "exception not supported.\n");
 150 #endif
 151
 152 #ifndef FE_UNDERFLOW
 153   if (options.fpe & GFC_FPE_UNDERFLOW)
 154     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 155                 "exception not supported.\n");
 156 #endif
 157
 158 #ifndef FE_INEXACT
 159   if (options.fpe & GFC_FPE_INEXACT)
 160     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 161                 "exception not supported.\n");
 162 #endif
 163
 164   set_fpu_trap_exceptions (options.fpe, 0);
 165 }
 166
 167
 168 int
 169 get_fpu_except_flags (void)
 170 {
 171   int result, set_excepts;
 172
 173   result = 0;
 174   set_excepts = fetestexcept (FE_ALL_EXCEPT);
 175
 176 #ifdef FE_INVALID
 177   if (set_excepts & FE_INVALID)
 178     result |= GFC_FPE_INVALID;
 179 #endif
 180
 181 #ifdef FE_DIVBYZERO
 182   if (set_excepts & FE_DIVBYZERO)
 183     result |= GFC_FPE_ZERO;
 184 #endif
 185
 186 #ifdef FE_OVERFLOW
 187   if (set_excepts & FE_OVERFLOW)
 188     result |= GFC_FPE_OVERFLOW;
 189 #endif
 190
 191 #ifdef FE_UNDERFLOW
 192   if (set_excepts & FE_UNDERFLOW)
 193     result |= GFC_FPE_UNDERFLOW;
 194 #endif
 195
 196 #ifdef FE_DENORMAL
 197   if (set_excepts & FE_DENORMAL)
 198     result |= GFC_FPE_DENORMAL;
 199 #endif
 200
 201 #ifdef FE_INEXACT
 202   if (set_excepts & FE_INEXACT)
 203     result |= GFC_FPE_INEXACT;
 204 #endif
 205
 206   return result;
 207 }
 208
 209
 210 void
 211 set_fpu_except_flags (int set, int clear)
 212 {
 213   int exc_set = 0, exc_clr = 0;
 214
 215 #ifdef FE_INVALID
 216   if (set & GFC_FPE_INVALID)
 217     exc_set |= FE_INVALID;
 218   else if (clear & GFC_FPE_INVALID)
 219     exc_clr |= FE_INVALID;
 220 #endif
 221
 222 #ifdef FE_DIVBYZERO
 223   if (set & GFC_FPE_ZERO)
 224     exc_set |= FE_DIVBYZERO;
 225   else if (clear & GFC_FPE_ZERO)
 226     exc_clr |= FE_DIVBYZERO;
 227 #endif
 228
 229 #ifdef FE_OVERFLOW
 230   if (set & GFC_FPE_OVERFLOW)
 231     exc_set |= FE_OVERFLOW;
 232   else if (clear & GFC_FPE_OVERFLOW)
 233     exc_clr |= FE_OVERFLOW;
 234 #endif
 235
 236 #ifdef FE_UNDERFLOW
 237   if (set & GFC_FPE_UNDERFLOW)
 238     exc_set |= FE_UNDERFLOW;
 239   else if (clear & GFC_FPE_UNDERFLOW)
 240     exc_clr |= FE_UNDERFLOW;
 241 #endif
 242
 243 #ifdef FE_DENORMAL
 244   if (set & GFC_FPE_DENORMAL)
 245     exc_set |= FE_DENORMAL;
 246   else if (clear & GFC_FPE_DENORMAL)
 247     exc_clr |= FE_DENORMAL;
 248 #endif
 249
 250 #ifdef FE_INEXACT
 251   if (set & GFC_FPE_INEXACT)
 252     exc_set |= FE_INEXACT;
 253   else if (clear & GFC_FPE_INEXACT)
 254     exc_clr |= FE_INEXACT;
 255 #endif
 256
 257   feclearexcept (exc_clr);
 258   feraiseexcept (exc_set);
 259 }
 260
 261
 262 int
 263 support_fpu_flag (int flag)
 264 {
 265   if (flag & GFC_FPE_INVALID)
 266   {
 267 #ifndef FE_INVALID
 268     return 0;
 269 #endif
 270   }
 271   else if (flag & GFC_FPE_ZERO)
 272   {
 273 #ifndef FE_DIVBYZERO
 274     return 0;
 275 #endif
 276   }
 277   else if (flag & GFC_FPE_OVERFLOW)
 278   {
 279 #ifndef FE_OVERFLOW
 280     return 0;
 281 #endif
 282   }
 283   else if (flag & GFC_FPE_UNDERFLOW)
 284   {
 285 #ifndef FE_UNDERFLOW
 286     return 0;
 287 #endif
 288   }
 289   else if (flag & GFC_FPE_DENORMAL)
 290   {
 291 #ifndef FE_DENORMAL
 292     return 0;
 293 #endif
 294   }
 295   else if (flag & GFC_FPE_INEXACT)
 296   {
 297 #ifndef FE_INEXACT
 298     return 0;
 299 #endif
 300   }
 301
 302   return 1;
 303 }
 304
 305
 306 int
 307 get_fpu_rounding_mode (void)
 308 {
 309   int rnd_mode;
 310
 311   rnd_mode = fegetround ();
 312
 313   switch (rnd_mode)
 314     {
 315 #ifdef FE_TONEAREST
 316       case FE_TONEAREST:
 317         return GFC_FPE_TONEAREST;
 318 #endif
 319
 320 #ifdef FE_UPWARD
 321       case FE_UPWARD:
 322         return GFC_FPE_UPWARD;
 323 #endif
 324
 325 #ifdef FE_DOWNWARD
 326       case FE_DOWNWARD:
 327         return GFC_FPE_DOWNWARD;
 328 #endif
 329
 330 #ifdef FE_TOWARDZERO
 331       case FE_TOWARDZERO:
 332         return GFC_FPE_TOWARDZERO;
 333 #endif
 334       default:
 335         return GFC_FPE_INVALID;
 336     }
 337 }
 338
 339
 340 void
 341 set_fpu_rounding_mode (int mode)
 342 {
 343   int rnd_mode;
 344
 345   switch (mode)
 346     {
 347 #ifdef FE_TONEAREST
 348       case GFC_FPE_TONEAREST:
 349         rnd_mode = FE_TONEAREST;
 350         break;
 351 #endif
 352
 353 #ifdef FE_UPWARD
 354       case GFC_FPE_UPWARD:
 355         rnd_mode = FE_UPWARD;
 356         break;
 357 #endif
 358
 359 #ifdef FE_DOWNWARD
 360       case GFC_FPE_DOWNWARD:
 361         rnd_mode = FE_DOWNWARD;
 362         break;
 363 #endif
 364
 365 #ifdef FE_TOWARDZERO
 366       case GFC_FPE_TOWARDZERO:
 367         rnd_mode = FE_TOWARDZERO;
 368         break;
 369 #endif
 370       default:
 371         return;
 372     }
 373
 374   fesetround (rnd_mode);
 375 }
 376
 377
 378 int
 379 support_fpu_rounding_mode (int mode)
 380 {
 381   switch (mode)
 382     {
 383       case GFC_FPE_TONEAREST:
 384 #ifdef FE_TONEAREST
 385         return 1;
 386 #else
 387         return 0;
 388 #endif
 389
 390       case GFC_FPE_UPWARD:
 391 #ifdef FE_UPWARD
 392         return 1;
 393 #else
 394         return 0;
 395 #endif
 396
 397       case GFC_FPE_DOWNWARD:
 398 #ifdef FE_DOWNWARD
 399         return 1;
 400 #else
 401         return 0;
 402 #endif
 403
 404       case GFC_FPE_TOWARDZERO:
 405 #ifdef FE_TOWARDZERO
 406         return 1;
 407 #else
 408         return 0;
 409 #endif
 410
 411       default:
 412         return 0;
 413     }
 414 }
 415
 416
 417 void
 418 get_fpu_state (void *state)
 419 {
 420   /* Check we can actually store the FPU state in the allocated size.  */
 421   assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 422
 423   fegetenv (state);
 424 }
 425
 426
 427 void
 428 set_fpu_state (void *state)
 429 {
 430   /* Check we can actually store the FPU state in the allocated size.  */
 431   assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 432
 433   fesetenv (state);
 434 }
 435