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