libgfortran/config/fpu-aix.h

   1 /* AIX FPU-related code.
   2    Copyright (C) 2005-2023 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 #ifdef FE_TONEARESTFROMZERO
 324       case FE_TONEARESTFROMZERO:
 325         return GFC_FPE_AWAY;
 326 #endif
 327
 328       default:
 329         return 0; /* Should be unreachable.  */
 330     }
 331 }
 332
 333
 334 void
 335 set_fpu_rounding_mode (int mode)
 336 {
 337   int rnd_mode;
 338
 339   switch (mode)
 340     {
 341 #ifdef FE_TONEAREST
 342       case GFC_FPE_TONEAREST:
 343         rnd_mode = FE_TONEAREST;
 344         break;
 345 #endif
 346
 347 #ifdef FE_UPWARD
 348       case GFC_FPE_UPWARD:
 349         rnd_mode = FE_UPWARD;
 350         break;
 351 #endif
 352
 353 #ifdef FE_DOWNWARD
 354       case GFC_FPE_DOWNWARD:
 355         rnd_mode = FE_DOWNWARD;
 356         break;
 357 #endif
 358
 359 #ifdef FE_TOWARDZERO
 360       case GFC_FPE_TOWARDZERO:
 361         rnd_mode = FE_TOWARDZERO;
 362         break;
 363 #endif
 364
 365 #ifdef FE_TONEARESTFROMZERO
 366       case GFC_FPE_AWAY:
 367         rnd_mode = FE_TONEARESTFROMZERO;
 368         break;
 369 #endif
 370
 371       default:
 372         return;
 373     }
 374
 375   fesetround (rnd_mode);
 376 }
 377
 378
 379 int
 380 support_fpu_rounding_mode (int mode)
 381 {
 382   switch (mode)
 383     {
 384       case GFC_FPE_TONEAREST:
 385 #ifdef FE_TONEAREST
 386         return 1;
 387 #else
 388         return 0;
 389 #endif
 390
 391       case GFC_FPE_UPWARD:
 392 #ifdef FE_UPWARD
 393         return 1;
 394 #else
 395         return 0;
 396 #endif
 397
 398       case GFC_FPE_DOWNWARD:
 399 #ifdef FE_DOWNWARD
 400         return 1;
 401 #else
 402         return 0;
 403 #endif
 404
 405       case GFC_FPE_TOWARDZERO:
 406 #ifdef FE_TOWARDZERO
 407         return 1;
 408 #else
 409         return 0;
 410 #endif
 411
 412       case GFC_FPE_AWAY:
 413 #ifdef FE_TONEARESTFROMZERO
 414         return 1;
 415 #else
 416         return 0;
 417 #endif
 418
 419       default:
 420         return 0;
 421     }
 422 }
 423
 424
 425
 426 void
 427 get_fpu_state (void *state)
 428 {
 429   fegetenv (state);
 430 }
 431
 432 void
 433 set_fpu_state (void *state)
 434 {
 435   fesetenv (state);
 436 }
 437
 438
 439 int
 440 support_fpu_underflow_control (int kind __attribute__((unused)))
 441 {
 442   return 0;
 443 }
 444
 445
 446 int
 447 get_fpu_underflow_mode (void)
 448 {
 449   return 0;
 450 }
 451
 452
 453 void
 454 set_fpu_underflow_mode (int gradual __attribute__((unused)))
 455 {
 456 }
 457