1 /* AIX FPU-related code.
2 Copyright (C) 2005-2016 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
set_fpu_trap_exceptions(int trap,int notrap)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
get_fpu_trap_exceptions(void)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
support_fpu_trap(int flag)127 support_fpu_trap (int flag)
128 {
129 return support_fpu_flag (flag);
130 }
131
132
133 void
set_fpu(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
get_fpu_except_flags(void)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
set_fpu_except_flags(int set,int clear)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
support_fpu_flag(int flag)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
get_fpu_rounding_mode(void)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 default:
324 return 0; /* Should be unreachable. */
325 }
326 }
327
328
329 void
set_fpu_rounding_mode(int mode)330 set_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
368 int
support_fpu_rounding_mode(int mode)369 support_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
408 void
get_fpu_state(void * state)409 get_fpu_state (void *state)
410 {
411 fegetenv (state);
412 }
413
414 void
set_fpu_state(void * state)415 set_fpu_state (void *state)
416 {
417 fesetenv (state);
418 }
419
420
421 int
support_fpu_underflow_control(int kind)422 support_fpu_underflow_control (int kind __attribute__((unused)))
423 {
424 return 0;
425 }
426
427
428 int
get_fpu_underflow_mode(void)429 get_fpu_underflow_mode (void)
430 {
431 return 0;
432 }
433
434
435 void
set_fpu_underflow_mode(int gradual)436 set_fpu_underflow_mode (int gradual __attribute__((unused)))
437 {
438 }
439
440