libgfortran/config/fpu-aix.h

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