1 | module iso_c_binding |
---|
2 | implicit none |
---|
3 | |
---|
4 | integer, parameter :: POINTER_LEN = 8 |
---|
5 | |
---|
6 | integer (KIND=4), parameter :: C_INT = 4 |
---|
7 | integer (KIND=4), parameter :: C_SHORT = 2 |
---|
8 | integer (KIND=4), parameter :: C_LONG = POINTER_LEN |
---|
9 | integer (KIND=4), parameter :: C_LONG_LONG = 8 |
---|
10 | integer (KIND=4), parameter :: C_SIGNED_CHAR = 1 |
---|
11 | integer (KIND=4), parameter :: C_SIZE_T = POINTER_LEN |
---|
12 | |
---|
13 | integer (KIND=4), parameter :: C_INT8_T = 1 |
---|
14 | integer (KIND=4), parameter :: C_INT16_T = 2 |
---|
15 | integer (KIND=4), parameter :: C_INT32_T = 4 |
---|
16 | integer (KIND=4), parameter :: C_INT64_T = 8 |
---|
17 | integer (KIND=4), parameter :: C_INT_LEAST8_T = 1 |
---|
18 | integer (KIND=4), parameter :: C_INT_LEAST16_T = 2 |
---|
19 | integer (KIND=4), parameter :: C_INT_LEAST32_T = 4 |
---|
20 | integer (KIND=4), parameter :: C_INT_LEAST64_T = 8 |
---|
21 | integer (KIND=4), parameter :: C_INT_FAST8_T = 1 |
---|
22 | integer (KIND=4), parameter :: C_INT_FAST16_T = POINTER_LEN |
---|
23 | integer (KIND=4), parameter :: C_INT_FAST32_T = POINTER_LEN |
---|
24 | integer (KIND=4), parameter :: C_INT_FAST64_T = 8 |
---|
25 | integer (KIND=4), parameter :: C_INTMAX_T = 8 |
---|
26 | integer (KIND=4), parameter :: C_INTPTR_T = POINTER_LEN |
---|
27 | |
---|
28 | integer (KIND=4), parameter :: C_FLOAT = 4 |
---|
29 | integer (KIND=4), parameter :: C_DOUBLE = 8 |
---|
30 | integer (KIND=4), parameter :: C_LONG_DOUBLE = C_LONG *2 |
---|
31 | |
---|
32 | integer (KIND=4), parameter :: C_FLOAT_COMPLEX = C_FLOAT |
---|
33 | integer (KIND=4), parameter :: C_DOUBLE_COMPLEX = C_DOUBLE |
---|
34 | integer (KIND=4), parameter :: C_LONG_DOUBLE_COMPLEX = C_LONG_DOUBLE |
---|
35 | |
---|
36 | integer (KIND=4), parameter :: C_BOOL = 1 |
---|
37 | |
---|
38 | integer (KIND=4), parameter :: C_CHAR = 1 |
---|
39 | |
---|
40 | character (KIND=1, LEN=1), parameter :: C_NULL_CHAR = achar(0) |
---|
41 | character (KIND=1, LEN=1), parameter :: C_ALERT = achar(7) |
---|
42 | character (KIND=1, LEN=1), parameter :: C_BACKSPACE = achar(8) |
---|
43 | character (KIND=1, LEN=1), parameter :: C_FORM_FEED = achar(12) |
---|
44 | character (KIND=1, LEN=1), parameter :: C_NEW_LINE = achar(10) |
---|
45 | character (KIND=1, LEN=1), parameter :: C_CARRIAGE_RETURN = achar(13) |
---|
46 | character (KIND=1, LEN=1), parameter :: C_HORIZONTAL_TAB = achar(9) |
---|
47 | character (KIND=1, LEN=1), parameter :: C_VERTICAL_TAB = achar(11) |
---|
48 | |
---|
49 | type, BIND(C) :: C_PTR |
---|
50 | private |
---|
51 | integer(C_INTPTR_T) :: ptr |
---|
52 | end type C_PTR |
---|
53 | |
---|
54 | type, BIND(C) :: C_FUNPTR |
---|
55 | private |
---|
56 | integer(C_INTPTR_T) :: ptr |
---|
57 | end type C_FUNPTR |
---|
58 | |
---|
59 | type(C_PTR), parameter :: C_NULL_PTR = C_PTR(0) |
---|
60 | type(C_FUNPTR), parameter :: C_NULL_FUNPTR = C_FUNPTR(0) |
---|
61 | |
---|
62 | integer(4), parameter, private :: for_desc_max_rank = 7 |
---|
63 | integer(C_INTPTR_T), parameter, private :: for_desc_array_defined= 1 |
---|
64 | integer(C_INTPTR_T), parameter, private :: for_desc_array_nodealloc = 2 |
---|
65 | integer(C_INTPTR_T), parameter, private :: for_desc_array_contiguous = 4 |
---|
66 | integer(C_INTPTR_T), parameter, private :: for_desc_flags = & |
---|
67 | for_desc_array_defined + & |
---|
68 | for_desc_array_nodealloc + & |
---|
69 | for_desc_array_contiguous |
---|
70 | |
---|
71 | type, private :: for_desc_triplet |
---|
72 | integer(C_INTPTR_T) :: extent |
---|
73 | integer(C_INTPTR_T) :: mult ! multiplier for this dimension |
---|
74 | integer(C_INTPTR_T) :: lowerbound |
---|
75 | end type for_desc_triplet |
---|
76 | |
---|
77 | type, private :: for_array_descriptor |
---|
78 | integer(C_INTPTR_T) :: base |
---|
79 | integer(C_INTPTR_T) :: len ! len of data type |
---|
80 | integer(C_INTPTR_T) :: offset |
---|
81 | integer(C_INTPTR_T) :: flags |
---|
82 | integer(C_INTPTR_T) :: rank |
---|
83 | integer(C_INTPTR_T) :: reserved1 |
---|
84 | type(for_desc_triplet) :: diminfo(for_desc_max_rank) |
---|
85 | end type for_array_descriptor |
---|
86 | |
---|
87 | interface c_associated |
---|
88 | module procedure c_associated_ptr, c_associated_funptr |
---|
89 | end interface |
---|
90 | |
---|
91 | interface c_f_pointer |
---|
92 | module procedure c_f_pointer_scalar |
---|
93 | |
---|
94 | subroutine c_f_pointer_array1 (cptr, fptr, shape) |
---|
95 | import :: c_ptr |
---|
96 | implicit none |
---|
97 | type(c_ptr), intent(in) :: cptr |
---|
98 | integer, POINTER, intent(out) :: fptr(:) |
---|
99 | integer(1), intent(in) :: shape(:) |
---|
100 | end subroutine c_f_pointer_array1 |
---|
101 | |
---|
102 | subroutine c_f_pointer_array2 (cptr, fptr, shape) |
---|
103 | import :: c_ptr |
---|
104 | implicit none |
---|
105 | type(c_ptr), intent(in) :: cptr |
---|
106 | integer, POINTER, intent(out) :: fptr(:) |
---|
107 | integer(2), intent(in) :: shape(:) |
---|
108 | end subroutine c_f_pointer_array2 |
---|
109 | |
---|
110 | subroutine c_f_pointer_array4 (cptr, fptr, shape) |
---|
111 | import :: c_ptr |
---|
112 | implicit none |
---|
113 | type(c_ptr), intent(in) :: cptr |
---|
114 | integer, POINTER, intent(out) :: fptr(:) |
---|
115 | integer(4), intent(in) :: shape(:) |
---|
116 | end subroutine c_f_pointer_array4 |
---|
117 | |
---|
118 | subroutine c_f_pointer_array8 (cptr, fptr, shape) |
---|
119 | import :: c_ptr |
---|
120 | implicit none |
---|
121 | type(c_ptr), intent(in) :: cptr |
---|
122 | integer, POINTER, intent(out) :: fptr(:) |
---|
123 | integer(8), intent(in) :: shape(:) |
---|
124 | end subroutine c_f_pointer_array8 |
---|
125 | |
---|
126 | end interface |
---|
127 | |
---|
128 | private :: c_f_pointer_private1 |
---|
129 | private :: c_f_pointer_private2 |
---|
130 | private :: c_f_pointer_private4 |
---|
131 | private :: c_f_pointer_private8 |
---|
132 | |
---|
133 | CONTAINS |
---|
134 | |
---|
135 | function c_associated_ptr (c_ptr_1, c_ptr_2) |
---|
136 | logical(4) :: c_associated_ptr |
---|
137 | type(c_ptr) :: c_ptr_1 |
---|
138 | type(c_ptr), optional :: c_ptr_2 |
---|
139 | end function c_associated_ptr |
---|
140 | |
---|
141 | function c_associated_funptr (c_ptr_1, c_ptr_2) |
---|
142 | logical(4) :: c_associated_funptr |
---|
143 | type(c_funptr) :: c_ptr_1 |
---|
144 | type(c_funptr), optional :: c_ptr_2 |
---|
145 | end function c_associated_funptr |
---|
146 | |
---|
147 | subroutine c_f_pointer_scalar (cptr, fptr) |
---|
148 | integer, POINTER , intent(in):: cptr |
---|
149 | integer, POINTER , intent(out):: fptr |
---|
150 | end subroutine c_f_pointer_scalar |
---|
151 | |
---|
152 | subroutine c_f_pointer_private1 (caddr, fdesc, shape) |
---|
153 | integer(C_INTPTR_T), intent(in) :: caddr |
---|
154 | type(for_array_descriptor), intent(inout) :: fdesc |
---|
155 | integer(1), intent(in) :: shape(:) |
---|
156 | end subroutine c_f_pointer_private1 |
---|
157 | |
---|
158 | subroutine c_f_pointer_private2 (caddr, fdesc, shape) |
---|
159 | integer(C_INTPTR_T), intent(in) :: caddr |
---|
160 | type(for_array_descriptor), intent(inout) :: fdesc |
---|
161 | integer(2), intent(in) :: shape(:) |
---|
162 | end subroutine c_f_pointer_private2 |
---|
163 | |
---|
164 | subroutine c_f_pointer_private4 (caddr, fdesc, shape) |
---|
165 | integer(C_INTPTR_T), intent(in) :: caddr |
---|
166 | type(for_array_descriptor), intent(inout) :: fdesc |
---|
167 | integer(4), intent(in) :: shape(:) |
---|
168 | end subroutine c_f_pointer_private4 |
---|
169 | |
---|
170 | subroutine c_f_pointer_private8 (caddr, fdesc, shape) |
---|
171 | integer(C_INTPTR_T), intent(in) :: caddr |
---|
172 | type(for_array_descriptor), intent(inout) :: fdesc |
---|
173 | integer(8), intent(in) :: shape(:) |
---|
174 | end subroutine c_f_pointer_private8 |
---|
175 | |
---|
176 | subroutine c_f_procpointer (cptr, fptr) |
---|
177 | integer, POINTER , intent(in):: cptr |
---|
178 | ! TODO remove comment when supported in OMNI |
---|
179 | !procedure(), POINTER , intent(out):: fptr |
---|
180 | integer, POINTER , intent(out):: fptr |
---|
181 | end subroutine c_f_procpointer |
---|
182 | |
---|
183 | function c_funloc (x) |
---|
184 | type(c_funptr) :: c_funloc |
---|
185 | integer :: x |
---|
186 | end function c_funloc |
---|
187 | |
---|
188 | function c_loc (x) |
---|
189 | type(c_ptr) :: c_loc |
---|
190 | integer :: x |
---|
191 | end function c_loc |
---|
192 | |
---|
193 | function c_sizeof (x) |
---|
194 | class(*), intent(in) :: x |
---|
195 | integer(kind=C_SIZE_T) :: c_sizeof |
---|
196 | end function c_sizeof |
---|
197 | |
---|
198 | end module iso_c_binding |
---|