]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/config/fpu-aix.h
Update copyright years.
[thirdparty/gcc.git] / libgfortran / config / fpu-aix.h
CommitLineData
3b14f664 1/* AIX FPU-related code.
a5544970 2 Copyright (C) 2005-2019 Free Software Foundation, Inc.
3b14f664
FXC
3 Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
4
1028b2bd 5This file is part of the GNU Fortran runtime library (libgfortran).
3b14f664
FXC
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
748086b7 10version 3 of the License, or (at your option) any later version.
3b14f664
FXC
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
748086b7
JJ
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/>. */
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 46void
8b198102 47set_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
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)
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
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}
82a4f54c
TB
202
203
8b198102
FXC
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
82a4f54c
TB
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
56710419 322
82a4f54c 323 default:
56710419 324 return 0; /* Should be unreachable. */
82a4f54c
TB
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
56710419 359
82a4f54c 360 default:
56710419 361 return; /* Should be unreachable. */
82a4f54c
TB
362 }
363
364 fesetround (rnd_mode);
365}
8b198102
FXC
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
5b0936da 380 case GFC_FPE_UPWARD:
8b198102
FXC
381#ifdef FE_UPWARD
382 return 1;
383#else
384 return 0;
385#endif
386
5b0936da 387 case GFC_FPE_DOWNWARD:
8b198102
FXC
388#ifdef FE_DOWNWARD
389 return 1;
390#else
391 return 0;
392#endif
393
5b0936da 394 case GFC_FPE_TOWARDZERO:
8b198102
FXC
395#ifdef FE_TOWARDZERO
396 return 1;
397#else
398 return 0;
399#endif
400
401 default:
56710419 402 return 0; /* Should be unreachable. */
8b198102
FXC
403 }
404}
405
406
407
408void
409get_fpu_state (void *state)
410{
8b198102
FXC
411 fegetenv (state);
412}
413
414void
415set_fpu_state (void *state)
416{
8b198102
FXC
417 fesetenv (state);
418}
419
f5168e47
FXC
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