[823] | 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 |
---|