1/* SysV FPU-related code (for systems not otherwise supported). 2 Copyright (C) 2005-2020 Free Software Foundation, Inc. 3 Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> 4 5This file is part of the GNU Fortran runtime library (libgfortran). 6 7Libgfortran is free software; you can redistribute it and/or 8modify it under the terms of the GNU General Public 9License as published by the Free Software Foundation; either 10version 3 of the License, or (at your option) any later version. 11 12Libgfortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17Under Section 7 of GPL version 3, you are granted additional 18permissions described in the GCC Runtime Library Exception, version 193.1, as published by the Free Software Foundation. 20 21You should have received a copy of the GNU General Public License and 22a copy of the GCC Runtime Library Exception along with this program; 23see 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 56void 57set_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 107int 108get_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 141int 142support_fpu_trap (int flag) 143{ 144 return support_fpu_flag (flag); 145} 146 147 148void 149set_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 191int 192get_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 234void 235set_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 287int 288support_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 331int 332get_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 350void 351set_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 376int 377support_fpu_rounding_mode (int mode __attribute__((unused))) 378{ 379 return 1; 380} 381 382 383typedef 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 396void 397get_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 406void 407set_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 417int 418support_fpu_underflow_control (int kind __attribute__((unused))) 419{ 420 return 0; 421} 422 423 424int 425get_fpu_underflow_mode (void) 426{ 427 return 0; 428} 429 430 431void 432set_fpu_underflow_mode (int gradual __attribute__((unused))) 433{ 434} 435 436