1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
!===-- 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
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 ! TODO: or default LOGICAL?
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
! 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
! TODO c_f_procpointer
end module iso_c_binding
|
