[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

diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
new file mode 100644 (file)
index 0000000..ba4587b
--- /dev/null
+++ b/flang/module/ieee_arithmetic.f90
@@ -0,0 +1,190 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! 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
+  private :: getSignBit
+
+ 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 :: nzSignificand, quiet; \
+    raw = transfer(x, raw); \
+    exponent = ibits(raw, significand, exponentBits); \
+    nzSignificand = ibits(raw, 0, significand) /= 0; \
+    quiet = btest(raw, significand - 1); \
+    ieee_class_a##RKIND = classify(exponent, maxExpo, 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

diff --git a/flang/module/ieee_exceptions.f90 b/flang/module/ieee_exceptions.f90
new file mode 100644 (file)
index 0000000..bc9da86
--- /dev/null
+++ b/flang/module/ieee_exceptions.f90
@@ -0,0 +1,63 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! See Fortran 2018, clause 17
+module ieee_exceptions
+
+  type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3
+    private
+    integer(kind=1) :: flag = 0
+  end type ieee_flag_type
+
+  type(ieee_flag_type), parameter :: &
+    ieee_invalid = ieee_flag_type(1), &
+    ieee_overflow = ieee_flag_type(2), &
+    ieee_divide_by_zero = ieee_flag_type(4), &
+    ieee_underflow = ieee_flag_type(8), &
+    ieee_inexact = ieee_flag_type(16)
+
+  type(ieee_flag_type), parameter :: &
+    ieee_usual(:) = [ &
+      ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
+    ieee_all(:) = [ &
+      ieee_usual, ieee_underflow, ieee_inexact ]
+
+  type :: ieee_modes_type ! Fortran 2018, 17.7
+    private
+  end type ieee_modes_type
+
+  type :: ieee_status_type ! Fortran 2018, 17.7
+    private
+  end type ieee_status_type
+
+ contains
+  subroutine ieee_get_modes(modes)
+    type(ieee_modes_type), intent(out) :: modes
+  end subroutine ieee_get_modes
+
+  subroutine ieee_set_modes(modes)
+    type(ieee_modes_type), intent(in) :: modes
+  end subroutine ieee_set_modes
+
+  subroutine ieee_get_status(status)
+    type(ieee_status_type), intent(out) :: status
+  end subroutine ieee_get_status
+
+  subroutine ieee_set_status(status)
+    type(ieee_status_type), intent(in) :: status
+  end subroutine ieee_set_status
+
+  ! TODO: other interfaces (see Table 17.3)
+
+end module ieee_exceptions

diff --git a/flang/module/ieee_features.f90 b/flang/module/ieee_features.f90
new file mode 100644 (file)
index 0000000..06262c3
--- /dev/null
+++ b/flang/module/ieee_features.f90
@@ -0,0 +1,38 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! See Fortran 2018, clause 17.2
+
+module ieee_features
+
+  type :: ieee_features_type
+    private
+    integer(kind=1) :: feature = 0
+  end type ieee_features_type
+
+  type(ieee_features_type), parameter :: &
+    ieee_datatype = ieee_features_type(1), &
+    ieee_denormal = ieee_features_type(2), &
+    ieee_divide = ieee_features_type(3), &
+    ieee_halting = ieee_features_type(4), &
+    ieee_inexact_flag = ieee_features_type(5), &
+    ieee_inf = ieee_features_type(6), &
+    ieee_invalid_flag = ieee_features_type(7), &
+    ieee_nan = ieee_features_type(8), &
+    ieee_rounding = ieee_features_type(9), &
+    ieee_sqrt = ieee_features_type(10), &
+    ieee_subnormal = ieee_features_type(11), &
+    ieee_underflow_flag = ieee_features_type(12)
+
+end module ieee_features

diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
new file mode 100644 (file)
index 0000000..479ddcb
--- /dev/null
+++ b/flang/module/iso_c_binding.f90
@@ -0,0 +1,104 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! See Fortran 2018, clause 18.2
+
+module iso_c_binding
+
+  type :: c_ptr
+    integer(kind=8) :: address
+  end type c_ptr
+
+  type :: c_funptr
+    integer(kind=8) :: address
+  end type c_funptr
+
+  type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
+  type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
+
+  ! Table 18.2 (in clause 18.3.1)
+  ! TODO: Specialize (via macros?) for alternative targets
+  integer, parameter :: &
+    c_int8_t = 1, &
+    c_int16_t = 2, &
+    c_int32_t = 4, &
+    c_int64_t = 8, &
+    c_int128_t = 16 ! anticipating future addition
+  integer, parameter :: &
+    c_int = c_int32_t, &
+    c_short = c_int16_t, &
+    c_long = c_int64_t, &
+    c_long_long = c_int64_t, &
+    c_signed_char = c_int8_t, &
+    c_size_t = c_long_long, &
+    c_intmax_t = c_int128_t, &
+    c_intptr_t = c_size_t, &
+    c_ptrdiff_t = c_size_t
+  integer, parameter :: &
+    c_int_least8_t = c_int8_t, &
+    c_int_fast8_t = c_int8_t, &
+    c_int_least16_t = c_int16_t, &
+    c_int_fast16_t = c_int16_t, &
+    c_int_least32_t = c_int32_t, &
+    c_int_fast32_t = c_int32_t, &
+    c_int_least64_t = c_int64_t, &
+    c_int_fast64_t = c_int64_t, &
+    c_int_least128_t = c_int128_t, &
+    c_int_fast128_t = c_int128_t
+
+  integer, parameter :: &
+    c_float = 4, &
+    c_double = 8, &
+#if __x86_64__
+    c_long_double = 10
+#else
+    c_long_double = 16
+#endif
+
+  integer, parameter :: &
+    c_float_complex = c_float, &
+    c_double_complex = c_double, &
+    c_long_double_complex = c_long_double
+
+  integer, parameter :: c_bool = 1 ! TODO: or default LOGICAL?
+  integer, parameter :: c_char = 1 ! TODO: Kanji mode
+
+ contains
+
+  logical function c_associated(c_ptr_1, c_ptr_2)
+    type(c_ptr), intent(in) :: c_ptr_1
+    type(c_ptr), intent(in), optional :: c_ptr_2
+    if (c_ptr_1%address == c_null_ptr%address) then
+      c_associated = .false.
+    else if (present(c_ptr_2)) then
+      c_associated = c_ptr_1%address == c_ptr_2%address
+    else
+      c_associated = .true.
+    end if
+  end function c_associated
+
+  subroutine c_f_pointer(cptr, fptr, shape)
+    type(c_ptr), intent(in) :: cptr
+    type(*), pointer, dimension(..), intent(out) :: fptr
+    ! TODO: Use a larger kind for shape than default integer
+    integer, intent(in), optional :: shape(:) ! size(shape) == rank(fptr)
+    ! TODO: Define, or write in C and change this to an interface
+  end subroutine c_f_pointer
+
+  ! TODO c_f_procpointer
+  ! TODO c_funcloc
+  ! TODO c_loc
+  ! TODO c_sizeof
+
+end module iso_c_binding