1/* FPU-related code for aarch64.
2   Copyright (C) 2020-2022 Free Software Foundation, Inc.
3   Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
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/* Rounding mask and modes */
28
29#define FPCR_RM_MASK  0x0c00000
30#define FE_TONEAREST  0x0000000
31#define FE_UPWARD     0x0400000
32#define FE_DOWNWARD   0x0800000
33#define FE_TOWARDZERO 0x0c00000
34#define FE_MAP_FZ     0x1000000
35
36/* Exceptions */
37
38#define FE_INVALID	1
39#define FE_DIVBYZERO	2
40#define FE_OVERFLOW	4
41#define FE_UNDERFLOW	8
42#define FE_INEXACT	16
43
44#define FE_ALL_EXCEPT (FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW | FE_INEXACT)
45#define FE_EXCEPT_SHIFT	8
46
47
48
49/* This structure corresponds to the layout of the block
50   written by FSTENV.  */
51struct fenv
52{
53  unsigned int __fpcr;
54  unsigned int __fpsr;
55};
56
57/* Check we can actually store the FPU state in the allocated size.  */
58_Static_assert (sizeof(struct fenv) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE,
59		"GFC_FPE_STATE_BUFFER_SIZE is too small");
60
61
62
63void
64set_fpu (void)
65{
66  if (options.fpe & GFC_FPE_DENORMAL)
67    estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
68	        "exception not supported.\n");
69
70  set_fpu_trap_exceptions (options.fpe, 0);
71}
72
73
74int
75get_fpu_trap_exceptions (void)
76{
77  unsigned int fpcr, exceptions;
78  int res = 0;
79
80  fpcr = __builtin_aarch64_get_fpcr();
81  exceptions = (fpcr >> FE_EXCEPT_SHIFT) & FE_ALL_EXCEPT;
82
83  if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
84  if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
85  if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
86  if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
87  if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
88
89  return res;
90}
91
92
93void set_fpu_trap_exceptions (int trap, int notrap)
94{
95  unsigned int mode_set = 0, mode_clr = 0;
96  unsigned int fpsr, fpsr_new;
97  unsigned int fpcr, fpcr_new;
98
99  if (trap & GFC_FPE_INVALID)
100    mode_set |= FE_INVALID;
101  if (notrap & GFC_FPE_INVALID)
102    mode_clr |= FE_INVALID;
103
104  if (trap & GFC_FPE_ZERO)
105    mode_set |= FE_DIVBYZERO;
106  if (notrap & GFC_FPE_ZERO)
107    mode_clr |= FE_DIVBYZERO;
108
109  if (trap & GFC_FPE_OVERFLOW)
110    mode_set |= FE_OVERFLOW;
111  if (notrap & GFC_FPE_OVERFLOW)
112    mode_clr |= FE_OVERFLOW;
113
114  if (trap & GFC_FPE_UNDERFLOW)
115    mode_set |= FE_UNDERFLOW;
116  if (notrap & GFC_FPE_UNDERFLOW)
117    mode_clr |= FE_UNDERFLOW;
118
119  if (trap & GFC_FPE_INEXACT)
120    mode_set |= FE_INEXACT;
121  if (notrap & GFC_FPE_INEXACT)
122    mode_clr |= FE_INEXACT;
123
124  /* Clear stalled exception flags.  */
125  fpsr = __builtin_aarch64_get_fpsr();
126  fpsr_new = fpsr & ~FE_ALL_EXCEPT;
127  if (fpsr_new != fpsr)
128    __builtin_aarch64_set_fpsr(fpsr_new);
129
130  fpcr_new = fpcr = __builtin_aarch64_get_fpcr();
131  fpcr_new |= (mode_set << FE_EXCEPT_SHIFT);
132  fpcr_new &= ~(mode_clr << FE_EXCEPT_SHIFT);
133
134  if (fpcr_new != fpcr)
135    __builtin_aarch64_set_fpcr(fpcr_new);
136}
137
138
139int
140support_fpu_flag (int flag)
141{
142  if (flag & GFC_FPE_DENORMAL)
143    return 0;
144
145  return 1;
146}
147
148
149int
150support_fpu_trap (int flag)
151{
152  if (flag & GFC_FPE_DENORMAL)
153    return 0;
154
155  return 1;
156}
157
158
159int
160get_fpu_except_flags (void)
161{
162  int result;
163  unsigned int fpsr;
164
165  result = 0;
166  fpsr = __builtin_aarch64_get_fpsr() & FE_ALL_EXCEPT;
167
168  if (fpsr & FE_INVALID)
169    result |= GFC_FPE_INVALID;
170  if (fpsr & FE_DIVBYZERO)
171    result |= GFC_FPE_ZERO;
172  if (fpsr & FE_OVERFLOW)
173    result |= GFC_FPE_OVERFLOW;
174  if (fpsr & FE_UNDERFLOW)
175    result |= GFC_FPE_UNDERFLOW;
176  if (fpsr & FE_INEXACT)
177    result |= GFC_FPE_INEXACT;
178
179  return result;
180}
181
182
183void
184set_fpu_except_flags (int set, int clear)
185{
186  unsigned int exc_set = 0, exc_clr = 0;
187  unsigned int fpsr, fpsr_new;
188
189  if (set & GFC_FPE_INVALID)
190    exc_set |= FE_INVALID;
191  else if (clear & GFC_FPE_INVALID)
192    exc_clr |= FE_INVALID;
193
194  if (set & GFC_FPE_ZERO)
195    exc_set |= FE_DIVBYZERO;
196  else if (clear & GFC_FPE_ZERO)
197    exc_clr |= FE_DIVBYZERO;
198
199  if (set & GFC_FPE_OVERFLOW)
200    exc_set |= FE_OVERFLOW;
201  else if (clear & GFC_FPE_OVERFLOW)
202    exc_clr |= FE_OVERFLOW;
203
204  if (set & GFC_FPE_UNDERFLOW)
205    exc_set |= FE_UNDERFLOW;
206  else if (clear & GFC_FPE_UNDERFLOW)
207    exc_clr |= FE_UNDERFLOW;
208
209  if (set & GFC_FPE_INEXACT)
210    exc_set |= FE_INEXACT;
211  else if (clear & GFC_FPE_INEXACT)
212    exc_clr |= FE_INEXACT;
213
214  fpsr_new = fpsr = __builtin_aarch64_get_fpsr();
215  fpsr_new &= ~exc_clr;
216  fpsr_new |= exc_set;
217
218  if (fpsr_new != fpsr)
219    __builtin_aarch64_set_fpsr(fpsr_new);
220}
221
222
223void
224get_fpu_state (void *state)
225{
226  struct fenv *envp = state;
227  envp->__fpcr = __builtin_aarch64_get_fpcr();
228  envp->__fpsr = __builtin_aarch64_get_fpsr();
229}
230
231
232void
233set_fpu_state (void *state)
234{
235  struct fenv *envp = state;
236  __builtin_aarch64_set_fpcr(envp->__fpcr);
237  __builtin_aarch64_set_fpsr(envp->__fpsr);
238}
239
240
241int
242get_fpu_rounding_mode (void)
243{
244  unsigned int fpcr = __builtin_aarch64_get_fpcr();
245  fpcr &= FPCR_RM_MASK;
246
247  switch (fpcr)
248    {
249      case FE_TONEAREST:
250        return GFC_FPE_TONEAREST;
251      case FE_UPWARD:
252        return GFC_FPE_UPWARD;
253      case FE_DOWNWARD:
254        return GFC_FPE_DOWNWARD;
255      case FE_TOWARDZERO:
256        return GFC_FPE_TOWARDZERO;
257      default:
258        return 0; /* Should be unreachable.  */
259    }
260}
261
262
263void
264set_fpu_rounding_mode (int round)
265{
266  unsigned int fpcr, round_mode;
267
268  switch (round)
269    {
270    case GFC_FPE_TONEAREST:
271      round_mode = FE_TONEAREST;
272      break;
273    case GFC_FPE_UPWARD:
274      round_mode = FE_UPWARD;
275      break;
276    case GFC_FPE_DOWNWARD:
277      round_mode = FE_DOWNWARD;
278      break;
279    case GFC_FPE_TOWARDZERO:
280      round_mode = FE_TOWARDZERO;
281      break;
282    default:
283      return; /* Should be unreachable.  */
284    }
285
286  fpcr = __builtin_aarch64_get_fpcr();
287
288  /* Only set FPCR if requested mode is different from current.  */
289  round_mode = (fpcr ^ round_mode) & FPCR_RM_MASK;
290  if (round_mode != 0)
291    __builtin_aarch64_set_fpcr(fpcr ^ round_mode);
292}
293
294
295int
296support_fpu_rounding_mode (int mode __attribute__((unused)))
297{
298  return 1;
299}
300
301
302int
303support_fpu_underflow_control (int kind __attribute__((unused)))
304{
305  /* Not supported for binary128.  */
306  return (kind == 4 || kind == 8) ? 1 : 0;
307}
308
309
310int
311get_fpu_underflow_mode (void)
312{
313  unsigned int fpcr = __builtin_aarch64_get_fpcr();
314
315  /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow.  */
316  return (fpcr & FE_MAP_FZ) ? 0 : 1;
317}
318
319
320void
321set_fpu_underflow_mode (int gradual __attribute__((unused)))
322{
323  unsigned int fpcr = __builtin_aarch64_get_fpcr();
324
325  if (gradual)
326    fpcr &= ~FE_MAP_FZ;
327  else
328    fpcr |= FE_MAP_FZ;
329
330  __builtin_aarch64_set_fpcr(fpcr);
331}
332