libgfortran/config/fpu-sysv.h

   1 /* SysV FPU-related code (for systems not otherwise supported).
   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 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 #ifdef FP_RN
 337       case FP_RN:
 338         return GFC_FPE_TONEAREST;
 339 #endif
 340
 341 #ifdef FP_RP
 342       case FP_RP:
 343         return GFC_FPE_UPWARD;
 344 #endif
 345
 346 #ifdef FP_RM
 347       case FP_RM:
 348         return GFC_FPE_DOWNWARD;
 349 #endif
 350
 351 #ifdef FP_RZ
 352       case FP_RZ:
 353         return GFC_FPE_TOWARDZERO;
 354 #endif
 355       default:
 356         return GFC_FPE_INVALID;
 357     }
 358 }
 359
 360
 361 void
 362 set_fpu_rounding_mode (int mode)
 363 {
 364   FP_RND_TYPE rnd_mode;
 365
 366   switch (mode)
 367     {
 368 #ifdef FP_RN
 369       case GFC_FPE_TONEAREST:
 370         rnd_mode = FP_RN;
 371         break;
 372 #endif
 373
 374 #ifdef FP_RP
 375       case GFC_FPE_UPWARD:
 376         rnd_mode = FP_RP;
 377         break;
 378 #endif
 379
 380 #ifdef FP_RM
 381       case GFC_FPE_DOWNWARD:
 382         rnd_mode = FP_RM;
 383         break;
 384 #endif
 385
 386 #ifdef FP_RZ
 387       case GFC_FPE_TOWARDZERO:
 388         rnd_mode = FP_RZ;
 389         break;
 390 #endif
 391       default:
 392         return;
 393     }
 394   fpsetround (rnd_mode);
 395 }
 396
 397
 398 int
 399 support_fpu_rounding_mode (int mode)
 400 {
 401   switch (mode)
 402     {
 403       case GFC_FPE_TONEAREST:
 404 #ifdef FP_RN
 405         return 1;
 406 #else
 407         return 0;
 408 #endif
 409
 410       case GFC_FPE_UPWARD:
 411 #ifdef FP_RP
 412         return 1;
 413 #else
 414         return 0;
 415 #endif
 416
 417       case GFC_FPE_DOWNWARD:
 418 #ifdef FP_RM
 419         return 1;
 420 #else
 421         return 0;
 422 #endif
 423
 424       case GFC_FPE_TOWARDZERO:
 425 #ifdef FP_RZ
 426         return 1;
 427 #else
 428         return 0;
 429 #endif
 430
 431       default:
 432         return 0;
 433     }
 434 }
 435
 436
 437 typedef struct
 438 {
 439   FP_EXCEPT_TYPE mask;
 440   FP_EXCEPT_TYPE sticky;
 441   FP_RND_TYPE round;
 442 } fpu_state_t;
 443
 444
 445 void
 446 get_fpu_state (void *s)
 447 {
 448   fpu_state_t *state = s;
 449
 450   /* Check we can actually store the FPU state in the allocated size.  */
 451   assert (sizeof(fpu_state_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 452
 453   state->mask = fpgetmask ();
 454   state->sticky = fpgetsticky ();
 455   state->round = fpgetround ();
 456 }
 457
 458 void
 459 set_fpu_state (void *s)
 460 {
 461   fpu_state_t *state = s;
 462
 463   /* Check we can actually store the FPU state in the allocated size.  */
 464   assert (sizeof(fpu_state_t) <= GFC_FPE_STATE_BUFFER_SIZE);
 465
 466   fpsetmask (state->mask);
 467   FPSETSTICKY (state->sticky);
 468   fpsetround (state->round);
 469 }
 470