libgfortran/config/fpu-aix.h

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