142 lines · plain
1!===-- module/__fortran_ieee_exceptions.f90 --------------------------------===!2!3! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4! See https://llvm.org/LICENSE.txt for license information.5! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6!7!===------------------------------------------------------------------------===!8 9! See Fortran 2018, clause 1710! The content of the standard intrinsic IEEE_EXCEPTIONS module is packaged11! here under another name so that IEEE_ARITHMETIC can USE it and export its12! declarations without clashing with a non-intrinsic module in a program.13 14#include '../include/flang/Runtime/magic-numbers.h'15 16module __fortran_ieee_exceptions17 use __fortran_builtins, only: &18 ieee_flag_type => __builtin_ieee_flag_type, &19 ieee_support_flag => __builtin_ieee_support_flag, &20 ieee_support_halting => __builtin_ieee_support_halting, &21 ieee_invalid => __builtin_ieee_invalid, &22 ieee_overflow => __builtin_ieee_overflow, &23 ieee_divide_by_zero => __builtin_ieee_divide_by_zero, &24 ieee_underflow => __builtin_ieee_underflow, &25 ieee_inexact => __builtin_ieee_inexact, &26 ieee_denorm => __builtin_ieee_denorm27 implicit none28 private29 30 public :: ieee_flag_type, ieee_support_flag, ieee_support_halting31 public :: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_underflow, &32 ieee_inexact, ieee_denorm33 34 type(ieee_flag_type), parameter, public :: &35 ieee_usual(*) = [ ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &36 ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ]37 38 type, public :: ieee_modes_type ! Fortran 2018, 17.739 private ! opaque fenv.h femode_t data; code will access only one component40 integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT)41 integer(kind=1), allocatable :: __allocatable_data(:)42 end type ieee_modes_type43 44 type, public :: ieee_status_type ! Fortran 2018, 17.745 private ! opaque fenv.h fenv_t data; code will access only one component46 integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT)47 integer(kind=1), allocatable :: __allocatable_data(:)48 end type ieee_status_type49 50! Define specifics with 1 LOGICAL or REAL argument for generic G.51#define SPECIFICS_L(G) \52 G(1) G(2) G(4) G(8)53#if __x86_64__54#define SPECIFICS_R(G) \55 G(2) G(3) G(4) G(8) G(10) G(16)56#else57#define SPECIFICS_R(G) \58 G(2) G(3) G(4) G(8) G(16)59#endif60 61#define IEEE_GET_FLAG_L(FVKIND) \62 elemental subroutine ieee_get_flag_l##FVKIND(flag, flag_value); \63 import ieee_flag_type; \64 type(ieee_flag_type), intent(in) :: flag; \65 logical(FVKIND), intent(out) :: flag_value; \66 end subroutine ieee_get_flag_l##FVKIND;67 interface ieee_get_flag68 SPECIFICS_L(IEEE_GET_FLAG_L)69 end interface ieee_get_flag70 public :: ieee_get_flag71#undef IEEE_GET_FLAG_L72 73#define IEEE_GET_HALTING_MODE_L(HKIND) \74 elemental subroutine ieee_get_halting_mode_l##HKIND(flag, halting); \75 import ieee_flag_type; \76 type(ieee_flag_type), intent(in) :: flag; \77 logical(HKIND), intent(out) :: halting; \78 end subroutine ieee_get_halting_mode_l##HKIND;79 interface ieee_get_halting_mode80 SPECIFICS_L(IEEE_GET_HALTING_MODE_L)81 end interface ieee_get_halting_mode82 public :: ieee_get_halting_mode83#undef IEEE_GET_HALTING_MODE_L84 85 interface ieee_get_modes86 pure subroutine ieee_get_modes_0(modes)87 import ieee_modes_type88 type(ieee_modes_type), intent(out) :: modes89 end subroutine ieee_get_modes_090 end interface91 public :: ieee_get_modes92 93 interface ieee_get_status94 pure subroutine ieee_get_status_0(status)95 import ieee_status_type96 type(ieee_status_type), intent(out) :: status97 end subroutine ieee_get_status_098 end interface99 public :: ieee_get_status100 101#define IEEE_SET_FLAG_L(FVKIND) \102 elemental subroutine ieee_set_flag_l##FVKIND(flag, flag_value); \103 import ieee_flag_type; \104 type(ieee_flag_type), intent(in) :: flag; \105 logical(FVKIND), intent(in) :: flag_value; \106 end subroutine ieee_set_flag_l##FVKIND;107 interface ieee_set_flag108 SPECIFICS_L(IEEE_SET_FLAG_L)109 end interface ieee_set_flag110 public :: ieee_set_flag111#undef IEEE_SET_FLAG_L112 113#define IEEE_SET_HALTING_MODE_L(HKIND) \114 elemental subroutine ieee_set_halting_mode_l##HKIND(flag, halting); \115 import ieee_flag_type; \116 type(ieee_flag_type), intent(in) :: flag; \117 logical(HKIND), intent(in) :: halting; \118 end subroutine ieee_set_halting_mode_l##HKIND;119 interface ieee_set_halting_mode120 SPECIFICS_L(IEEE_SET_HALTING_MODE_L)121 end interface ieee_set_halting_mode122 public :: ieee_set_halting_mode123#undef IEEE_SET_HALTING_MODE_L124 125 interface ieee_set_modes126 subroutine ieee_set_modes_0(modes)127 import ieee_modes_type128 type(ieee_modes_type), intent(in) :: modes129 end subroutine ieee_set_modes_0130 end interface131 public :: ieee_set_modes132 133 interface ieee_set_status134 pure subroutine ieee_set_status_0(status)135 import ieee_status_type136 type(ieee_status_type), intent(in) :: status137 end subroutine ieee_set_status_0138 end interface139 public :: ieee_set_status140 141end module __fortran_ieee_exceptions142