libgfortran/config/fpu-sysv.h

   1 /* SysV FPU-related code (for systems not otherwise supported).
   2    Copyright (C) 2005-2013 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 void
  29 set_fpu (void)
  30 {
  31   int cw = 0;
  32
  33   if (options.fpe & GFC_FPE_INVALID)
  34 #ifdef FP_X_INV
  35     cw |= FP_X_INV;
  36 #else
  37     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
  38                 "exception not supported.\n");
  39 #endif
  40
  41   if (options.fpe & GFC_FPE_DENORMAL)
  42 #ifdef FP_X_DNML
  43     cw |= FP_X_DNML;
  44 #else
  45     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
  46                 "exception not supported.\n");
  47 #endif
  48
  49   if (options.fpe & GFC_FPE_ZERO)
  50 #ifdef FP_X_DZ
  51     cw |= FP_X_DZ;
  52 #else
  53     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
  54                 "exception not supported.\n");
  55 #endif
  56
  57   if (options.fpe & GFC_FPE_OVERFLOW)
  58 #ifdef FP_X_OFL
  59     cw |= FP_X_OFL;
  60 #else
  61     estr_write ("Fortran runtime warning: IEEE 'overflow' "
  62                 "exception not supported.\n");
  63 #endif
  64
  65   if (options.fpe & GFC_FPE_UNDERFLOW)
  66 #ifdef FP_X_UFL
  67     cw |= FP_X_UFL;
  68 #else
  69     estr_write ("Fortran runtime warning: IEEE 'underflow' "
  70                 "exception not supported.\n");
  71 #endif
  72
  73   if (options.fpe & GFC_FPE_INEXACT)
  74 #ifdef FP_X_IMP
  75     cw |= FP_X_IMP;
  76 #else
  77     estr_write ("Fortran runtime warning: IEEE 'inexact' "
  78                 "exception not supported.\n");
  79 #endif
  80
  81   fpsetmask(cw);
  82 }
  83
  84 int
  85 get_fpu_except_flags (void)
  86 {
  87   int result;
  88 #if HAVE_FP_EXCEPT
  89   fp_except set_excepts;
  90 #elif HAVE_FP_EXCEPT_T
  91   fp_except_t set_excepts;
  92 #else
  93   choke me
  94 #endif
  95
  96   result = 0;
  97   set_excepts = fpgetsticky ();
  98
  99 #ifdef FP_X_INV
 100   if (set_excepts & FP_X_INV)
 101     result |= GFC_FPE_INVALID;
 102 #endif
 103
 104 #ifdef FP_X_DZ
 105   if (set_excepts & FP_X_DZ)
 106     result |= GFC_FPE_ZERO;
 107 #endif
 108
 109 #ifdef FP_X_OFL
 110   if (set_excepts & FP_X_OFL)
 111     result |= GFC_FPE_OVERFLOW;
 112 #endif
 113
 114 #ifdef FP_X_UFL
 115   if (set_excepts & FP_X_UFL)
 116     result |= GFC_FPE_UNDERFLOW;
 117 #endif
 118
 119 #ifdef FP_X_DNML
 120   if (set_excepts & FP_X_DNML)
 121     result |= GFC_FPE_DENORMAL;
 122 #endif
 123
 124 #ifdef FP_X_IMP
 125   if (set_excepts & FP_X_IMP)
 126     result |= GFC_FPE_INEXACT;
 127 #endif
 128
 129   return result;
 130 }
 131
 132
 133 int
 134 get_fpu_rounding_mode (void)
 135 {
 136   switch (fpgetround ())
 137     {
 138 #ifdef FP_RN
 139       case FP_RN:
 140         return GFC_FPE_TONEAREST;
 141 #endif
 142
 143 #ifdef FP_RP
 144       case FP_RP:
 145         return GFC_FPE_UPWARD;
 146 #endif
 147
 148 #ifdef FP_RM
 149       case FP_RM:
 150         return GFC_FPE_DOWNWARD;
 151 #endif
 152
 153 #ifdef FP_RZ
 154       case FP_RZ:
 155         return GFC_FPE_TOWARDZERO;
 156 #endif
 157       default:
 158         return GFC_FPE_INVALID;
 159     }
 160 }
 161
 162
 163 void
 164 set_fpu_rounding_mode (int mode)
 165 {
 166 #if HAVE_FP_RND
 167   fp_rnd rnd_mode;
 168 #elif HAVE_FP_RND_T
 169   fp_rnd_t rnd_mode;
 170 #else
 171   choke me
 172 #endif
 173
 174   switch (mode)
 175     {
 176 #ifdef FP_RN
 177       case GFC_FPE_TONEAREST:
 178         rnd_mode = FP_RN;
 179         break;
 180 #endif
 181
 182 #ifdef FP_RP
 183       case GFC_FPE_UPWARD:
 184         rnd_mode = FP_RP;
 185         break;
 186 #endif
 187
 188 #ifdef FP_RM
 189       case GFC_FPE_DOWNWARD:
 190         rnd_mode = FP_RM;
 191         break;
 192 #endif
 193
 194 #ifdef FP_RZ
 195       case GFC_FPE_TOWARDZERO:
 196         rnd_mode = FP_RZ;
 197         break;
 198 #endif
 199       default:
 200         return;
 201     }
 202   fpsetround (rnd_mode);
 203 }