1 /* AIX FPU-related code.
2 Copyright (C) 2005-2023 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
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
46 void
47 set_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
92 int
93 get_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
126 int
127 support_fpu_trap (int flag)
128 {
129 return support_fpu_flag (flag);
130 }
131
132
133 void
134 set_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
173 int
174 get_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
204 void
205 set_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
251 int
252 support_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
294 int
295 get_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 #ifdef FE_TONEARESTFROMZERO
324 case FE_TONEARESTFROMZERO:
325 return GFC_FPE_AWAY;
326 #endif
327
328 default:
329 return 0; /* Should be unreachable. */
330 }
331 }
332
333
334 void
335 set_fpu_rounding_mode (int mode)
336 {
337 int rnd_mode;
338
339 switch (mode)
340 {
341 #ifdef FE_TONEAREST
342 case GFC_FPE_TONEAREST:
343 rnd_mode = FE_TONEAREST;
344 break;
345 #endif
346
347 #ifdef FE_UPWARD
348 case GFC_FPE_UPWARD:
349 rnd_mode = FE_UPWARD;
350 break;
351 #endif
352
353 #ifdef FE_DOWNWARD
354 case GFC_FPE_DOWNWARD:
355 rnd_mode = FE_DOWNWARD;
356 break;
357 #endif
358
359 #ifdef FE_TOWARDZERO
360 case GFC_FPE_TOWARDZERO:
361 rnd_mode = FE_TOWARDZERO;
362 break;
363 #endif
364
365 #ifdef FE_TONEARESTFROMZERO
366 case GFC_FPE_AWAY:
367 rnd_mode = FE_TONEARESTFROMZERO;
368 break;
369 #endif
370
371 default:
372 return;
373 }
374
375 fesetround (rnd_mode);
376 }
377
378
379 int
380 support_fpu_rounding_mode (int mode)
381 {
382 switch (mode)
383 {
384 case GFC_FPE_TONEAREST:
385 #ifdef FE_TONEAREST
386 return 1;
387 #else
388 return 0;
389 #endif
390
391 case GFC_FPE_UPWARD:
392 #ifdef FE_UPWARD
393 return 1;
394 #else
395 return 0;
396 #endif
397
398 case GFC_FPE_DOWNWARD:
399 #ifdef FE_DOWNWARD
400 return 1;
401 #else
402 return 0;
403 #endif
404
405 case GFC_FPE_TOWARDZERO:
406 #ifdef FE_TOWARDZERO
407 return 1;
408 #else
409 return 0;
410 #endif
411
412 case GFC_FPE_AWAY:
413 #ifdef FE_TONEARESTFROMZERO
414 return 1;
415 #else
416 return 0;
417 #endif
418
419 default:
420 return 0;
421 }
422 }
423
424
425
426 void
427 get_fpu_state (void *state)
428 {
429 fegetenv (state);
430 }
431
432 void
433 set_fpu_state (void *state)
434 {
435 fesetenv (state);
436 }
437
438
439 int
440 support_fpu_underflow_control (int kind __attribute__((unused)))
441 {
442 return 0;
443 }
444
445
446 int
447 get_fpu_underflow_mode (void)
448 {
449 return 0;
450 }
451
452
453 void
454 set_fpu_underflow_mode (int gradual __attribute__((unused)))
455 {
456 }
457