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
|
! Copyright 2020-2022 Free Software Foundation, Inc.
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
module type_module
use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
type, bind(C) :: MyType
real(c_float) :: a
real(c_float) :: b
end type MyType
end module type_module
program mixed_stack_main
implicit none
! Set up some locals.
! Call a Fortran function.
call mixed_func_1a
write(*,*) "All done"
end program mixed_stack_main
subroutine breakpt ()
implicit none
write(*,*) "Hello World" ! Break here.
end subroutine breakpt
subroutine mixed_func_1a()
use type_module
implicit none
TYPE(MyType) :: obj
complex(kind=4) :: d
obj%a = 1.5
obj%b = 2.5
d = cmplx (4.0, 5.0)
! Call a C function.
call mixed_func_1b (1, 2.0, 3D0, d, "abcdef", obj)
end subroutine mixed_func_1a
! This subroutine is called from the Fortran code.
subroutine mixed_func_1b(a, b, c, d, e, g)
use type_module
implicit none
integer :: a
real(kind=4) :: b
real(kind=8) :: c
complex(kind=4) :: d
character(len=*) :: e
character(len=:), allocatable :: f
TYPE(MyType) :: g
interface
subroutine mixed_func_1c (a, b, c, d, f, g) bind(C)
use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
use, intrinsic :: iso_c_binding, only: c_float_complex, c_char
use type_module
implicit none
integer(c_int), value, intent(in) :: a
real(c_float), value, intent(in) :: b
real(c_double), value, intent(in) :: c
complex(c_float_complex), value, intent(in) :: d
character(c_char), intent(in) :: f(*)
TYPE(MyType) :: g
end subroutine mixed_func_1c
end interface
! Create a copy of the string with a NULL terminator on the end.
f = e//char(0)
! Call a C function.
call mixed_func_1c (a, b, c, d, f, g)
end subroutine mixed_func_1b
! This subroutine is called from the C code.
subroutine mixed_func_1d(a, b, c, d, str)
use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
use, intrinsic :: iso_c_binding, only: c_float_complex
implicit none
integer(c_int) :: a
real(c_float) :: b
real(c_double) :: c
complex(c_float_complex) :: d
character(len=*) :: str
interface
subroutine mixed_func_1e () bind(C)
implicit none
end subroutine mixed_func_1e
end interface
write(*,*) a, b, c, d, str
! Call a C++ function (via an extern "C" wrapper).
call mixed_func_1e
end subroutine mixed_func_1d
! This is called from C++ code.
subroutine mixed_func_1h ()
call breakpt
end subroutine mixed_func_1h
|
