]>
Commit | Line | Data |
---|---|---|
3b14f664 | 1 | /* AIX FPU-related code. |
7adcbafe | 2 | Copyright (C) 2005-2022 Free Software Foundation, Inc. |
3b14f664 FXC |
3 | Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> |
4 | ||
1028b2bd | 5 | This file is part of the GNU Fortran runtime library (libgfortran). |
3b14f664 FXC |
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 | |
748086b7 | 10 | version 3 of the License, or (at your option) any later version. |
3b14f664 FXC |
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 | ||
748086b7 JJ |
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/>. */ | |
3b14f664 FXC |
25 | |
26 | ||
27 | /* FPU-related code for AIX. */ | |
28 | #ifdef HAVE_FPTRAP_H | |
29 | #include <fptrap.h> | |
30 | #endif | |
31 | ||
fa86f4f9 TB |
32 | #ifdef HAVE_FPXCP_H |
33 | #include <fpxcp.h> | |
34 | #endif | |
35 | ||
8b198102 FXC |
36 | #ifdef HAVE_FENV_H |
37 | #include <fenv.h> | |
38 | #endif | |
39 | ||
40 | ||
a709346f FXC |
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 | ||
3b14f664 | 46 | void |
8b198102 | 47 | set_fpu_trap_exceptions (int trap, int notrap) |
3b14f664 | 48 | { |
8b198102 | 49 | fptrap_t mode_set = 0, mode_clr = 0; |
3b14f664 | 50 | |
3b14f664 | 51 | #ifdef TRP_INVALID |
8b198102 FXC |
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) | |
1028b2bd JB |
138 | estr_write ("Fortran runtime warning: IEEE 'invalid operation' " |
139 | "exception not supported.\n"); | |
3b14f664 FXC |
140 | #endif |
141 | ||
142 | if (options.fpe & GFC_FPE_DENORMAL) | |
57b4d355 | 143 | estr_write ("Fortran runtime warning: Floating point 'denormal operand' " |
1028b2bd | 144 | "exception not supported.\n"); |
3b14f664 | 145 | |
8b198102 | 146 | #ifndef TRP_DIV_BY_ZERO |
3b14f664 | 147 | if (options.fpe & GFC_FPE_ZERO) |
1028b2bd JB |
148 | estr_write ("Fortran runtime warning: IEEE 'division by zero' " |
149 | "exception not supported.\n"); | |
3b14f664 FXC |
150 | #endif |
151 | ||
8b198102 | 152 | #ifndef TRP_OVERFLOW |
3b14f664 | 153 | if (options.fpe & GFC_FPE_OVERFLOW) |
1028b2bd JB |
154 | estr_write ("Fortran runtime warning: IEEE 'overflow' " |
155 | "exception not supported.\n"); | |
3b14f664 FXC |
156 | #endif |
157 | ||
8b198102 | 158 | #ifndef TRP_UNDERFLOW |
3b14f664 | 159 | if (options.fpe & GFC_FPE_UNDERFLOW) |
1028b2bd JB |
160 | estr_write ("Fortran runtime warning: IEEE 'underflow' " |
161 | "exception not supported.\n"); | |
3b14f664 FXC |
162 | #endif |
163 | ||
8b198102 | 164 | #ifndef TRP_INEXACT |
57b4d355 | 165 | if (options.fpe & GFC_FPE_INEXACT) |
57b4d355 | 166 | estr_write ("Fortran runtime warning: IEEE 'inexact' " |
1028b2bd | 167 | "exception not supported.\n"); |
3b14f664 FXC |
168 | #endif |
169 | ||
8b198102 | 170 | set_fpu_trap_exceptions (options.fpe, 0); |
3b14f664 | 171 | } |
fa86f4f9 | 172 | |
fa86f4f9 TB |
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 | } | |
82a4f54c TB |
202 | |
203 | ||
8b198102 FXC |
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 | ||
82a4f54c TB |
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 | |
56710419 | 322 | |
4637a1d2 FXC |
323 | #ifdef FE_TONEARESTFROMZERO |
324 | case FE_TONEARESTFROMZERO: | |
325 | return GFC_FPE_AWAY; | |
326 | #endif | |
327 | ||
82a4f54c | 328 | default: |
56710419 | 329 | return 0; /* Should be unreachable. */ |
82a4f54c TB |
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 | |
56710419 | 364 | |
4637a1d2 FXC |
365 | #ifdef FE_TONEARESTFROMZERO |
366 | case GFC_FPE_AWAY: | |
367 | rnd_mode = FE_TONEARESTFROMZERO; | |
368 | break; | |
369 | #endif | |
370 | ||
82a4f54c | 371 | default: |
4637a1d2 | 372 | return; |
82a4f54c TB |
373 | } |
374 | ||
375 | fesetround (rnd_mode); | |
376 | } | |
8b198102 FXC |
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 | ||
5b0936da | 391 | case GFC_FPE_UPWARD: |
8b198102 FXC |
392 | #ifdef FE_UPWARD |
393 | return 1; | |
394 | #else | |
395 | return 0; | |
396 | #endif | |
397 | ||
5b0936da | 398 | case GFC_FPE_DOWNWARD: |
8b198102 FXC |
399 | #ifdef FE_DOWNWARD |
400 | return 1; | |
401 | #else | |
402 | return 0; | |
403 | #endif | |
404 | ||
5b0936da | 405 | case GFC_FPE_TOWARDZERO: |
8b198102 FXC |
406 | #ifdef FE_TOWARDZERO |
407 | return 1; | |
408 | #else | |
409 | return 0; | |
410 | #endif | |
411 | ||
4637a1d2 FXC |
412 | case GFC_FPE_AWAY: |
413 | #ifdef FE_TONEARESTFROMZERO | |
414 | return 1; | |
415 | #else | |
416 | return 0; | |
417 | #endif | |
418 | ||
8b198102 | 419 | default: |
4637a1d2 | 420 | return 0; |
8b198102 FXC |
421 | } |
422 | } | |
423 | ||
424 | ||
425 | ||
426 | void | |
427 | get_fpu_state (void *state) | |
428 | { | |
8b198102 FXC |
429 | fegetenv (state); |
430 | } | |
431 | ||
432 | void | |
433 | set_fpu_state (void *state) | |
434 | { | |
8b198102 FXC |
435 | fesetenv (state); |
436 | } | |
437 | ||
f5168e47 FXC |
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 |