mirror of
https://github.com/capstone-engine/llvm-capstone.git
synced 2024-12-03 19:32:35 +00:00
9e7548ab31
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@add6cde724 Reviewed-on: https://github.com/flang-compiler/f18/pull/887
185 lines
5.7 KiB
Fortran
185 lines
5.7 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
|
|
!
|
|
!------------------------------------------------------------------------------!
|
|
|
|
! See Fortran 2018, clause 17.2
|
|
module ieee_arithmetic
|
|
|
|
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(==)
|
|
module procedure class_eq
|
|
module procedure round_eq
|
|
end interface operator(==)
|
|
interface operator(/=)
|
|
module procedure class_ne
|
|
module procedure round_ne
|
|
end interface operator(/=)
|
|
|
|
! See Fortran 2018, 17.10 & 17.11
|
|
interface ieee_class
|
|
module procedure ieee_class_a2
|
|
module procedure ieee_class_a3
|
|
module procedure ieee_class_a4
|
|
module procedure ieee_class_a8
|
|
module procedure ieee_class_a10
|
|
module procedure ieee_class_a16
|
|
end interface ieee_class
|
|
|
|
interface ieee_copy_sign
|
|
module procedure ieee_copy_sign_a2
|
|
module procedure ieee_copy_sign_a3
|
|
module procedure ieee_copy_sign_a4
|
|
module procedure ieee_copy_sign_a8
|
|
module procedure ieee_copy_sign_a10
|
|
module procedure ieee_copy_sign_a16
|
|
end interface ieee_copy_sign
|
|
|
|
! TODO: more interfaces (_fma, &c.)
|
|
|
|
private :: classify
|
|
|
|
contains
|
|
|
|
elemental logical function class_eq(x,y)
|
|
type(ieee_class_type), intent(in) :: x, y
|
|
class_eq = x%which == y%which
|
|
end function class_eq
|
|
|
|
elemental logical function class_ne(x,y)
|
|
type(ieee_class_type), intent(in) :: x, y
|
|
class_ne = x%which /= y%which
|
|
end function class_ne
|
|
|
|
elemental logical function round_eq(x,y)
|
|
type(ieee_round_type), intent(in) :: x, y
|
|
round_eq = x%mode == y%mode
|
|
end function round_eq
|
|
|
|
elemental logical function round_ne(x,y)
|
|
type(ieee_round_type), intent(in) :: x, y
|
|
round_ne = x%mode /= y%mode
|
|
end function round_ne
|
|
|
|
elemental type(ieee_class_type) function classify( &
|
|
expo,maxExpo,negative,significandNZ,quietBit)
|
|
integer, intent(in) :: expo, maxExpo
|
|
logical, intent(in) :: negative, significandNZ, quietBit
|
|
if (expo == 0) then
|
|
if (significandNZ) then
|
|
if (negative) then
|
|
classify = ieee_negative_denormal
|
|
else
|
|
classify = ieee_positive_denormal
|
|
end if
|
|
else
|
|
if (negative) then
|
|
classify = ieee_negative_zero
|
|
else
|
|
classify = ieee_positive_zero
|
|
end if
|
|
end if
|
|
else if (expo == maxExpo) then
|
|
if (significandNZ) then
|
|
if (quietBit) then
|
|
classify = ieee_quiet_nan
|
|
else
|
|
classify = ieee_signaling_nan
|
|
end if
|
|
else
|
|
if (negative) then
|
|
classify = ieee_negative_inf
|
|
else
|
|
classify = ieee_positive_inf
|
|
end if
|
|
end if
|
|
else
|
|
if (negative) then
|
|
classify = ieee_negative_normal
|
|
else
|
|
classify = ieee_positive_normal
|
|
end if
|
|
end if
|
|
end function classify
|
|
|
|
#define _CLASSIFY(RKIND,IKIND,TOTALBITS,PREC,IMPLICIT) \
|
|
type(ieee_class_type) elemental function ieee_class_a##RKIND(x); \
|
|
real(kind=RKIND), intent(in) :: x; \
|
|
integer(kind=IKIND) :: raw; \
|
|
integer, parameter :: significand = PREC - IMPLICIT; \
|
|
integer, parameter :: exponentBits = TOTALBITS - 1 - significand; \
|
|
integer, parameter :: maxExpo = shiftl(1, exponentBits) - 1; \
|
|
integer :: exponent, sign; \
|
|
logical :: negative, nzSignificand, quiet; \
|
|
raw = transfer(x, raw); \
|
|
exponent = ibits(raw, significand, exponentBits); \
|
|
negative = btest(raw, TOTALBITS - 1); \
|
|
nzSignificand = ibits(raw, 0, significand) /= 0; \
|
|
quiet = btest(raw, significand - 1); \
|
|
ieee_class_a##RKIND = classify(exponent, maxExpo, negative, nzSignificand, quiet); \
|
|
end function ieee_class_a##RKIND
|
|
_CLASSIFY(2,2,16,11,1)
|
|
_CLASSIFY(3,2,16,8,1)
|
|
_CLASSIFY(4,4,32,24,1)
|
|
_CLASSIFY(8,8,64,53,1)
|
|
_CLASSIFY(10,16,80,64,0)
|
|
_CLASSIFY(16,16,128,112,1)
|
|
#undef _CLASSIFY
|
|
|
|
! TODO: This might need to be an actual Operation instead
|
|
#define _COPYSIGN(RKIND,IKIND,BITS) \
|
|
real(kind=RKIND) elemental function ieee_copy_sign_a##RKIND(x,y); \
|
|
real(kind=RKIND), intent(in) :: x, y; \
|
|
integer(kind=IKIND) :: xbits, ybits; \
|
|
xbits = transfer(x, xbits); \
|
|
ybits = transfer(y, ybits); \
|
|
xbits = ior(ibclr(xbits, BITS-1), iand(ybits, shiftl(1_##IKIND, BITS-1))); \
|
|
ieee_copy_sign_a##RKIND = transfer(xbits, x); \
|
|
end function ieee_copy_sign_a##RKIND
|
|
_COPYSIGN(2,2,16)
|
|
_COPYSIGN(3,2,16)
|
|
_COPYSIGN(4,4,32)
|
|
_COPYSIGN(8,8,64)
|
|
_COPYSIGN(10,16,80)
|
|
_COPYSIGN(16,16,128)
|
|
#undef _COPYSIGN
|
|
|
|
end module ieee_arithmetic
|