libgfortran/config/fpu-sysv.h

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