f674ddc19f
Canonicalize !$CUF KERNEL DO loop nests, similar to OpenACC/OpenMP canonicalization. Check statements and expressions in device contexts for usage that isn't supported. Add more tests, and include some tweaks to standard modules needed to build CUDA Fortran modules. Depends on https://reviews.llvm.org/D150159, https://reviews.llvm.org/D150161, https://reviews.llvm.org/D150162, & https://reviews.llvm.org/D150163. Differential Revision: https://reviews.llvm.org/D150164
135 lines
4.2 KiB
Fortran
135 lines
4.2 KiB
Fortran
!===-- module/iso_c_binding.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 18.2
|
|
|
|
module iso_c_binding
|
|
|
|
use __Fortran_builtins, only: &
|
|
c_f_pointer => __builtin_c_f_pointer, &
|
|
c_ptr => __builtin_c_ptr, &
|
|
c_funptr => __builtin_c_funptr, &
|
|
c_sizeof => sizeof, &
|
|
c_loc => __builtin_c_loc, &
|
|
operator(==), operator(/=)
|
|
|
|
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 = kind(c_sizeof(1)), &
|
|
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
|
|
integer, parameter :: c_char = 1
|
|
|
|
! C characters with special semantics
|
|
character(kind=c_char, len=1), parameter :: c_null_char = achar(0)
|
|
character(kind=c_char, len=1), parameter :: c_alert = achar(7)
|
|
character(kind=c_char, len=1), parameter :: c_backspace = achar(8)
|
|
character(kind=c_char, len=1), parameter :: c_form_feed = achar(12)
|
|
character(kind=c_char, len=1), parameter :: c_new_line = achar(10)
|
|
character(kind=c_char, len=1), parameter :: c_carriage_return = achar(13)
|
|
character(kind=c_char, len=1), parameter :: c_horizontal_tab = achar(9)
|
|
character(kind=c_char, len=1), parameter :: c_vertical_tab = achar(11)
|
|
|
|
interface c_associated
|
|
module procedure c_associated_c_ptr
|
|
module procedure c_associated_c_funptr
|
|
end interface
|
|
private :: c_associated_c_ptr, c_associated_c_funptr
|
|
|
|
interface c_f_procpointer
|
|
module procedure c_f_procpointer
|
|
end interface
|
|
|
|
! gfortran extensions
|
|
integer, parameter :: &
|
|
c_float128 = 16, &
|
|
c_float128_complex = c_float128
|
|
|
|
contains
|
|
|
|
pure logical function c_associated_c_ptr(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_c_ptr = .false.
|
|
else if (present(c_ptr_2)) then
|
|
c_associated_c_ptr = c_ptr_1%__address == c_ptr_2%__address
|
|
else
|
|
c_associated_c_ptr = .true.
|
|
end if
|
|
end function c_associated_c_ptr
|
|
|
|
pure logical function c_associated_c_funptr(c_funptr_1, c_funptr_2)
|
|
type(c_funptr), intent(in) :: c_funptr_1
|
|
type(c_funptr), intent(in), optional :: c_funptr_2
|
|
if (c_funptr_1%__address == c_null_ptr%__address) then
|
|
c_associated_c_funptr = .false.
|
|
else if (present(c_funptr_2)) then
|
|
c_associated_c_funptr = c_funptr_1%__address == c_funptr_2%__address
|
|
else
|
|
c_associated_c_funptr = .true.
|
|
end if
|
|
end function c_associated_c_funptr
|
|
|
|
function c_funloc(x)
|
|
type(c_funptr) :: c_funloc
|
|
external :: x
|
|
c_funloc = c_funptr(loc(x))
|
|
end function c_funloc
|
|
|
|
subroutine c_f_procpointer(cptr, fptr)
|
|
type(c_funptr), intent(in) :: cptr
|
|
procedure(), pointer, intent(out) :: fptr
|
|
! TODO: implement
|
|
end subroutine c_f_procpointer
|
|
|
|
end module iso_c_binding
|