1/* AIX FPU-related code.
2   Copyright (C) 2005-2022 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