maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity
llvm-project/flang/module/ieee_arithmetic.f90

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

550 lines
19 KiB
Fortran
Raw Normal View History

[flang] Flang relicensing changes for LLVM Apache 2.0 license This changes the license information in many of the flang source files. - Renamed LICENSE to LICENSE.txt. - NVIDIA Copyright lines have been removed. - Initial lines for files follow the LLVM coding convention (file name on the first line; Emacs mode information on the first line). - License references have been replaced with the abridged LLVM text. - License information was removed from the test files. - No file header was placed on test files (these weren't in most LLVM test files). - License information was added to documentation files where it was missing. We did not add brief file summaries to the initial line. See http://llvm.org/docs/DeveloperPolicy.html#new-llvm-project-license-framework for a description of the new license. See http://llvm.org/docs/CodingStandards.html#file-headers for a description of the new LLVM standard file header. Original-commit: flang-compiler/f18@add6cde7244b926ca457a1c74c21fea071b85329 Reviewed-on: https://github.com/flang-compiler/f18/pull/887
2019-12-21 04:52:07 +08:00
!===-- module/ieee_arithmetic.f90 ------------------------------------------===!
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
!
[flang] Flang relicensing changes for LLVM Apache 2.0 license This changes the license information in many of the flang source files. - Renamed LICENSE to LICENSE.txt. - NVIDIA Copyright lines have been removed. - Initial lines for files follow the LLVM coding convention (file name on the first line; Emacs mode information on the first line). - License references have been replaced with the abridged LLVM text. - License information was removed from the test files. - No file header was placed on test files (these weren't in most LLVM test files). - License information was added to documentation files where it was missing. We did not add brief file summaries to the initial line. See http://llvm.org/docs/DeveloperPolicy.html#new-llvm-project-license-framework for a description of the new license. See http://llvm.org/docs/CodingStandards.html#file-headers for a description of the new LLVM standard file header. Original-commit: flang-compiler/f18@add6cde7244b926ca457a1c74c21fea071b85329 Reviewed-on: https://github.com/flang-compiler/f18/pull/887
2019-12-21 04:52:07 +08:00
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
! See https://llvm.org/LICENSE.txt for license information.
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
!
[flang] Minor format change to LLVM license lines Replace comment lines containing all dashes with the proper ===-----....----=== markers. Original-commit: flang-compiler/f18@a8936b0d4187a9a9ef43f9d34055a3213beeb9d2 Reviewed-on: https://github.com/flang-compiler/f18/pull/922
2020-01-11 04:12:03 +08:00
!===------------------------------------------------------------------------===!
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
! Fortran 2018 Clause 17
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
module ieee_arithmetic
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a
! USE statement for IEEE_EXCEPTIONS; everything that is public in
! IEEE_EXCEPTIONS is public in IEEE_ARITHMETIC."
use __Fortran_ieee_exceptions
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
[flang] Implement IEEE_SUPPORT_xxx inquiry functions Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic functions from the intrinsic module IEEE_ARITHMETIC, folding all of their results to .TRUE. Differential Revision: https://reviews.llvm.org/D95830
2021-02-02 07:23:58 +08:00
use __Fortran_builtins, only: &
[flang] Define missing & needed IEEE_ARITHMETIC symbols Define IEEE_IS_NAN, IEEE_IS_FINITE, & IEEE_REM. Differential Revision: https://reviews.llvm.org/D100599
2021-04-16 05:11:47 +08:00
ieee_is_nan => __builtin_ieee_is_nan, &
Add ieee_is_normal/ieee_is_negative to ieee_arithmetic module.
2022-01-21 16:24:32 +08:00
ieee_is_negative => __builtin_ieee_is_negative, &
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
ieee_is_normal => __builtin_ieee_is_normal, &
[flang] Define IEEE_SCALB, IEEE_NEXT_AFTER, IEEE_NEXT_DOWN, IEEE_NEXT_UP These functions were missing from the standard intrinsic module IEEE_ARITHMETIC. IEEE_SCALB is an alias for the standard intrinsic function SCALE(), and the others are defined as new builtin intrinsic functions. Differential Revision: https://reviews.llvm.org/D111253
2021-10-02 05:40:40 +08:00
ieee_next_after => __builtin_ieee_next_after, &
ieee_next_down => __builtin_ieee_next_down, &
ieee_next_up => __builtin_ieee_next_up, &
ieee_scalb => scale, &
[flang] Define missing & needed IEEE_ARITHMETIC symbols Define IEEE_IS_NAN, IEEE_IS_FINITE, & IEEE_REM. Differential Revision: https://reviews.llvm.org/D100599
2021-04-16 05:11:47 +08:00
ieee_selected_real_kind => __builtin_ieee_selected_real_kind, &
[flang] Implement IEEE_SUPPORT_xxx inquiry functions Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic functions from the intrinsic module IEEE_ARITHMETIC, folding all of their results to .TRUE. Differential Revision: https://reviews.llvm.org/D95830
2021-02-02 07:23:58 +08:00
ieee_support_datatype => __builtin_ieee_support_datatype, &
ieee_support_denormal => __builtin_ieee_support_denormal, &
ieee_support_divide => __builtin_ieee_support_divide, &
ieee_support_inf => __builtin_ieee_support_inf, &
ieee_support_io => __builtin_ieee_support_io, &
ieee_support_nan => __builtin_ieee_support_nan, &
ieee_support_sqrt => __builtin_ieee_support_sqrt, &
ieee_support_standard => __builtin_ieee_support_standard, &
ieee_support_subnormal => __builtin_ieee_support_subnormal, &
[flang] Define missing & needed IEEE_ARITHMETIC symbols Define IEEE_IS_NAN, IEEE_IS_FINITE, & IEEE_REM. Differential Revision: https://reviews.llvm.org/D100599
2021-04-16 05:11:47 +08:00
ieee_support_underflow_control => __builtin_ieee_support_underflow_control
implicit none
[flang] Implement IEEE_SUPPORT_xxx inquiry functions Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic functions from the intrinsic module IEEE_ARITHMETIC, folding all of their results to .TRUE. Differential Revision: https://reviews.llvm.org/D95830
2021-02-02 07:23:58 +08:00
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
type :: ieee_class_type
private
integer(kind=1) :: which = 0
end type ieee_class_type
type(ieee_class_type), parameter :: &
ieee_signaling_nan = ieee_class_type(1), &
ieee_quiet_nan = ieee_class_type(2), &
ieee_negative_inf = ieee_class_type(3), &
ieee_negative_normal = ieee_class_type(4), &
ieee_negative_denormal = ieee_class_type(5), &
ieee_negative_zero = ieee_class_type(6), &
ieee_positive_zero = ieee_class_type(7), &
ieee_positive_subnormal = ieee_class_type(8), &
ieee_positive_normal = ieee_class_type(9), &
ieee_positive_inf = ieee_class_type(10), &
ieee_other_value = ieee_class_type(11)
type(ieee_class_type), parameter :: &
ieee_negative_subnormal = ieee_negative_denormal, &
ieee_positive_denormal = ieee_negative_subnormal
type :: ieee_round_type
private
integer(kind=1) :: mode = 0
end type ieee_round_type
type(ieee_round_type), parameter :: &
ieee_nearest = ieee_round_type(1), &
ieee_to_zero = ieee_round_type(2), &
ieee_up = ieee_round_type(3), &
ieee_down = ieee_round_type(4), &
ieee_away = ieee_round_type(5), &
ieee_other = ieee_round_type(6)
interface operator(==)
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
elemental logical function ieee_class_eq(x, y)
import ieee_class_type
type(ieee_class_type), intent(in) :: x, y
end function ieee_class_eq
elemental logical function ieee_round_eq(x, y)
import ieee_round_type
type(ieee_round_type), intent(in) :: x, y
end function ieee_round_eq
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
end interface operator(==)
interface operator(/=)
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
elemental logical function ieee_class_ne(x, y)
import ieee_class_type
type(ieee_class_type), intent(in) :: x, y
end function ieee_class_ne
elemental logical function ieee_round_ne(x, y)
import ieee_round_type
type(ieee_round_type), intent(in) :: x, y
end function ieee_round_ne
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
end interface operator(/=)
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
private :: ieee_class_eq, ieee_round_eq, ieee_class_ne, ieee_round_ne
! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
! generic G.
#define SPECIFICS_I(G) \
G(1) G(2) G(4) G(8) G(16)
#define SPECIFICS_L(G) \
G(1) G(2) G(4) G(8)
#define SPECIFICS_R(G) \
G(2) G(3) G(4) G(8) G(10) G(16)
#define SPECIFICS_II(G) \
G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \
G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
#define SPECIFICS_RI(G) \
G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \
G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
#define SPECIFICS_RR(G) \
G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \
G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \
G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \
G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \
G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \
G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16)
! Set PRIVATE accessibility for specifics with 1 or 2 INTEGER, LOGICAL, or REAL
! arguments for generic G.
#define PRIVATE_I(G) private :: \
G##_i1, G##_i2, G##_i4, G##_i8, G##_i16
#define PRIVATE_L(G) private :: \
G##_l1, G##_l2, G##_l4, G##_l8
#define PRIVATE_R(G) private :: \
G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16
#define PRIVATE_II(G) private :: \
G##_i1_i1, G##_i1_i2, G##_i1_i4, G##_i1_i8, G##_i1_i16, \
G##_i2_i1, G##_i2_i2, G##_i2_i4, G##_i2_i8, G##_i2_i16, \
G##_i4_i1, G##_i4_i2, G##_i4_i4, G##_i4_i8, G##_i4_i16, \
G##_i8_i1, G##_i8_i2, G##_i8_i4, G##_i8_i8, G##_i8_i16, \
G##_i16_i1, G##_i16_i2, G##_i16_i4, G##_i16_i8, G##_i16_i16
#define PRIVATE_RI(G) private :: \
G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \
G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \
G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \
G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \
G##_a10_i1, G##_a10_i2, G##_a10_i4, G##_a10_i8, G##_a10_i16, \
G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16
#define PRIVATE_RR(G) private :: \
G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a10, G##_a2_a16, \
G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a10, G##_a3_a16, \
G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a10, G##_a4_a16, \
G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a10, G##_a8_a16, \
G##_a10_a2, G##_a10_a3, G##_a10_a4, G##_a10_a8, G##_a10_a10, G##_a10_a16, \
G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a10, G##_a16_a16
#define IEEE_CLASS_R(XKIND) \
elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \
import ieee_class_type; \
real(XKIND), intent(in) :: x; \
end function ieee_class_a##XKIND;
interface ieee_class
SPECIFICS_R(IEEE_CLASS_R)
end interface ieee_class
PRIVATE_R(IEEE_CLASS)
#undef IEEE_CLASS_R
#define IEEE_COPY_SIGN_RR(XKIND, YKIND) \
elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \
real(XKIND), intent(in) :: x; \
real(YKIND), intent(in) :: y; \
end function ieee_copy_sign_a##XKIND##_a##YKIND;
interface ieee_copy_sign
SPECIFICS_RR(IEEE_COPY_SIGN_RR)
end interface ieee_copy_sign
PRIVATE_RR(IEEE_COPY_SIGN)
#undef IEEE_COPY_SIGN_RR
#define IEEE_FMA_R(AKIND) \
elemental real(AKIND) function ieee_fma_a##AKIND(a, b, c); \
real(AKIND), intent(in) :: a, b, c; \
end function ieee_fma_a##AKIND;
interface ieee_fma
SPECIFICS_R(IEEE_FMA_R)
end interface ieee_fma
PRIVATE_R(IEEE_FMA)
#undef IEEE_FMA_R
#define IEEE_GET_ROUNDING_MODE_I(RKIND) \
subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \
import ieee_round_type; \
type(ieee_round_type), intent(out) :: round_value; \
integer(RKIND), intent(in) :: radix; \
end subroutine ieee_get_rounding_mode_i##RKIND;
interface ieee_get_rounding_mode
subroutine ieee_get_rounding_mode(round_value)
import ieee_round_type
type(ieee_round_type), intent(out) :: round_value
end subroutine ieee_get_rounding_mode
SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)
end interface ieee_get_rounding_mode
PRIVATE_I(IEEE_GET_ROUNDING_MODE)
#undef IEEE_GET_ROUNDING_MODE_I
#define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \
subroutine ieee_get_underflow_mode_l##GKIND(gradual); \
logical(GKIND), intent(out) :: gradual; \
end subroutine ieee_get_underflow_mode_l##GKIND;
interface ieee_get_underflow_mode
SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L)
end interface ieee_get_underflow_mode
PRIVATE_L(IEEE_GET_UNDERFLOW_MODE)
#undef IEEE_GET_UNDERFLOW_MODE_L
! When kind argument is present, kind(result) is value(kind), not kind(kind).
! That is not known here, so return integer(16).
#define IEEE_INT_R(AKIND) \
elemental integer function ieee_int_a##AKIND(a, round); \
import ieee_round_type; \
real(AKIND), intent(in) :: a; \
type(ieee_round_type), intent(in) :: round; \
end function ieee_int_a##AKIND;
#define IEEE_INT_RI(AKIND, KKIND) \
elemental integer(16) function ieee_int_a##AKIND##_i##KKIND(a, round, kind); \
import ieee_round_type; \
real(AKIND), intent(in) :: a; \
type(ieee_round_type), intent(in) :: round; \
integer(KKIND), intent(in) :: kind; \
end function ieee_int_a##AKIND##_i##KKIND;
interface ieee_int
SPECIFICS_R(IEEE_INT_R)
SPECIFICS_RI(IEEE_INT_RI)
end interface ieee_int
PRIVATE_R(IEEE_INT)
PRIVATE_RI(IEEE_INT)
#undef IEEE_INT_R
#undef IEEE_INT_RI
#define IEEE_IS_FINITE_R(XKIND) \
elemental logical function ieee_is_finite_a##XKIND(x); \
real(XKIND), intent(in) :: x; \
end function ieee_is_finite_a##XKIND;
interface ieee_is_finite
SPECIFICS_R(IEEE_IS_FINITE_R)
end interface ieee_is_finite
PRIVATE_R(IEEE_IS_FINITE)
#undef IEEE_IS_FINITE_R
#define IEEE_LOGB_R(XKIND) \
elemental real(XKIND) function ieee_logb_a##XKIND(x); \
real(XKIND), intent(in) :: x; \
end function ieee_logb_a##XKIND;
interface ieee_logb
SPECIFICS_R(IEEE_LOGB_R)
end interface ieee_logb
PRIVATE_R(IEEE_LOGB)
#undef IEEE_LOGB_R
#define IEEE_MAX_NUM_R(XKIND) \
elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
end function ieee_max_num_a##XKIND;
interface ieee_max_num
SPECIFICS_R(IEEE_MAX_NUM_R)
end interface ieee_max_num
PRIVATE_R(IEEE_MAX_NUM)
#undef IEEE_MAX_NUM_R
#define IEEE_MAX_NUM_MAG_R(XKIND) \
elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
end function ieee_max_num_mag_a##XKIND;
interface ieee_max_num_mag
SPECIFICS_R(IEEE_MAX_NUM_MAG_R)
end interface ieee_max_num_mag
PRIVATE_R(IEEE_MAX_NUM_MAG)
#undef IEEE_MAX_NUM_MAG_R
#define IEEE_MIN_NUM_R(XKIND) \
elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
end function ieee_min_num_a##XKIND;
interface ieee_min_num
SPECIFICS_R(IEEE_MIN_NUM_R)
end interface ieee_min_num
PRIVATE_R(IEEE_MIN_NUM)
#undef IEEE_MIN_NUM_R
#define IEEE_MIN_NUM_MAG_R(XKIND) \
elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
end function ieee_min_num_mag_a##XKIND;
interface ieee_min_num_mag
SPECIFICS_R(IEEE_MIN_NUM_MAG_R)
end interface ieee_min_num_mag
PRIVATE_R(IEEE_MIN_NUM_MAG)
#undef IEEE_MIN_NUM_MAG_R
#define IEEE_QUIET_EQ_R(AKIND) \
elemental logical function ieee_quiet_eq_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_eq_a##AKIND;
interface ieee_quiet_eq
SPECIFICS_R(IEEE_QUIET_EQ_R)
end interface ieee_quiet_eq
PRIVATE_R(IEEE_QUIET_EQ)
#undef IEEE_QUIET_EQ_R
#define IEEE_QUIET_GE_R(AKIND) \
elemental logical function ieee_quiet_ge_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_ge_a##AKIND;
interface ieee_quiet_ge
SPECIFICS_R(IEEE_QUIET_GE_R)
end interface ieee_quiet_ge
PRIVATE_R(IEEE_QUIET_GE)
#undef IEEE_QUIET_GE_R
#define IEEE_QUIET_GT_R(AKIND) \
elemental logical function ieee_quiet_gt_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_gt_a##AKIND;
interface ieee_quiet_gt
SPECIFICS_R(IEEE_QUIET_GT_R)
end interface ieee_quiet_gt
PRIVATE_R(IEEE_QUIET_GT)
#undef IEEE_QUIET_GT_R
#define IEEE_QUIET_LE_R(AKIND) \
elemental logical function ieee_quiet_le_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_le_a##AKIND;
interface ieee_quiet_le
SPECIFICS_R(IEEE_QUIET_LE_R)
end interface ieee_quiet_le
PRIVATE_R(IEEE_QUIET_LE)
#undef IEEE_QUIET_LE_R
#define IEEE_QUIET_LT_R(AKIND) \
elemental logical function ieee_quiet_lt_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_lt_a##AKIND;
interface ieee_quiet_lt
SPECIFICS_R(IEEE_QUIET_LT_R)
end interface ieee_quiet_lt
PRIVATE_R(IEEE_QUIET_LT)
#undef IEEE_QUIET_LT_R
#define IEEE_QUIET_NE_R(AKIND) \
elemental logical function ieee_quiet_ne_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_quiet_ne_a##AKIND;
interface ieee_quiet_ne
SPECIFICS_R(IEEE_QUIET_NE_R)
end interface ieee_quiet_ne
PRIVATE_R(IEEE_QUIET_NE)
#undef IEEE_QUIET_NE_R
! When kind argument is present, kind(result) is value(kind), not kind(kind).
! That is not known here, so return real(16).
#define IEEE_REAL_I(AKIND) \
elemental real function ieee_real_i##AKIND(a); \
integer(AKIND), intent(in) :: a; \
end function ieee_real_i##AKIND;
#define IEEE_REAL_R(AKIND) \
elemental real function ieee_real_a##AKIND(a); \
real(AKIND), intent(in) :: a; \
end function ieee_real_a##AKIND;
#define IEEE_REAL_II(AKIND, KKIND) \
elemental real(16) function ieee_real_i##AKIND##_i##KKIND(a, kind); \
integer(AKIND), intent(in) :: a; \
integer(KKIND), intent(in) :: kind; \
end function ieee_real_i##AKIND##_i##KKIND;
#define IEEE_REAL_RI(AKIND, KKIND) \
elemental real(16) function ieee_real_a##AKIND##_i##KKIND(a, kind); \
real(AKIND), intent(in) :: a; \
integer(KKIND), intent(in) :: kind; \
end function ieee_real_a##AKIND##_i##KKIND;
interface ieee_real
SPECIFICS_I(IEEE_REAL_I)
SPECIFICS_R(IEEE_REAL_R)
SPECIFICS_II(IEEE_REAL_II)
SPECIFICS_RI(IEEE_REAL_RI)
end interface ieee_real
PRIVATE_I(IEEE_REAL)
PRIVATE_R(IEEE_REAL)
PRIVATE_II(IEEE_REAL)
PRIVATE_RI(IEEE_REAL)
#undef IEEE_REAL_I
#undef IEEE_REAL_R
#undef IEEE_REAL_II
#undef IEEE_REAL_RI
#define IEEE_REM_RR(XKIND, YKIND) \
elemental real(XKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \
real(XKIND), intent(in) :: x; \
real(YKIND), intent(in) :: y; \
end function ieee_rem_a##XKIND##_a##YKIND;
interface ieee_rem
SPECIFICS_RR(IEEE_REM_RR)
end interface ieee_rem
PRIVATE_RR(IEEE_REM)
#undef IEEE_REM_RR
#define IEEE_RINT_R(XKIND) \
elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \
import ieee_round_type; \
real(XKIND), intent(in) :: x; \
type(ieee_round_type), optional, intent(in) :: round; \
end function ieee_rint_a##XKIND;
interface ieee_rint
SPECIFICS_R(IEEE_RINT_R)
end interface ieee_rint
PRIVATE_R(IEEE_RINT)
#undef IEEE_RINT_R
#define IEEE_SET_ROUNDING_MODE_I(RKIND) \
subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \
import ieee_round_type; \
type(ieee_round_type), intent(in) :: round_value; \
integer(RKIND), intent(in) :: radix; \
end subroutine ieee_set_rounding_mode_i##RKIND;
interface ieee_set_rounding_mode
subroutine ieee_set_rounding_mode(round_value)
import ieee_round_type
type(ieee_round_type), intent(in) :: round_value
end subroutine ieee_set_rounding_mode
SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)
end interface ieee_set_rounding_mode
PRIVATE_I(IEEE_SET_ROUNDING_MODE)
#undef IEEE_SET_ROUNDING_MODE_I
#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \
subroutine ieee_set_underflow_mode_l##GKIND(gradual); \
logical(GKIND), intent(in) :: gradual; \
end subroutine ieee_set_underflow_mode_l##GKIND;
interface ieee_set_underflow_mode
SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L)
end interface ieee_set_underflow_mode
PRIVATE_L(IEEE_SET_UNDERFLOW_MODE)
#undef IEEE_SET_UNDERFLOW_MODE_L
#define IEEE_SIGNALING_EQ_R(AKIND) \
elemental logical function ieee_signaling_eq_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_eq_a##AKIND;
interface ieee_signaling_eq
SPECIFICS_R(IEEE_SIGNALING_EQ_R)
end interface ieee_signaling_eq
PRIVATE_R(IEEE_SIGNALING_EQ)
#undef IEEE_SIGNALING_EQ_R
#define IEEE_SIGNALING_GE_R(AKIND) \
elemental logical function ieee_signaling_ge_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_ge_a##AKIND;
interface ieee_signaling_ge
SPECIFICS_R(IEEE_SIGNALING_GE_R)
end interface ieee_signaling_ge
PRIVATE_R(IEEE_SIGNALING_GE)
#undef IEEE_SIGNALING_GE_R
#define IEEE_SIGNALING_GT_R(AKIND) \
elemental logical function ieee_signaling_gt_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_gt_a##AKIND;
interface ieee_signaling_gt
SPECIFICS_R(IEEE_SIGNALING_GT_R)
end interface ieee_signaling_gt
PRIVATE_R(IEEE_SIGNALING_GT)
#undef IEEE_SIGNALING_GT_R
#define IEEE_SIGNALING_LE_R(AKIND) \
elemental logical function ieee_signaling_le_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_le_a##AKIND;
interface ieee_signaling_le
SPECIFICS_R(IEEE_SIGNALING_LE_R)
end interface ieee_signaling_le
PRIVATE_R(IEEE_SIGNALING_LE)
#undef IEEE_SIGNALING_LE_R
#define IEEE_SIGNALING_LT_R(AKIND) \
elemental logical function ieee_signaling_lt_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_lt_a##AKIND;
interface ieee_signaling_lt
SPECIFICS_R(IEEE_SIGNALING_LT_R)
end interface ieee_signaling_lt
PRIVATE_R(IEEE_SIGNALING_LT)
#undef IEEE_SIGNALING_LT_R
#define IEEE_SIGNALING_NE_R(AKIND) \
elemental logical function ieee_signaling_ne_a##AKIND(a, b); \
real(AKIND), intent(in) :: a, b; \
end function ieee_signaling_ne_a##AKIND;
interface ieee_signaling_ne
SPECIFICS_R(IEEE_SIGNALING_NE_R)
end interface ieee_signaling_ne
PRIVATE_R(IEEE_SIGNALING_NE)
#undef IEEE_SIGNALING_NE_R
#define IEEE_SIGNBIT_R(XKIND) \
elemental logical function ieee_signbit_a##XKIND(x); \
real(XKIND), intent(in) :: x; \
end function ieee_signbit_a##XKIND;
interface ieee_signbit
SPECIFICS_R(IEEE_SIGNBIT_R)
end interface ieee_signbit
PRIVATE_R(IEEE_SIGNBIT)
#undef IEEE_SIGNBIT_R
#define IEEE_SUPPORT_ROUNDING_R(XKIND) \
pure logical function ieee_support_rounding_a##XKIND(round_value, x); \
import ieee_round_type; \
type(ieee_round_type), intent(in) :: round_value; \
real(XKIND), intent(in) :: x(..); \
end function ieee_support_rounding_a##XKIND;
interface ieee_support_rounding
[flang] Increase support for intrinsic module procedures * Make Semantics test doconcurrent01.f90 an expected failure pending a fix for a problem in recognizing a PURE prefix specifier for a specific procedure that occurs in new intrinsic module source code, * review update * review update * Increase support for intrinsic module procedures The f18 standard defines 5 intrinsic modules that define varying numbers of procedures, including several operators: 2 iso_fortran_env 55 ieee_arithmetic 10 ieee_exceptions 0 ieee_features 6 iso_c_binding There are existing fortran source files for each of these intrinsic modules. This PR adds generic procedure declarations to these files for procedures that do not already have them, together with associated specific procedure declarations. It also adds the capability of recognizing intrinsic module procedures in lowering code, making it possible to use existing language intrinsic code generation for intrinsic module procedures for both scalar and elemental calls. Code can then be generated for intrinsic module procedures using existing options, including front end folding, direct inlining, and calls to runtime support routines. Detailed code generation is provided for several procedures in this PR, with others left to future PRs. Procedure calls that reach lowering and don't have detailed implementation support will generate a "not yet implemented" message with a recognizable name. The generic procedures in these modules may each have as many as 36 specific procedures. Most specific procedures are generated via macros that generate type specific interface declarations. These specific declarations provide detailed argument information for each individual procedure call, similar to what is done via other means for standard language intrinsics. The modules only provide interface declarations. There are no procedure definitions, again in keeping with how language intrinsics are processed. This patch is part of the upstreaming effort from fir-dev branch. Reviewed By: jeanPerier, PeteSteinfeld Differential Revision: https://reviews.llvm.org/D128431 Co-authored-by: V Donaldson <vdonaldson@nvidia.com>
2022-06-24 00:03:06 +08:00
logical function ieee_support_rounding(round_value)
[flang] Update intrinsic module source files The f18 standard defines several intrinsic modules containing definitions and declarations for various constants, types, and procedures. This PR adds declarations for missing procedures in these modules.
2022-05-26 06:32:02 +08:00
import ieee_round_type
type(ieee_round_type), intent(in) :: round_value
end function ieee_support_rounding
SPECIFICS_R(IEEE_SUPPORT_ROUNDING_R)
end interface ieee_support_rounding
PRIVATE_R(IEEE_SUPPORT_ROUNDING)
#undef IEEE_SUPPORT_ROUNDING_R
#define IEEE_UNORDERED_RR(XKIND, YKIND) \
elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \
real(XKIND), intent(in) :: x; \
real(YKIND), intent(in) :: y; \
end function ieee_unordered_a##XKIND##_a##YKIND;
interface ieee_unordered
SPECIFICS_RR(IEEE_UNORDERED_RR)
end interface ieee_unordered
PRIVATE_RR(IEEE_UNORDERED)
#undef IEEE_UNORDERED_RR
#define IEEE_VALUE_R(XKIND) \
elemental real(XKIND) function ieee_value_a##XKIND(x, class); \
import ieee_class_type; \
real(XKIND), intent(in) :: x; \
type(ieee_class_type), intent(in) :: class; \
end function ieee_value_a##XKIND;
interface ieee_value
SPECIFICS_R(IEEE_VALUE_R)
end interface ieee_value
PRIVATE_R(IEEE_VALUE)
#undef IEEE_VALUE_R
[flang] Implement IEEE_SUPPORT_xxx inquiry functions Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic functions from the intrinsic module IEEE_ARITHMETIC, folding all of their results to .TRUE. Differential Revision: https://reviews.llvm.org/D95830
2021-02-02 07:23:58 +08:00
[flang] Placeholders for some standard modules Original-commit: flang-compiler/f18@a7182af0d5a6c66faab45977554c1074a3fb9d7f Reviewed-on: https://github.com/flang-compiler/f18/pull/477 Tree-same-pre-rewrite: false
2019-06-01 07:35:52 +08:00
end module ieee_arithmetic