]>
Commit | Line | Data |
---|---|---|
d566c3e0 | 1 | /* Helper functions in C for IEEE modules |
f1717362 | 2 | Copyright (C) 2013-2016 Free Software Foundation, Inc. |
d566c3e0 | 3 | Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> |
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 | #include "libgfortran.h" | |
27 | ||
28 | /* Prototypes. */ | |
29 | ||
30 | extern int ieee_class_helper_4 (GFC_REAL_4 *); | |
31 | internal_proto(ieee_class_helper_4); | |
32 | ||
33 | extern int ieee_class_helper_8 (GFC_REAL_8 *); | |
34 | internal_proto(ieee_class_helper_8); | |
35 | ||
c53bd1d9 | 36 | #ifdef HAVE_GFC_REAL_10 |
37 | extern int ieee_class_helper_10 (GFC_REAL_10 *); | |
38 | internal_proto(ieee_class_helper_10); | |
39 | #endif | |
40 | ||
41 | #ifdef HAVE_GFC_REAL_16 | |
42 | extern int ieee_class_helper_16 (GFC_REAL_16 *); | |
43 | internal_proto(ieee_class_helper_16); | |
44 | #endif | |
45 | ||
d566c3e0 | 46 | /* Enumeration of the possible floating-point types. These values |
47 | correspond to the hidden arguments of the IEEE_CLASS_TYPE | |
48 | derived-type of IEEE_ARITHMETIC. */ | |
49 | ||
50 | enum { IEEE_OTHER_VALUE = 0, IEEE_SIGNALING_NAN, IEEE_QUIET_NAN, | |
51 | IEEE_NEGATIVE_INF, IEEE_NEGATIVE_NORMAL, IEEE_NEGATIVE_DENORMAL, | |
52 | IEEE_NEGATIVE_ZERO, IEEE_POSITIVE_ZERO, IEEE_POSITIVE_DENORMAL, | |
53 | IEEE_POSITIVE_NORMAL, IEEE_POSITIVE_INF }; | |
54 | ||
55 | #define CLASSMACRO(TYPE) \ | |
56 | int ieee_class_helper_ ## TYPE (GFC_REAL_ ## TYPE *value) \ | |
57 | { \ | |
58 | int res = __builtin_fpclassify (IEEE_QUIET_NAN, IEEE_POSITIVE_INF, \ | |
59 | IEEE_POSITIVE_NORMAL, \ | |
60 | IEEE_POSITIVE_DENORMAL, \ | |
61 | IEEE_POSITIVE_ZERO, *value); \ | |
62 | \ | |
63 | if (__builtin_signbit (*value)) \ | |
64 | { \ | |
65 | if (res == IEEE_POSITIVE_NORMAL) \ | |
66 | return IEEE_NEGATIVE_NORMAL; \ | |
67 | else if (res == IEEE_POSITIVE_DENORMAL) \ | |
68 | return IEEE_NEGATIVE_DENORMAL; \ | |
69 | else if (res == IEEE_POSITIVE_ZERO) \ | |
70 | return IEEE_NEGATIVE_ZERO; \ | |
71 | else if (res == IEEE_POSITIVE_INF) \ | |
72 | return IEEE_NEGATIVE_INF; \ | |
73 | } \ | |
74 | \ | |
75 | if (res == IEEE_QUIET_NAN) \ | |
76 | { \ | |
77 | /* TODO: Handle signaling NaNs */ \ | |
78 | return res; \ | |
79 | } \ | |
80 | \ | |
81 | return res; \ | |
82 | } | |
83 | ||
84 | CLASSMACRO(4) | |
85 | CLASSMACRO(8) | |
86 | ||
c53bd1d9 | 87 | #ifdef HAVE_GFC_REAL_10 |
88 | CLASSMACRO(10) | |
89 | #endif | |
90 | ||
91 | #ifdef HAVE_GFC_REAL_16 | |
92 | CLASSMACRO(16) | |
93 | #endif | |
94 | ||
d566c3e0 | 95 | |
d566c3e0 | 96 | #define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \ |
97 | GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \ | |
98 | GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT) | |
99 | ||
100 | /* Functions to save and restore floating-point state, clear and restore | |
101 | exceptions on procedure entry/exit. The rules we follow are set | |
102 | in Fortran 2008's 14.3 paragraph 3, note 14.4, 14.4 paragraph 4, | |
103 | 14.5 paragraph 2, and 14.6 paragraph 1. */ | |
104 | ||
105 | void ieee_procedure_entry (void *); | |
106 | export_proto(ieee_procedure_entry); | |
107 | ||
108 | void | |
109 | ieee_procedure_entry (void *state) | |
110 | { | |
111 | /* Save the floating-point state in the space provided by the caller. */ | |
112 | get_fpu_state (state); | |
113 | ||
114 | /* Clear the floating-point exceptions. */ | |
115 | set_fpu_except_flags (0, GFC_FPE_ALL); | |
116 | } | |
117 | ||
118 | ||
119 | void ieee_procedure_exit (void *); | |
120 | export_proto(ieee_procedure_exit); | |
121 | ||
122 | void | |
123 | ieee_procedure_exit (void *state) | |
124 | { | |
125 | /* Get the flags currently signaling. */ | |
126 | int flags = get_fpu_except_flags (); | |
127 | ||
128 | /* Restore the floating-point state we had on entry. */ | |
129 | set_fpu_state (state); | |
130 | ||
131 | /* And re-raised the flags that were raised since entry. */ | |
132 | set_fpu_except_flags (flags, 0); | |
133 | } | |
134 |