vasilito
cb424d7448
verify-patch-sanity.py validates every active recipe .patch has internally- consistent hunk line counts — catching the 'malformed patch at line N' failure at commit/CI/preflight time instead of hours into a cook. This cycle hit that class three times (qtwaylandscanner, sddm, xwayland), each only discovered when cookbook tried to apply the patch. Running it across the repo found 29 latent malformed patches (validated against GNU patch: e.g. relibc/P3-sysv-ipc reproduces 'malformed patch at line 22'). They were harmless only because they sit in vendored recipes (baked, not re- applied) — but would fail on any version-bump re-derivation. --fix recounts the hunk headers (body untouched) and repaired all 29. Wired into build-preflight.sh (Phase 1.0D) and redbear-ci.yml, with a unit test (test-patch-sanity.sh). Skips archived/legacy trees and unvalidatable formats (empty placeholders, bare-@@ git hunks).
643 lines
21 KiB
Fortran
643 lines
21 KiB
Fortran
!===-- module/ieee_arithmetic.f90 ------------------------------------------===!
|
|
!
|
|
! 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
|
|
!
|
|
!===------------------------------------------------------------------------===!
|
|
|
|
! Fortran 2018 Clause 17
|
|
|
|
#include '../include/flang/Runtime/magic-numbers.h'
|
|
|
|
module ieee_arithmetic
|
|
! F18 Clause 17.1p1:
|
|
! 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
|
|
|
|
use __fortran_builtins, only: &
|
|
ieee_away => __builtin_ieee_away, &
|
|
ieee_down => __builtin_ieee_down, &
|
|
ieee_fma => __builtin_fma, &
|
|
ieee_int => __builtin_ieee_int, &
|
|
ieee_is_nan => __builtin_ieee_is_nan, &
|
|
ieee_is_negative => __builtin_ieee_is_negative, &
|
|
ieee_is_normal => __builtin_ieee_is_normal, &
|
|
ieee_nearest => __builtin_ieee_nearest, &
|
|
ieee_next_after => __builtin_ieee_next_after, &
|
|
ieee_next_down => __builtin_ieee_next_down, &
|
|
ieee_next_up => __builtin_ieee_next_up, &
|
|
ieee_other => __builtin_ieee_other, &
|
|
ieee_real => __builtin_ieee_real, &
|
|
ieee_round_type => __builtin_ieee_round_type, &
|
|
ieee_scalb => scale, &
|
|
ieee_selected_real_kind => __builtin_ieee_selected_real_kind, &
|
|
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_rounding => __builtin_ieee_support_rounding, &
|
|
ieee_support_sqrt => __builtin_ieee_support_sqrt, &
|
|
ieee_support_standard => __builtin_ieee_support_standard, &
|
|
ieee_support_subnormal => __builtin_ieee_support_subnormal, &
|
|
ieee_support_underflow_control => __builtin_ieee_support_underflow_control, &
|
|
ieee_to_zero => __builtin_ieee_to_zero, &
|
|
ieee_up => __builtin_ieee_up
|
|
|
|
|
|
implicit none
|
|
|
|
! Set PRIVATE by default to explicitly only export what is meant
|
|
! to be exported by this MODULE.
|
|
private
|
|
|
|
! Explicitly export the symbols from __fortran_builtins
|
|
public :: ieee_away
|
|
public :: ieee_down
|
|
public :: ieee_fma
|
|
public :: ieee_int
|
|
public :: ieee_is_nan
|
|
public :: ieee_is_negative
|
|
public :: ieee_is_normal
|
|
public :: ieee_nearest
|
|
public :: ieee_other
|
|
public :: ieee_next_after
|
|
public :: ieee_next_down
|
|
public :: ieee_next_up
|
|
public :: ieee_real
|
|
public :: ieee_round_type
|
|
public :: ieee_scalb
|
|
public :: ieee_selected_real_kind
|
|
public :: ieee_support_datatype
|
|
public :: ieee_support_denormal
|
|
public :: ieee_support_divide
|
|
public :: ieee_support_inf
|
|
public :: ieee_support_io
|
|
public :: ieee_support_nan
|
|
public :: ieee_support_rounding
|
|
public :: ieee_support_sqrt
|
|
public :: ieee_support_standard
|
|
public :: ieee_support_subnormal
|
|
public :: ieee_support_underflow_control
|
|
public :: ieee_to_zero
|
|
public :: ieee_up
|
|
|
|
! Explicitly export the symbols from __fortran_ieee_exceptions
|
|
public :: ieee_flag_type
|
|
public :: ieee_invalid
|
|
public :: ieee_overflow
|
|
public :: ieee_divide_by_zero
|
|
public :: ieee_underflow
|
|
public :: ieee_inexact
|
|
public :: ieee_denorm
|
|
public :: ieee_usual
|
|
public :: ieee_all
|
|
public :: ieee_modes_type
|
|
public :: ieee_status_type
|
|
public :: ieee_get_flag
|
|
public :: ieee_get_halting_mode
|
|
public :: ieee_get_modes
|
|
public :: ieee_get_status
|
|
public :: ieee_set_flag
|
|
public :: ieee_set_halting_mode
|
|
public :: ieee_set_modes
|
|
public :: ieee_set_status
|
|
public :: ieee_support_flag
|
|
public :: ieee_support_halting
|
|
|
|
type, public :: ieee_class_type
|
|
private
|
|
integer(kind=1) :: which = 0
|
|
end type ieee_class_type
|
|
|
|
type(ieee_class_type), parameter, public :: &
|
|
ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &
|
|
ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &
|
|
ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &
|
|
ieee_negative_normal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &
|
|
ieee_negative_subnormal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &
|
|
ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &
|
|
ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &
|
|
ieee_positive_subnormal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &
|
|
ieee_positive_normal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &
|
|
ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &
|
|
ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)
|
|
|
|
type(ieee_class_type), parameter, public :: &
|
|
ieee_negative_denormal = ieee_negative_subnormal, &
|
|
ieee_positive_denormal = ieee_positive_subnormal
|
|
|
|
interface operator(==)
|
|
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
|
|
end interface operator(==)
|
|
public :: operator(==)
|
|
|
|
interface operator(/=)
|
|
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
|
|
end interface operator(/=)
|
|
public :: operator(/=)
|
|
|
|
! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
|
|
! generic G.
|
|
!
|
|
! The result type of most function specifics is either a fixed type or
|
|
! the type of the first argument. The result type of a SPECIFICS_rRR
|
|
! function call is the highest precision argument type.
|
|
|
|
#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)
|
|
|
|
#if FLANG_SUPPORT_R16
|
|
#if __x86_64__
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8) G(10) G(16)
|
|
#else
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8) G(16)
|
|
#endif
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8) G(10)
|
|
#else
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8)
|
|
#endif
|
|
#endif
|
|
|
|
#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)
|
|
|
|
#if FLANG_SUPPORT_R16
|
|
#if __x86_64__
|
|
#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)
|
|
#else
|
|
#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(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
|
|
#endif
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_RI(G) \
|
|
G(2,1) G(2,2) G(2,4) G(2,8) \
|
|
G(3,1) G(3,2) G(3,4) G(3,8) \
|
|
G(4,1) G(4,2) G(4,4) G(4,8) \
|
|
G(8,1) G(8,2) G(8,4) G(8,8) \
|
|
G(10,1) G(10,2) G(10,4) G(10,8)
|
|
#else
|
|
#define SPECIFICS_RI(G) \
|
|
G(2,1) G(2,2) G(2,4) G(2,8) \
|
|
G(3,1) G(3,2) G(3,4) G(3,8) \
|
|
G(4,1) G(4,2) G(4,4) G(4,8) \
|
|
G(8,1) G(8,2) G(8,4) G(8,8)
|
|
#endif
|
|
#endif
|
|
|
|
#if FLANG_SUPPORT_R16
|
|
#if __x86_64__
|
|
#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)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) G(16,2,16) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) G(16,3,16) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) G(16,4,16) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) G(16,8,16) \
|
|
G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10) G(16,10,16) \
|
|
G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,10) G(16,16,16)
|
|
#else
|
|
#define SPECIFICS_RR(G) \
|
|
G(2,2) G(2,3) G(2,4) G(2,8) G(2,16) \
|
|
G(3,2) G(3,3) G(3,4) G(3,8) G(3,16) \
|
|
G(4,2) G(4,3) G(4,4) G(4,8) G(4,16) \
|
|
G(8,2) G(8,3) G(8,4) G(8,8) G(8,16) \
|
|
G(16,2) G(16,3) G(16,4) G(16,8) G(16,16)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(16,2,16) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(16,3,16) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(16,4,16) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(16,8,16) \
|
|
G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,16)
|
|
#endif
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_RR(G) \
|
|
G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) \
|
|
G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) \
|
|
G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) \
|
|
G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) \
|
|
G(10,2) G(10,3) G(10,4) G(10,8) G(10,10)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) \
|
|
G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10)
|
|
#else
|
|
#define SPECIFICS_RR(G) \
|
|
G(2,2) G(2,3) G(2,4) G(2,8) \
|
|
G(3,2) G(3,3) G(3,4) G(3,8) \
|
|
G(4,2) G(4,3) G(4,4) G(4,8) \
|
|
G(8,2) G(8,3) G(8,4) G(8,8)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8)
|
|
#endif
|
|
#endif
|
|
|
|
#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
|
|
public :: 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
|
|
public :: ieee_copy_sign
|
|
#undef IEEE_COPY_SIGN_RR
|
|
|
|
#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_0(round_value)
|
|
import ieee_round_type
|
|
type(ieee_round_type), intent(out) :: round_value
|
|
end subroutine ieee_get_rounding_mode_0
|
|
SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)
|
|
end interface ieee_get_rounding_mode
|
|
public :: 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
|
|
public :: ieee_get_underflow_mode
|
|
#undef IEEE_GET_UNDERFLOW_MODE_L
|
|
|
|
#define IEEE_IS_FINITE_R(XKIND) \
|
|
elemental logical function ieee_is_finite_a##XKIND(x); \
|
|
real(XKIND), intent(in) :: x; \
|
|
!dir$ ignore_tkr(d) x; \
|
|
end function ieee_is_finite_a##XKIND;
|
|
interface ieee_is_finite
|
|
SPECIFICS_R(IEEE_IS_FINITE_R)
|
|
end interface ieee_is_finite
|
|
public :: 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
|
|
public :: ieee_logb
|
|
#undef IEEE_LOGB_R
|
|
|
|
#define IEEE_MAX_R(XKIND) \
|
|
elemental real(XKIND) function ieee_max_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_max_a##XKIND;
|
|
interface ieee_max
|
|
SPECIFICS_R(IEEE_MAX_R)
|
|
end interface ieee_max
|
|
public :: ieee_max
|
|
#undef IEEE_MAX_R
|
|
|
|
#define IEEE_MAX_MAG_R(XKIND) \
|
|
elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_max_mag_a##XKIND;
|
|
interface ieee_max_mag
|
|
SPECIFICS_R(IEEE_MAX_MAG_R)
|
|
end interface ieee_max_mag
|
|
public :: ieee_max_mag
|
|
#undef IEEE_MAX_MAG_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
|
|
public :: 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
|
|
public :: ieee_max_num_mag
|
|
#undef IEEE_MAX_NUM_MAG_R
|
|
|
|
#define IEEE_MIN_R(XKIND) \
|
|
elemental real(XKIND) function ieee_min_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_min_a##XKIND;
|
|
interface ieee_min
|
|
SPECIFICS_R(IEEE_MIN_R)
|
|
end interface ieee_min
|
|
public :: ieee_min
|
|
#undef IEEE_MIN_R
|
|
|
|
#define IEEE_MIN_MAG_R(XKIND) \
|
|
elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_min_mag_a##XKIND;
|
|
interface ieee_min_mag
|
|
SPECIFICS_R(IEEE_MIN_MAG_R)
|
|
end interface ieee_min_mag
|
|
public :: ieee_min_mag
|
|
#undef IEEE_MIN_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
|
|
public :: 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
|
|
public ::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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: ieee_quiet_ne
|
|
#undef IEEE_QUIET_NE_R
|
|
|
|
#define IEEE_REM_rRR(RKIND, XKIND, YKIND) \
|
|
elemental real(RKIND) 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_rRR(IEEE_REM_rRR)
|
|
end interface ieee_rem
|
|
public :: ieee_rem
|
|
#undef IEEE_REM_rRR
|
|
|
|
#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
|
|
public :: 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_0(round_value)
|
|
import ieee_round_type
|
|
type(ieee_round_type), intent(in) :: round_value
|
|
end subroutine ieee_set_rounding_mode_0
|
|
SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)
|
|
end interface ieee_set_rounding_mode
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: ieee_signbit
|
|
#undef IEEE_SIGNBIT_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
|
|
public :: 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
|
|
public :: ieee_value
|
|
#undef IEEE_VALUE_R
|
|
|
|
end module ieee_arithmetic
|