1 /* SysV FPU-related code (for systems not otherwise supported). 2 Copyright (C) 2005-2019 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 436