]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/ieee/ieee_arithmetic.F90
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update copyright years.
[thirdparty/gcc.git] / libgfortran / ieee / ieee_arithmetic.F90
CommitLineData
d566c3e0 1! Implementation of the IEEE_ARITHMETIC standard intrinsic module
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 "config.h"
27#include "kinds.inc"
28#include "c99_protos.inc"
29#include "fpu-target.inc"
30
31module IEEE_ARITHMETIC
32
33 use IEEE_EXCEPTIONS
34 implicit none
35 private
36
37 ! Every public symbol from IEEE_EXCEPTIONS must be made public here
38 public :: IEEE_FLAG_TYPE, IEEE_INVALID, IEEE_OVERFLOW, &
39 IEEE_DIVIDE_BY_ZERO, IEEE_UNDERFLOW, IEEE_INEXACT, IEEE_USUAL, &
40 IEEE_ALL, IEEE_STATUS_TYPE, IEEE_GET_FLAG, IEEE_GET_HALTING_MODE, &
41 IEEE_GET_STATUS, IEEE_SET_FLAG, IEEE_SET_HALTING_MODE, &
42 IEEE_SET_STATUS, IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
43
44 ! Derived types and named constants
45
46 type, public :: IEEE_CLASS_TYPE
47 private
48 integer :: hidden
49 end type
50
51 type(IEEE_CLASS_TYPE), parameter, public :: &
52 IEEE_OTHER_VALUE = IEEE_CLASS_TYPE(0), &
53 IEEE_SIGNALING_NAN = IEEE_CLASS_TYPE(1), &
54 IEEE_QUIET_NAN = IEEE_CLASS_TYPE(2), &
55 IEEE_NEGATIVE_INF = IEEE_CLASS_TYPE(3), &
56 IEEE_NEGATIVE_NORMAL = IEEE_CLASS_TYPE(4), &
57 IEEE_NEGATIVE_DENORMAL = IEEE_CLASS_TYPE(5), &
58 IEEE_NEGATIVE_ZERO = IEEE_CLASS_TYPE(6), &
59 IEEE_POSITIVE_ZERO = IEEE_CLASS_TYPE(7), &
60 IEEE_POSITIVE_DENORMAL = IEEE_CLASS_TYPE(8), &
61 IEEE_POSITIVE_NORMAL = IEEE_CLASS_TYPE(9), &
62 IEEE_POSITIVE_INF = IEEE_CLASS_TYPE(10)
63
64 type, public :: IEEE_ROUND_TYPE
65 private
66 integer :: hidden
67 end type
68
69 type(IEEE_ROUND_TYPE), parameter, public :: &
70 IEEE_NEAREST = IEEE_ROUND_TYPE(GFC_FPE_TONEAREST), &
71 IEEE_TO_ZERO = IEEE_ROUND_TYPE(GFC_FPE_TOWARDZERO), &
72 IEEE_UP = IEEE_ROUND_TYPE(GFC_FPE_UPWARD), &
73 IEEE_DOWN = IEEE_ROUND_TYPE(GFC_FPE_DOWNWARD), &
74 IEEE_OTHER = IEEE_ROUND_TYPE(0)
75
76
77 ! Equality operators on the derived types
78 interface operator (==)
79 module procedure IEEE_CLASS_TYPE_EQ, IEEE_ROUND_TYPE_EQ
80 end interface
81 public :: operator(==)
82
83 interface operator (/=)
84 module procedure IEEE_CLASS_TYPE_NE, IEEE_ROUND_TYPE_NE
85 end interface
86 public :: operator (/=)
87
88
89 ! IEEE_IS_FINITE
90
91 interface
92 elemental logical function _gfortran_ieee_is_finite_4(X)
93 real(kind=4), intent(in) :: X
94 end function
95 elemental logical function _gfortran_ieee_is_finite_8(X)
96 real(kind=8), intent(in) :: X
97 end function
c53bd1d9 98#ifdef HAVE_GFC_REAL_10
99 elemental logical function _gfortran_ieee_is_finite_10(X)
100 real(kind=10), intent(in) :: X
101 end function
102#endif
103#ifdef HAVE_GFC_REAL_16
104 elemental logical function _gfortran_ieee_is_finite_16(X)
105 real(kind=16), intent(in) :: X
106 end function
107#endif
d566c3e0 108 end interface
109
110 interface IEEE_IS_FINITE
c53bd1d9 111 procedure &
112#ifdef HAVE_GFC_REAL_16
113 _gfortran_ieee_is_finite_16, &
114#endif
115#ifdef HAVE_GFC_REAL_10
116 _gfortran_ieee_is_finite_10, &
117#endif
118 _gfortran_ieee_is_finite_8, _gfortran_ieee_is_finite_4
d566c3e0 119 end interface
120 public :: IEEE_IS_FINITE
121
122 ! IEEE_IS_NAN
123
124 interface
125 elemental logical function _gfortran_ieee_is_nan_4(X)
126 real(kind=4), intent(in) :: X
127 end function
128 elemental logical function _gfortran_ieee_is_nan_8(X)
129 real(kind=8), intent(in) :: X
130 end function
c53bd1d9 131#ifdef HAVE_GFC_REAL_10
132 elemental logical function _gfortran_ieee_is_nan_10(X)
133 real(kind=10), intent(in) :: X
134 end function
135#endif
136#ifdef HAVE_GFC_REAL_16
137 elemental logical function _gfortran_ieee_is_nan_16(X)
138 real(kind=16), intent(in) :: X
139 end function
140#endif
d566c3e0 141 end interface
142
143 interface IEEE_IS_NAN
c53bd1d9 144 procedure &
145#ifdef HAVE_GFC_REAL_16
146 _gfortran_ieee_is_nan_16, &
147#endif
148#ifdef HAVE_GFC_REAL_10
149 _gfortran_ieee_is_nan_10, &
150#endif
151 _gfortran_ieee_is_nan_8, _gfortran_ieee_is_nan_4
d566c3e0 152 end interface
153 public :: IEEE_IS_NAN
154
155 ! IEEE_IS_NEGATIVE
156
157 interface
158 elemental logical function _gfortran_ieee_is_negative_4(X)
159 real(kind=4), intent(in) :: X
160 end function
161 elemental logical function _gfortran_ieee_is_negative_8(X)
162 real(kind=8), intent(in) :: X
163 end function
c53bd1d9 164#ifdef HAVE_GFC_REAL_10
165 elemental logical function _gfortran_ieee_is_negative_10(X)
166 real(kind=10), intent(in) :: X
167 end function
168#endif
169#ifdef HAVE_GFC_REAL_16
170 elemental logical function _gfortran_ieee_is_negative_16(X)
171 real(kind=16), intent(in) :: X
172 end function
173#endif
d566c3e0 174 end interface
175
176 interface IEEE_IS_NEGATIVE
c53bd1d9 177 procedure &
178#ifdef HAVE_GFC_REAL_16
179 _gfortran_ieee_is_negative_16, &
180#endif
181#ifdef HAVE_GFC_REAL_10
182 _gfortran_ieee_is_negative_10, &
183#endif
184 _gfortran_ieee_is_negative_8, _gfortran_ieee_is_negative_4
d566c3e0 185 end interface
186 public :: IEEE_IS_NEGATIVE
187
188 ! IEEE_IS_NORMAL
189
190 interface
191 elemental logical function _gfortran_ieee_is_normal_4(X)
192 real(kind=4), intent(in) :: X
193 end function
194 elemental logical function _gfortran_ieee_is_normal_8(X)
195 real(kind=8), intent(in) :: X
196 end function
c53bd1d9 197#ifdef HAVE_GFC_REAL_10
198 elemental logical function _gfortran_ieee_is_normal_10(X)
199 real(kind=10), intent(in) :: X
200 end function
201#endif
202#ifdef HAVE_GFC_REAL_16
203 elemental logical function _gfortran_ieee_is_normal_16(X)
204 real(kind=16), intent(in) :: X
205 end function
206#endif
d566c3e0 207 end interface
208
209 interface IEEE_IS_NORMAL
c53bd1d9 210 procedure &
211#ifdef HAVE_GFC_REAL_16
212 _gfortran_ieee_is_normal_16, &
213#endif
214#ifdef HAVE_GFC_REAL_10
215 _gfortran_ieee_is_normal_10, &
216#endif
217 _gfortran_ieee_is_normal_8, _gfortran_ieee_is_normal_4
d566c3e0 218 end interface
219 public :: IEEE_IS_NORMAL
220
221 ! IEEE_COPY_SIGN
222
c53bd1d9 223#define COPYSIGN_MACRO(A,B) \
224 elemental real(kind = A) function \
225 _gfortran_ieee_copy_sign_/**/A/**/_/**/B (X,Y) ; \
226 real(kind = A), intent(in) :: X ; \
227 real(kind = B), intent(in) :: Y ; \
228 end function
229
d566c3e0 230 interface
c53bd1d9 231COPYSIGN_MACRO(4,4)
232COPYSIGN_MACRO(4,8)
233#ifdef HAVE_GFC_REAL_10
234COPYSIGN_MACRO(4,10)
235#endif
236#ifdef HAVE_GFC_REAL_16
237COPYSIGN_MACRO(4,16)
238#endif
239COPYSIGN_MACRO(8,4)
240COPYSIGN_MACRO(8,8)
241#ifdef HAVE_GFC_REAL_10
242COPYSIGN_MACRO(8,10)
243#endif
244#ifdef HAVE_GFC_REAL_16
245COPYSIGN_MACRO(8,16)
246#endif
247#ifdef HAVE_GFC_REAL_10
248COPYSIGN_MACRO(10,4)
249COPYSIGN_MACRO(10,8)
250COPYSIGN_MACRO(10,10)
251#ifdef HAVE_GFC_REAL_16
252COPYSIGN_MACRO(10,16)
253#endif
254#endif
255#ifdef HAVE_GFC_REAL_16
256COPYSIGN_MACRO(16,4)
257COPYSIGN_MACRO(16,8)
258#ifdef HAVE_GFC_REAL_10
259COPYSIGN_MACRO(16,10)
260#endif
261COPYSIGN_MACRO(16,16)
262#endif
d566c3e0 263 end interface
264
265 interface IEEE_COPY_SIGN
c53bd1d9 266 procedure &
267#ifdef HAVE_GFC_REAL_16
268 _gfortran_ieee_copy_sign_16_16, &
269#ifdef HAVE_GFC_REAL_10
270 _gfortran_ieee_copy_sign_16_10, &
271#endif
272 _gfortran_ieee_copy_sign_16_8, &
273 _gfortran_ieee_copy_sign_16_4, &
274#endif
275#ifdef HAVE_GFC_REAL_10
276#ifdef HAVE_GFC_REAL_16
277 _gfortran_ieee_copy_sign_10_16, &
278#endif
279 _gfortran_ieee_copy_sign_10_10, &
280 _gfortran_ieee_copy_sign_10_8, &
281 _gfortran_ieee_copy_sign_10_4, &
282#endif
283#ifdef HAVE_GFC_REAL_16
284 _gfortran_ieee_copy_sign_8_16, &
285#endif
286#ifdef HAVE_GFC_REAL_10
287 _gfortran_ieee_copy_sign_8_10, &
288#endif
289 _gfortran_ieee_copy_sign_8_8, &
290 _gfortran_ieee_copy_sign_8_4, &
291#ifdef HAVE_GFC_REAL_16
292 _gfortran_ieee_copy_sign_4_16, &
293#endif
294#ifdef HAVE_GFC_REAL_10
295 _gfortran_ieee_copy_sign_4_10, &
296#endif
297 _gfortran_ieee_copy_sign_4_8, &
298 _gfortran_ieee_copy_sign_4_4
d566c3e0 299 end interface
300 public :: IEEE_COPY_SIGN
301
302 ! IEEE_UNORDERED
303
c53bd1d9 304#define UNORDERED_MACRO(A,B) \
305 elemental logical function \
306 _gfortran_ieee_unordered_/**/A/**/_/**/B (X,Y) ; \
307 real(kind = A), intent(in) :: X ; \
308 real(kind = B), intent(in) :: Y ; \
309 end function
310
d566c3e0 311 interface
c53bd1d9 312UNORDERED_MACRO(4,4)
313UNORDERED_MACRO(4,8)
314#ifdef HAVE_GFC_REAL_10
315UNORDERED_MACRO(4,10)
316#endif
317#ifdef HAVE_GFC_REAL_16
318UNORDERED_MACRO(4,16)
319#endif
320UNORDERED_MACRO(8,4)
321UNORDERED_MACRO(8,8)
322#ifdef HAVE_GFC_REAL_10
323UNORDERED_MACRO(8,10)
324#endif
325#ifdef HAVE_GFC_REAL_16
326UNORDERED_MACRO(8,16)
327#endif
328#ifdef HAVE_GFC_REAL_10
329UNORDERED_MACRO(10,4)
330UNORDERED_MACRO(10,8)
331UNORDERED_MACRO(10,10)
332#ifdef HAVE_GFC_REAL_16
333UNORDERED_MACRO(10,16)
334#endif
335#endif
336#ifdef HAVE_GFC_REAL_16
337UNORDERED_MACRO(16,4)
338UNORDERED_MACRO(16,8)
339#ifdef HAVE_GFC_REAL_10
340UNORDERED_MACRO(16,10)
341#endif
342UNORDERED_MACRO(16,16)
343#endif
d566c3e0 344 end interface
345
346 interface IEEE_UNORDERED
c53bd1d9 347 procedure &
348#ifdef HAVE_GFC_REAL_16
349 _gfortran_ieee_unordered_16_16, &
350#ifdef HAVE_GFC_REAL_10
351 _gfortran_ieee_unordered_16_10, &
352#endif
353 _gfortran_ieee_unordered_16_8, &
354 _gfortran_ieee_unordered_16_4, &
355#endif
356#ifdef HAVE_GFC_REAL_10
357#ifdef HAVE_GFC_REAL_16
358 _gfortran_ieee_unordered_10_16, &
359#endif
360 _gfortran_ieee_unordered_10_10, &
361 _gfortran_ieee_unordered_10_8, &
362 _gfortran_ieee_unordered_10_4, &
363#endif
364#ifdef HAVE_GFC_REAL_16
365 _gfortran_ieee_unordered_8_16, &
366#endif
367#ifdef HAVE_GFC_REAL_10
368 _gfortran_ieee_unordered_8_10, &
369#endif
370 _gfortran_ieee_unordered_8_8, &
371 _gfortran_ieee_unordered_8_4, &
372#ifdef HAVE_GFC_REAL_16
373 _gfortran_ieee_unordered_4_16, &
374#endif
375#ifdef HAVE_GFC_REAL_10
376 _gfortran_ieee_unordered_4_10, &
377#endif
378 _gfortran_ieee_unordered_4_8, &
379 _gfortran_ieee_unordered_4_4
d566c3e0 380 end interface
381 public :: IEEE_UNORDERED
382
383 ! IEEE_LOGB
384
385 interface
386 elemental real(kind=4) function _gfortran_ieee_logb_4 (X)
387 real(kind=4), intent(in) :: X
388 end function
389 elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
390 real(kind=8), intent(in) :: X
391 end function
c53bd1d9 392#ifdef HAVE_GFC_REAL_10
393 elemental real(kind=10) function _gfortran_ieee_logb_10 (X)
394 real(kind=10), intent(in) :: X
395 end function
396#endif
397#ifdef HAVE_GFC_REAL_16
398 elemental real(kind=16) function _gfortran_ieee_logb_16 (X)
399 real(kind=16), intent(in) :: X
400 end function
401#endif
d566c3e0 402 end interface
403
404 interface IEEE_LOGB
c53bd1d9 405 procedure &
406#ifdef HAVE_GFC_REAL_16
407 _gfortran_ieee_logb_16, &
408#endif
409#ifdef HAVE_GFC_REAL_10
410 _gfortran_ieee_logb_10, &
411#endif
412 _gfortran_ieee_logb_8, &
413 _gfortran_ieee_logb_4
d566c3e0 414 end interface
415 public :: IEEE_LOGB
416
417 ! IEEE_NEXT_AFTER
418
c53bd1d9 419#define NEXT_AFTER_MACRO(A,B) \
420 elemental real(kind = A) function \
421 _gfortran_ieee_next_after_/**/A/**/_/**/B (X,Y) ; \
422 real(kind = A), intent(in) :: X ; \
423 real(kind = B), intent(in) :: Y ; \
424 end function
425
d566c3e0 426 interface
c53bd1d9 427NEXT_AFTER_MACRO(4,4)
428NEXT_AFTER_MACRO(4,8)
429#ifdef HAVE_GFC_REAL_10
430NEXT_AFTER_MACRO(4,10)
431#endif
432#ifdef HAVE_GFC_REAL_16
433NEXT_AFTER_MACRO(4,16)
434#endif
435NEXT_AFTER_MACRO(8,4)
436NEXT_AFTER_MACRO(8,8)
437#ifdef HAVE_GFC_REAL_10
438NEXT_AFTER_MACRO(8,10)
439#endif
440#ifdef HAVE_GFC_REAL_16
441NEXT_AFTER_MACRO(8,16)
442#endif
443#ifdef HAVE_GFC_REAL_10
444NEXT_AFTER_MACRO(10,4)
445NEXT_AFTER_MACRO(10,8)
446NEXT_AFTER_MACRO(10,10)
447#ifdef HAVE_GFC_REAL_16
448NEXT_AFTER_MACRO(10,16)
449#endif
450#endif
451#ifdef HAVE_GFC_REAL_16
452NEXT_AFTER_MACRO(16,4)
453NEXT_AFTER_MACRO(16,8)
454#ifdef HAVE_GFC_REAL_10
455NEXT_AFTER_MACRO(16,10)
456#endif
457NEXT_AFTER_MACRO(16,16)
458#endif
d566c3e0 459 end interface
460
461 interface IEEE_NEXT_AFTER
c53bd1d9 462 procedure &
463#ifdef HAVE_GFC_REAL_16
464 _gfortran_ieee_next_after_16_16, &
465#ifdef HAVE_GFC_REAL_10
466 _gfortran_ieee_next_after_16_10, &
467#endif
468 _gfortran_ieee_next_after_16_8, &
469 _gfortran_ieee_next_after_16_4, &
470#endif
471#ifdef HAVE_GFC_REAL_10
472#ifdef HAVE_GFC_REAL_16
473 _gfortran_ieee_next_after_10_16, &
474#endif
475 _gfortran_ieee_next_after_10_10, &
476 _gfortran_ieee_next_after_10_8, &
477 _gfortran_ieee_next_after_10_4, &
478#endif
479#ifdef HAVE_GFC_REAL_16
480 _gfortran_ieee_next_after_8_16, &
481#endif
482#ifdef HAVE_GFC_REAL_10
483 _gfortran_ieee_next_after_8_10, &
484#endif
485 _gfortran_ieee_next_after_8_8, &
486 _gfortran_ieee_next_after_8_4, &
487#ifdef HAVE_GFC_REAL_16
488 _gfortran_ieee_next_after_4_16, &
489#endif
490#ifdef HAVE_GFC_REAL_10
491 _gfortran_ieee_next_after_4_10, &
492#endif
493 _gfortran_ieee_next_after_4_8, &
494 _gfortran_ieee_next_after_4_4
d566c3e0 495 end interface
496 public :: IEEE_NEXT_AFTER
497
498 ! IEEE_REM
499
c53bd1d9 500#define REM_MACRO(RES,A,B) \
501 elemental real(kind = RES) function \
502 _gfortran_ieee_rem_/**/A/**/_/**/B (X,Y) ; \
503 real(kind = A), intent(in) :: X ; \
504 real(kind = B), intent(in) :: Y ; \
505 end function
506
d566c3e0 507 interface
c53bd1d9 508REM_MACRO(4,4,4)
509REM_MACRO(8,4,8)
510#ifdef HAVE_GFC_REAL_10
511REM_MACRO(10,4,10)
512#endif
513#ifdef HAVE_GFC_REAL_16
514REM_MACRO(16,4,16)
515#endif
516REM_MACRO(8,8,4)
517REM_MACRO(8,8,8)
518#ifdef HAVE_GFC_REAL_10
519REM_MACRO(10,8,10)
520#endif
521#ifdef HAVE_GFC_REAL_16
522REM_MACRO(16,8,16)
523#endif
524#ifdef HAVE_GFC_REAL_10
525REM_MACRO(10,10,4)
526REM_MACRO(10,10,8)
527REM_MACRO(10,10,10)
528#ifdef HAVE_GFC_REAL_16
529REM_MACRO(16,10,16)
530#endif
531#endif
532#ifdef HAVE_GFC_REAL_16
533REM_MACRO(16,16,4)
534REM_MACRO(16,16,8)
535#ifdef HAVE_GFC_REAL_10
536REM_MACRO(16,16,10)
537#endif
538REM_MACRO(16,16,16)
539#endif
d566c3e0 540 end interface
541
542 interface IEEE_REM
c53bd1d9 543 procedure &
544#ifdef HAVE_GFC_REAL_16
545 _gfortran_ieee_rem_16_16, &
546#ifdef HAVE_GFC_REAL_10
547 _gfortran_ieee_rem_16_10, &
548#endif
549 _gfortran_ieee_rem_16_8, &
550 _gfortran_ieee_rem_16_4, &
551#endif
552#ifdef HAVE_GFC_REAL_10
553#ifdef HAVE_GFC_REAL_16
554 _gfortran_ieee_rem_10_16, &
555#endif
556 _gfortran_ieee_rem_10_10, &
557 _gfortran_ieee_rem_10_8, &
558 _gfortran_ieee_rem_10_4, &
559#endif
560#ifdef HAVE_GFC_REAL_16
561 _gfortran_ieee_rem_8_16, &
562#endif
563#ifdef HAVE_GFC_REAL_10
564 _gfortran_ieee_rem_8_10, &
565#endif
566 _gfortran_ieee_rem_8_8, &
567 _gfortran_ieee_rem_8_4, &
568#ifdef HAVE_GFC_REAL_16
569 _gfortran_ieee_rem_4_16, &
570#endif
571#ifdef HAVE_GFC_REAL_10
572 _gfortran_ieee_rem_4_10, &
573#endif
574 _gfortran_ieee_rem_4_8, &
575 _gfortran_ieee_rem_4_4
d566c3e0 576 end interface
577 public :: IEEE_REM
578
579 ! IEEE_RINT
580
581 interface
582 elemental real(kind=4) function _gfortran_ieee_rint_4 (X)
583 real(kind=4), intent(in) :: X
584 end function
585 elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
586 real(kind=8), intent(in) :: X
587 end function
c53bd1d9 588#ifdef HAVE_GFC_REAL_10
589 elemental real(kind=10) function _gfortran_ieee_rint_10 (X)
590 real(kind=10), intent(in) :: X
591 end function
592#endif
593#ifdef HAVE_GFC_REAL_16
594 elemental real(kind=16) function _gfortran_ieee_rint_16 (X)
595 real(kind=16), intent(in) :: X
596 end function
597#endif
d566c3e0 598 end interface
599
600 interface IEEE_RINT
c53bd1d9 601 procedure &
602#ifdef HAVE_GFC_REAL_16
603 _gfortran_ieee_rint_16, &
604#endif
605#ifdef HAVE_GFC_REAL_10
606 _gfortran_ieee_rint_10, &
607#endif
608 _gfortran_ieee_rint_8, _gfortran_ieee_rint_4
d566c3e0 609 end interface
610 public :: IEEE_RINT
611
612 ! IEEE_SCALB
613
614 interface
615 elemental real(kind=4) function _gfortran_ieee_scalb_4 (X, I)
616 real(kind=4), intent(in) :: X
617 integer, intent(in) :: I
618 end function
619 elemental real(kind=8) function _gfortran_ieee_scalb_8 (X, I)
620 real(kind=8), intent(in) :: X
621 integer, intent(in) :: I
622 end function
c53bd1d9 623#ifdef HAVE_GFC_REAL_10
624 elemental real(kind=10) function _gfortran_ieee_scalb_10 (X, I)
625 real(kind=10), intent(in) :: X
626 integer, intent(in) :: I
627 end function
628#endif
629#ifdef HAVE_GFC_REAL_16
630 elemental real(kind=16) function _gfortran_ieee_scalb_16 (X, I)
631 real(kind=16), intent(in) :: X
632 integer, intent(in) :: I
633 end function
634#endif
d566c3e0 635 end interface
636
637 interface IEEE_SCALB
c53bd1d9 638 procedure &
639#ifdef HAVE_GFC_REAL_16
640 _gfortran_ieee_scalb_16, &
641#endif
642#ifdef HAVE_GFC_REAL_10
643 _gfortran_ieee_scalb_10, &
644#endif
645 _gfortran_ieee_scalb_8, _gfortran_ieee_scalb_4
d566c3e0 646 end interface
647 public :: IEEE_SCALB
648
649 ! IEEE_VALUE
650
651 interface IEEE_VALUE
c53bd1d9 652 module procedure &
653#ifdef HAVE_GFC_REAL_16
654 IEEE_VALUE_16, &
655#endif
656#ifdef HAVE_GFC_REAL_10
657 IEEE_VALUE_10, &
658#endif
659 IEEE_VALUE_8, IEEE_VALUE_4
d566c3e0 660 end interface
661 public :: IEEE_VALUE
662
663 ! IEEE_CLASS
664
665 interface IEEE_CLASS
c53bd1d9 666 module procedure &
667#ifdef HAVE_GFC_REAL_16
668 IEEE_CLASS_16, &
669#endif
670#ifdef HAVE_GFC_REAL_10
671 IEEE_CLASS_10, &
672#endif
673 IEEE_CLASS_8, IEEE_CLASS_4
d566c3e0 674 end interface
675 public :: IEEE_CLASS
676
677 ! Public declarations for contained procedures
678 public :: IEEE_GET_ROUNDING_MODE, IEEE_SET_ROUNDING_MODE
679 public :: IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE
680 public :: IEEE_SELECTED_REAL_KIND
681
682 ! IEEE_SUPPORT_ROUNDING
683
684 interface IEEE_SUPPORT_ROUNDING
685 module procedure IEEE_SUPPORT_ROUNDING_4, IEEE_SUPPORT_ROUNDING_8, &
686#ifdef HAVE_GFC_REAL_10
687 IEEE_SUPPORT_ROUNDING_10, &
688#endif
689#ifdef HAVE_GFC_REAL_16
690 IEEE_SUPPORT_ROUNDING_16, &
691#endif
692 IEEE_SUPPORT_ROUNDING_NOARG
693 end interface
694 public :: IEEE_SUPPORT_ROUNDING
695
696 ! Interface to the FPU-specific function
697 interface
698 pure integer function support_rounding_helper(flag) &
699 bind(c, name="_gfortrani_support_fpu_rounding_mode")
700 integer, intent(in), value :: flag
701 end function
702 end interface
703
3e5db1e0 704 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
705
706 interface IEEE_SUPPORT_UNDERFLOW_CONTROL
707 module procedure IEEE_SUPPORT_UNDERFLOW_CONTROL_4, &
708 IEEE_SUPPORT_UNDERFLOW_CONTROL_8, &
709#ifdef HAVE_GFC_REAL_10
710 IEEE_SUPPORT_UNDERFLOW_CONTROL_10, &
711#endif
712#ifdef HAVE_GFC_REAL_16
713 IEEE_SUPPORT_UNDERFLOW_CONTROL_16, &
714#endif
715 IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG
716 end interface
717 public :: IEEE_SUPPORT_UNDERFLOW_CONTROL
718
719 ! Interface to the FPU-specific function
720 interface
721 pure integer function support_underflow_control_helper(kind) &
722 bind(c, name="_gfortrani_support_fpu_underflow_control")
723 integer, intent(in), value :: kind
724 end function
725 end interface
726
d566c3e0 727! IEEE_SUPPORT_* generic functions
728
729#if defined(HAVE_GFC_REAL_10) && defined(HAVE_GFC_REAL_16)
730# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_16, NAME/**/_NOARG
731#elif defined(HAVE_GFC_REAL_10)
732# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_NOARG
733#elif defined(HAVE_GFC_REAL_16)
734# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_16, NAME/**/_NOARG
735#else
736# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_NOARG
737#endif
738
739#define SUPPORTGENERIC(NAME) \
740 interface NAME ; module procedure MACRO1(NAME) ; end interface ; \
741 public :: NAME
742
743SUPPORTGENERIC(IEEE_SUPPORT_DATATYPE)
744SUPPORTGENERIC(IEEE_SUPPORT_DENORMAL)
745SUPPORTGENERIC(IEEE_SUPPORT_DIVIDE)
746SUPPORTGENERIC(IEEE_SUPPORT_INF)
747SUPPORTGENERIC(IEEE_SUPPORT_IO)
748SUPPORTGENERIC(IEEE_SUPPORT_NAN)
749SUPPORTGENERIC(IEEE_SUPPORT_SQRT)
750SUPPORTGENERIC(IEEE_SUPPORT_STANDARD)
d566c3e0 751
752contains
753
754 ! Equality operators for IEEE_CLASS_TYPE and IEEE_ROUNDING_MODE
755 elemental logical function IEEE_CLASS_TYPE_EQ (X, Y) result(res)
756 implicit none
757 type(IEEE_CLASS_TYPE), intent(in) :: X, Y
758 res = (X%hidden == Y%hidden)
759 end function
760
761 elemental logical function IEEE_CLASS_TYPE_NE (X, Y) result(res)
762 implicit none
763 type(IEEE_CLASS_TYPE), intent(in) :: X, Y
764 res = (X%hidden /= Y%hidden)
765 end function
766
767 elemental logical function IEEE_ROUND_TYPE_EQ (X, Y) result(res)
768 implicit none
769 type(IEEE_ROUND_TYPE), intent(in) :: X, Y
770 res = (X%hidden == Y%hidden)
771 end function
772
773 elemental logical function IEEE_ROUND_TYPE_NE (X, Y) result(res)
774 implicit none
775 type(IEEE_ROUND_TYPE), intent(in) :: X, Y
776 res = (X%hidden /= Y%hidden)
777 end function
778
c53bd1d9 779
d566c3e0 780 ! IEEE_SELECTED_REAL_KIND
c53bd1d9 781
d566c3e0 782 integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
783 implicit none
784 integer, intent(in), optional :: P, R, RADIX
c53bd1d9 785
786 ! Currently, if IEEE is supported and this module is built, it means
787 ! all our floating-point types conform to IEEE. Hence, we simply call
788 ! SELECTED_REAL_KIND.
789
790 res = SELECTED_REAL_KIND (P, R, RADIX)
791
d566c3e0 792 end function
793
794
795 ! IEEE_CLASS
796
797 elemental function IEEE_CLASS_4 (X) result(res)
798 implicit none
799 real(kind=4), intent(in) :: X
800 type(IEEE_CLASS_TYPE) :: res
801
802 interface
803 pure integer function _gfortrani_ieee_class_helper_4(val)
804 real(kind=4), intent(in) :: val
805 end function
806 end interface
807
808 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_4(X))
809 end function
810
811 elemental function IEEE_CLASS_8 (X) result(res)
812 implicit none
813 real(kind=8), intent(in) :: X
814 type(IEEE_CLASS_TYPE) :: res
815
816 interface
817 pure integer function _gfortrani_ieee_class_helper_8(val)
818 real(kind=8), intent(in) :: val
819 end function
820 end interface
821
822 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
823 end function
824
c53bd1d9 825#ifdef HAVE_GFC_REAL_10
826 elemental function IEEE_CLASS_10 (X) result(res)
827 implicit none
828 real(kind=10), intent(in) :: X
829 type(IEEE_CLASS_TYPE) :: res
830
831 interface
832 pure integer function _gfortrani_ieee_class_helper_10(val)
833 real(kind=10), intent(in) :: val
834 end function
835 end interface
836
837 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_10(X))
838 end function
839#endif
840
841#ifdef HAVE_GFC_REAL_16
842 elemental function IEEE_CLASS_16 (X) result(res)
843 implicit none
844 real(kind=16), intent(in) :: X
845 type(IEEE_CLASS_TYPE) :: res
846
847 interface
848 pure integer function _gfortrani_ieee_class_helper_16(val)
849 real(kind=16), intent(in) :: val
850 end function
851 end interface
852
853 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_16(X))
854 end function
855#endif
856
857
d566c3e0 858 ! IEEE_VALUE
859
860 elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
861 implicit none
862 real(kind=4), intent(in) :: X
863 type(IEEE_CLASS_TYPE), intent(in) :: C
864
865 select case (C%hidden)
866 case (1) ! IEEE_SIGNALING_NAN
867 res = -1
868 res = sqrt(res)
869 case (2) ! IEEE_QUIET_NAN
870 res = -1
871 res = sqrt(res)
872 case (3) ! IEEE_NEGATIVE_INF
873 res = huge(res)
874 res = (-res) * res
875 case (4) ! IEEE_NEGATIVE_NORMAL
876 res = -42
877 case (5) ! IEEE_NEGATIVE_DENORMAL
878 res = -tiny(res)
879 res = res / 2
880 case (6) ! IEEE_NEGATIVE_ZERO
881 res = 0
882 res = -res
883 case (7) ! IEEE_POSITIVE_ZERO
884 res = 0
885 case (8) ! IEEE_POSITIVE_DENORMAL
886 res = tiny(res)
887 res = res / 2
888 case (9) ! IEEE_POSITIVE_NORMAL
889 res = 42
890 case (10) ! IEEE_POSITIVE_INF
891 res = huge(res)
892 res = res * res
893 case default ! IEEE_OTHER_VALUE, should not happen
894 res = 0
895 end select
896 end function
897
898 elemental real(kind=8) function IEEE_VALUE_8(X, C) result(res)
899 implicit none
900 real(kind=8), intent(in) :: X
901 type(IEEE_CLASS_TYPE), intent(in) :: C
902
903 select case (C%hidden)
904 case (1) ! IEEE_SIGNALING_NAN
905 res = -1
906 res = sqrt(res)
907 case (2) ! IEEE_QUIET_NAN
908 res = -1
909 res = sqrt(res)
910 case (3) ! IEEE_NEGATIVE_INF
911 res = huge(res)
912 res = (-res) * res
913 case (4) ! IEEE_NEGATIVE_NORMAL
914 res = -42
915 case (5) ! IEEE_NEGATIVE_DENORMAL
916 res = -tiny(res)
917 res = res / 2
918 case (6) ! IEEE_NEGATIVE_ZERO
919 res = 0
920 res = -res
921 case (7) ! IEEE_POSITIVE_ZERO
922 res = 0
923 case (8) ! IEEE_POSITIVE_DENORMAL
924 res = tiny(res)
925 res = res / 2
926 case (9) ! IEEE_POSITIVE_NORMAL
927 res = 42
928 case (10) ! IEEE_POSITIVE_INF
929 res = huge(res)
930 res = res * res
931 case default ! IEEE_OTHER_VALUE, should not happen
932 res = 0
933 end select
934 end function
935
c53bd1d9 936#ifdef HAVE_GFC_REAL_10
937 elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
938 implicit none
939 real(kind=10), intent(in) :: X
940 type(IEEE_CLASS_TYPE), intent(in) :: C
941
942 select case (C%hidden)
943 case (1) ! IEEE_SIGNALING_NAN
944 res = -1
945 res = sqrt(res)
946 case (2) ! IEEE_QUIET_NAN
947 res = -1
948 res = sqrt(res)
949 case (3) ! IEEE_NEGATIVE_INF
950 res = huge(res)
951 res = (-res) * res
952 case (4) ! IEEE_NEGATIVE_NORMAL
953 res = -42
954 case (5) ! IEEE_NEGATIVE_DENORMAL
955 res = -tiny(res)
956 res = res / 2
957 case (6) ! IEEE_NEGATIVE_ZERO
958 res = 0
959 res = -res
960 case (7) ! IEEE_POSITIVE_ZERO
961 res = 0
962 case (8) ! IEEE_POSITIVE_DENORMAL
963 res = tiny(res)
964 res = res / 2
965 case (9) ! IEEE_POSITIVE_NORMAL
966 res = 42
967 case (10) ! IEEE_POSITIVE_INF
968 res = huge(res)
969 res = res * res
970 case default ! IEEE_OTHER_VALUE, should not happen
971 res = 0
972 end select
973 end function
974#endif
975
976#ifdef HAVE_GFC_REAL_16
977 elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
978 implicit none
979 real(kind=16), intent(in) :: X
980 type(IEEE_CLASS_TYPE), intent(in) :: C
981
982 select case (C%hidden)
983 case (1) ! IEEE_SIGNALING_NAN
984 res = -1
985 res = sqrt(res)
986 case (2) ! IEEE_QUIET_NAN
987 res = -1
988 res = sqrt(res)
989 case (3) ! IEEE_NEGATIVE_INF
990 res = huge(res)
991 res = (-res) * res
992 case (4) ! IEEE_NEGATIVE_NORMAL
993 res = -42
994 case (5) ! IEEE_NEGATIVE_DENORMAL
995 res = -tiny(res)
996 res = res / 2
997 case (6) ! IEEE_NEGATIVE_ZERO
998 res = 0
999 res = -res
1000 case (7) ! IEEE_POSITIVE_ZERO
1001 res = 0
1002 case (8) ! IEEE_POSITIVE_DENORMAL
1003 res = tiny(res)
1004 res = res / 2
1005 case (9) ! IEEE_POSITIVE_NORMAL
1006 res = 42
1007 case (10) ! IEEE_POSITIVE_INF
1008 res = huge(res)
1009 res = res * res
1010 case default ! IEEE_OTHER_VALUE, should not happen
1011 res = 0
1012 end select
1013 end function
1014#endif
1015
d566c3e0 1016
1017 ! IEEE_GET_ROUNDING_MODE
1018
1019 subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE)
1020 implicit none
1021 type(IEEE_ROUND_TYPE), intent(out) :: ROUND_VALUE
d566c3e0 1022
1023 interface
1024 integer function helper() &
1025 bind(c, name="_gfortrani_get_fpu_rounding_mode")
1026 end function
1027 end interface
1028
3e5db1e0 1029 ROUND_VALUE = IEEE_ROUND_TYPE(helper())
d566c3e0 1030 end subroutine
1031
1032
1033 ! IEEE_SET_ROUNDING_MODE
1034
1035 subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE)
1036 implicit none
1037 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1038
1039 interface
1040 subroutine helper(val) &
1041 bind(c, name="_gfortrani_set_fpu_rounding_mode")
1042 integer, value :: val
1043 end subroutine
1044 end interface
1045
1046 call helper(ROUND_VALUE%hidden)
1047 end subroutine
1048
1049
1050 ! IEEE_GET_UNDERFLOW_MODE
1051
1052 subroutine IEEE_GET_UNDERFLOW_MODE (GRADUAL)
1053 implicit none
1054 logical, intent(out) :: GRADUAL
3e5db1e0 1055
1056 interface
1057 integer function helper() &
1058 bind(c, name="_gfortrani_get_fpu_underflow_mode")
1059 end function
1060 end interface
1061
1062 GRADUAL = (helper() /= 0)
d566c3e0 1063 end subroutine
1064
1065
1066 ! IEEE_SET_UNDERFLOW_MODE
1067
1068 subroutine IEEE_SET_UNDERFLOW_MODE (GRADUAL)
1069 implicit none
1070 logical, intent(in) :: GRADUAL
3e5db1e0 1071
1072 interface
1073 subroutine helper(val) &
1074 bind(c, name="_gfortrani_set_fpu_underflow_mode")
1075 integer, value :: val
1076 end subroutine
1077 end interface
1078
1079 call helper(merge(1, 0, GRADUAL))
d566c3e0 1080 end subroutine
1081
1082! IEEE_SUPPORT_ROUNDING
1083
1084 pure logical function IEEE_SUPPORT_ROUNDING_4 (ROUND_VALUE, X) result(res)
1085 implicit none
1086 real(kind=4), intent(in) :: X
1087 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1088 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1089 end function
1090
1091 pure logical function IEEE_SUPPORT_ROUNDING_8 (ROUND_VALUE, X) result(res)
1092 implicit none
1093 real(kind=8), intent(in) :: X
1094 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1095 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1096 end function
1097
1098#ifdef HAVE_GFC_REAL_10
1099 pure logical function IEEE_SUPPORT_ROUNDING_10 (ROUND_VALUE, X) result(res)
1100 implicit none
1101 real(kind=10), intent(in) :: X
1102 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
c53bd1d9 1103 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
d566c3e0 1104 end function
1105#endif
1106
1107#ifdef HAVE_GFC_REAL_16
1108 pure logical function IEEE_SUPPORT_ROUNDING_16 (ROUND_VALUE, X) result(res)
1109 implicit none
1110 real(kind=16), intent(in) :: X
1111 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
c53bd1d9 1112 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
d566c3e0 1113 end function
1114#endif
1115
1116 pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
1117 implicit none
1118 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
d566c3e0 1119 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
d566c3e0 1120 end function
1121
3e5db1e0 1122! IEEE_SUPPORT_UNDERFLOW_CONTROL
1123
1124 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_4 (X) result(res)
1125 implicit none
1126 real(kind=4), intent(in) :: X
1127 res = (support_underflow_control_helper(4) /= 0)
1128 end function
1129
1130 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_8 (X) result(res)
1131 implicit none
1132 real(kind=8), intent(in) :: X
1133 res = (support_underflow_control_helper(8) /= 0)
1134 end function
1135
1136#ifdef HAVE_GFC_REAL_10
1137 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
1138 implicit none
1139 real(kind=10), intent(in) :: X
c53bd1d9 1140 res = (support_underflow_control_helper(10) /= 0)
3e5db1e0 1141 end function
1142#endif
1143
1144#ifdef HAVE_GFC_REAL_16
1145 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
1146 implicit none
1147 real(kind=16), intent(in) :: X
c53bd1d9 1148 res = (support_underflow_control_helper(16) /= 0)
3e5db1e0 1149 end function
1150#endif
1151
1152 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
1153 implicit none
3e5db1e0 1154 res = (support_underflow_control_helper(4) /= 0 &
c53bd1d9 1155 .and. support_underflow_control_helper(8) /= 0 &
1156#ifdef HAVE_GFC_REAL_10
1157 .and. support_underflow_control_helper(10) /= 0 &
1158#endif
1159#ifdef HAVE_GFC_REAL_16
1160 .and. support_underflow_control_helper(16) /= 0 &
3e5db1e0 1161#endif
c53bd1d9 1162 )
3e5db1e0 1163 end function
1164
d566c3e0 1165! IEEE_SUPPORT_* functions
1166
1167#define SUPPORTMACRO(NAME, INTKIND, VALUE) \
1168 pure logical function NAME/**/_/**/INTKIND (X) result(res) ; \
1169 implicit none ; \
1170 real(INTKIND), intent(in) :: X(..) ; \
1171 res = VALUE ; \
1172 end function
1173
1174#define SUPPORTMACRO_NOARG(NAME, VALUE) \
1175 pure logical function NAME/**/_NOARG () result(res) ; \
1176 implicit none ; \
1177 res = VALUE ; \
1178 end function
1179
1180! IEEE_SUPPORT_DATATYPE
1181
1182SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
1183SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
1184#ifdef HAVE_GFC_REAL_10
c53bd1d9 1185SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.true.)
d566c3e0 1186#endif
1187#ifdef HAVE_GFC_REAL_16
c53bd1d9 1188SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.true.)
d566c3e0 1189#endif
d566c3e0 1190SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
d566c3e0 1191
1192! IEEE_SUPPORT_DENORMAL
1193
1194SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
1195SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
1196#ifdef HAVE_GFC_REAL_10
c53bd1d9 1197SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.true.)
d566c3e0 1198#endif
1199#ifdef HAVE_GFC_REAL_16
c53bd1d9 1200SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.true.)
d566c3e0 1201#endif
d566c3e0 1202SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
d566c3e0 1203
1204! IEEE_SUPPORT_DIVIDE
1205
1206SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
1207SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
1208#ifdef HAVE_GFC_REAL_10
c53bd1d9 1209SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.true.)
d566c3e0 1210#endif
1211#ifdef HAVE_GFC_REAL_16
c53bd1d9 1212SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.true.)
d566c3e0 1213#endif
d566c3e0 1214SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
d566c3e0 1215
1216! IEEE_SUPPORT_INF
1217
1218SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
1219SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
1220#ifdef HAVE_GFC_REAL_10
c53bd1d9 1221SUPPORTMACRO(IEEE_SUPPORT_INF,10,.true.)
d566c3e0 1222#endif
1223#ifdef HAVE_GFC_REAL_16
c53bd1d9 1224SUPPORTMACRO(IEEE_SUPPORT_INF,16,.true.)
d566c3e0 1225#endif
d566c3e0 1226SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
d566c3e0 1227
1228! IEEE_SUPPORT_IO
1229
1230SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
1231SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
1232#ifdef HAVE_GFC_REAL_10
c53bd1d9 1233SUPPORTMACRO(IEEE_SUPPORT_IO,10,.true.)
d566c3e0 1234#endif
1235#ifdef HAVE_GFC_REAL_16
c53bd1d9 1236SUPPORTMACRO(IEEE_SUPPORT_IO,16,.true.)
d566c3e0 1237#endif
d566c3e0 1238SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
d566c3e0 1239
1240! IEEE_SUPPORT_NAN
1241
1242SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
1243SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
1244#ifdef HAVE_GFC_REAL_10
c53bd1d9 1245SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.true.)
d566c3e0 1246#endif
1247#ifdef HAVE_GFC_REAL_16
c53bd1d9 1248SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.true.)
d566c3e0 1249#endif
d566c3e0 1250SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
d566c3e0 1251
1252! IEEE_SUPPORT_SQRT
1253
1254SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
1255SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
1256#ifdef HAVE_GFC_REAL_10
c53bd1d9 1257SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.true.)
d566c3e0 1258#endif
1259#ifdef HAVE_GFC_REAL_16
c53bd1d9 1260SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.true.)
d566c3e0 1261#endif
d566c3e0 1262SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
d566c3e0 1263
1264! IEEE_SUPPORT_STANDARD
1265
1266SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
1267SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
1268#ifdef HAVE_GFC_REAL_10
c53bd1d9 1269SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.true.)
d566c3e0 1270#endif
1271#ifdef HAVE_GFC_REAL_16
c53bd1d9 1272SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.true.)
d566c3e0 1273#endif
d566c3e0 1274SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
d566c3e0 1275
d566c3e0 1276end module IEEE_ARITHMETIC
Mirror of https://gcc.gnu.org/git/gcc.git