1!===-- module/iso_c_binding.f90 --------------------------------------------===!
2!
3! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4! See https://llvm.org/LICENSE.txt for license information.
5! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6!
7!===------------------------------------------------------------------------===!
8
9! See Fortran 2018, clause 18.2
10
11module iso_c_binding
12
13  use __Fortran_builtins, only: &
14    c_f_pointer => __builtin_c_f_pointer, &
15    c_ptr => __builtin_c_ptr, &
16    c_funptr => __builtin_c_funptr
17
18  type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
19  type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
20
21  ! Table 18.2 (in clause 18.3.1)
22  ! TODO: Specialize (via macros?) for alternative targets
23  integer, parameter :: &
24    c_int8_t = 1, &
25    c_int16_t = 2, &
26    c_int32_t = 4, &
27    c_int64_t = 8, &
28    c_int128_t = 16 ! anticipating future addition
29  integer, parameter :: &
30    c_int = c_int32_t, &
31    c_short = c_int16_t, &
32    c_long = c_int64_t, &
33    c_long_long = c_int64_t, &
34    c_signed_char = c_int8_t, &
35    c_size_t = c_long_long, &
36    c_intmax_t = c_int128_t, &
37    c_intptr_t = c_size_t, &
38    c_ptrdiff_t = c_size_t
39  integer, parameter :: &
40    c_int_least8_t = c_int8_t, &
41    c_int_fast8_t = c_int8_t, &
42    c_int_least16_t = c_int16_t, &
43    c_int_fast16_t = c_int16_t, &
44    c_int_least32_t = c_int32_t, &
45    c_int_fast32_t = c_int32_t, &
46    c_int_least64_t = c_int64_t, &
47    c_int_fast64_t = c_int64_t, &
48    c_int_least128_t = c_int128_t, &
49    c_int_fast128_t = c_int128_t
50
51  integer, parameter :: &
52    c_float = 4, &
53    c_double = 8, &
54#if __x86_64__
55    c_long_double = 10
56#else
57    c_long_double = 16
58#endif
59
60  integer, parameter :: &
61    c_float_complex = c_float, &
62    c_double_complex = c_double, &
63    c_long_double_complex = c_long_double
64
65  integer, parameter :: c_bool = 1 ! TODO: or default LOGICAL?
66  integer, parameter :: c_char = 1
67
68  ! C characters with special semantics
69  character(kind=c_char, len=1), parameter :: c_null_char = achar(0)
70  character(kind=c_char, len=1), parameter :: c_alert = achar(7)
71  character(kind=c_char, len=1), parameter :: c_backspace = achar(8)
72  character(kind=c_char, len=1), parameter :: c_form_feed = achar(12)
73  character(kind=c_char, len=1), parameter :: c_new_line = achar(10)
74  character(kind=c_char, len=1), parameter :: c_carriage_return = achar(13)
75  character(kind=c_char, len=1), parameter :: c_horizontal_tab = achar(9)
76  character(kind=c_char, len=1), parameter :: c_vertical_tab =  achar(11)
77
78 contains
79
80  logical function c_associated(c_ptr_1, c_ptr_2)
81    type(c_ptr), intent(in) :: c_ptr_1
82    type(c_ptr), intent(in), optional :: c_ptr_2
83    if (c_ptr_1%__address == c_null_ptr%__address) then
84      c_associated = .false.
85    else if (present(c_ptr_2)) then
86      c_associated = c_ptr_1%__address == c_ptr_2%__address
87    else
88      c_associated = .true.
89    end if
90  end function c_associated
91
92  function c_loc(x)
93    type(c_ptr) :: c_loc
94    type(*), dimension(..), intent(in) :: x
95    c_loc = c_ptr(loc(x))
96  end function c_loc
97
98  function c_funloc(x)
99    type(c_funptr) :: c_funloc
100    external :: x
101    c_funloc = c_funptr(loc(x))
102  end function c_funloc
103
104  ! TODO c_f_procpointer
105  ! TODO c_sizeof
106
107end module iso_c_binding
108