I have a C program that calls a Fortran subroutine in a static lib. This subroutine takes as argument a function pointer to a callback implemented in C. A minimal example looks like this:
Fortran code:
subroutine fortran_function(input, c_function) bind(c)
use, intrinsic :: iso_c_binding
implicit none
real(c_float), value, intent(IN) :: input
type(c_funptr), intent(IN), value :: c_function
abstract interface
subroutine callback(a, b) bind(c)
USE iso_c_binding, only: c_float, c_int
integer(c_int), intent(IN), value :: a
real(c_float), intent(IN), value :: b
end subroutine callback
end interface
procedure(callback), pointer :: c_proc
call c_f_procpointer(c_function, c_proc)
call c_proc(1_c_int, input)
if (input > 1.0) call c_proc(2_c_int, input)
end subroutine fortran_function
C code:
#include <stdio.h>
typedef void (*c_function)(int, float);
void fortran_function(float, c_function);
void callback(int a, float b)
{
printf("a=%d, b=%.1f\n", a, b);
}
int main()
{
fortran_function(0.0, &callback);
fortran_function(5.0, &callback);
}
If I compile this (Intel and MSVS on Windows) everything works fine and I get the expected output:
a=1, b=0.0
a=1, b=5.0
a=2, b=5.0
However, I ultimatley want to target a powerpc (using gfortran and gcc-variant crosscompiler). The program compiles there without warnings (-Wall) but produces the output:
a=1, b=0.0
a=2, b=0.0
a=1, b=5.0
a=2, b=5.0
This is very strange because for the first call the flow should never enter the if-body. Apparently it does so anyway, but even prints the correct value for the input.
Compiled on Ubuntu with:
powerpc-linux-gnu-gfortran test.f90 -c -Wall -pedantic
ar cr test.lib test.o
What I already checked:
Replacing if (input > 1.0) with if (input > 1.0_c_float) doesn't solve the problem
Using pass-by-reference instead by-value on the function pointer crashes instantly (on Windows it runs fine)
Turning of optimization (on both the C and Fortran part) doesn't solve the problem
All types are 4 byte sizeof(real)=sizeof(real(c_float))=sizeof(integer)=sizeof(integer(c_int)) (same in C)
Does anyone have an idea what could possibly cause this problem?
Related
I am trying to test Fortran/C mixed language by using module and procedure. I used the base example case from this link: http://cftcc.iccas.ac.cn/upload/doc/ifc/f_ug1/pgwusmod.htm
but when I try to modify the code, I start to get the error like
"_initfo_", reference from: _MAIN__ in main.o
ld: symbol(s) not found for architecture x86_64.
here is my code:
new.F >>
MODULE EXAMP
use iso_c_binding
REAL, bind(C) :: A(3)
INTEGER I1, I2
CHARACTER(80) LINE
TYPE MYDATA
SEQUENCE
INTEGER N
CHARACTER(30) INFO
END TYPE MYDATA
END MODULE EXAMP
cnew.c >>
/* C code accessing module data */
extern float a[3];
extern int examp_mp_i1, examp_mp_i2;
extern char examp_mp_line[80];
//extern void usemodule();
extern struct {
int n;
char info[30];
} examp_mp_mydata;
void pythagoras (float *c){
*c = (float) sqrt(a[0]*a[0] + a[1]*a[1]);
}
void initfo(float *aa){
*aa = a[0]+a[1]+a[2];
}
main.F >>
! Fortran 95/90 Module including procedure
MODULE CPROC
INTERFACE
SUBROUTINE PYTHAGORAS ( res)
!DEC$ ATTRIBUTES C :: PYTHAGORAS
!DEC$ ATTRIBUTES REFERENCE :: res
! res is passed by REFERENCE because its individual attribute
!: overrides the subroutine's C attribute
REAL res
! a and b have the VALUE attribute by default because
! the subroutine has the C attribute
END SUBROUTINE
END INTERFACE
END MODULE
! Fortran 95/90 Module including procedure
MODULE CCPROC
INTERFACE
SUBROUTINE INITFO (aa)
REAL aa
END SUBROUTINE
END INTERFACE
END MODULE
PROGRAM MAIN
USE EXAMP
! Fortran 95/90 Module including procedure
USE CPROC
USE CCPROC
A(1)=1.0
A(2)=2.0
A(3)=3.0
WRITE(*,*) A(1)
CALL PYTHAGORAS ( X)
WRITE(*,*) X
CALL INITFO(Y)
WRITE(*,*) Y
END PROGRAM MAIN
I am using intel compilers.
this is what I did to compile:
icc -c cnew.c
ifort -c new.f
ifort -o test main.f new.o cnew.o
I am really new to fortran. I really hope someone can point me to a right direction.
Thanks,
Jing
With Fortran 2003 you would declare the interfaces like this:
INTERFACE
SUBROUTINE PYTHAGORAS (res) bind(c, name='pythagoras')
use iso_c_binding
real(kind=c_float) :: res
END SUBROUTINE
SUBROUTINE initfo (aa) bind(c, name='initfo')
use iso_c_binding
real(kind=c_float) :: aa
END SUBROUTINE
END INTERFACE
The main point here is the name attribute added to the subroutine declaration, this tells the compiler, which symbol to actually use. Otherwise the name mangling gives you not found entities.
In total this gives: new.f90
MODULE EXAMP
use iso_c_binding
REAL(kind=c_float), bind(c) :: A(3)
INTEGER :: I1, I2
CHARACTER(80) :: LINE
TYPE MYDATA
SEQUENCE
INTEGER :: N
CHARACTER(len=30) :: INFO
END TYPE MYDATA
END MODULE EXAMP
main.f90:
MODULE CPROC
use iso_c_binding
INTERFACE
SUBROUTINE PYTHAGORAS (res) bind(c, name='pythagoras')
use iso_c_binding
real(kind=c_float) :: res
END SUBROUTINE
SUBROUTINE initfo (aa) bind(c, name='initfo')
use iso_c_binding
real(kind=c_float) :: aa
END SUBROUTINE
END INTERFACE
END MODULE
PROGRAM MAIN
USE EXAMP
! Fortran 95/90 Module including procedure
USE CPROC
A(1)=1.0
A(2)=2.0
A(3)=3.0
WRITE(*,*) A(1)
CALL PYTHAGORAS(X)
WRITE(*,*) X
CALL INITFO(Y)
WRITE(*,*) Y
END PROGRAM MAIN
With the c-code unchanged. I would urge you to not use global variables like your a.
I'm trying to use dynamic library loading in Linux with Fortran based on this, but I'd like to add support for dladdr. Basically my code is:
procedure(proto), pointer :: my_func
type(c_funptr) :: funptr
funptr = dlsym(handle,'myfunction')
if (c_associated(funptr)) then
call c_f_procpointer(funptr, my_func)
else
my_func => myfunction
end if
write(6,*) dladdr(???,info)
Many details are missing, but the important part is I want to pass to dladdr the actual function represented by my_func, which is a procedure pointer to some other function: either something found by dlsym or an explicit Fortran association. So my problem is I don't know what to put in the ???.
I get success (non-zero return value) if I use funptr or c_funloc(myfunction), so at least the dladdr call is working. But I can't use my_func (the gfortran compiler complains about bad argument type), and both c_loc(my_func) and c_funloc(my_func) fail (zero return value). I think the problem is I have to "dereference" my_func once, and then get the C function pointer that. How could I do that?
Full code:
dlfcn.f90
MODULE DLFCN
USE ISO_C_BINDING
IMPLICIT NONE
PRIVATE
PUBLIC :: DLOpen, DLSym, DLClose, DLError, DLAddr ! DL API
! Valid modes for mode in DLOpen:
INTEGER, PARAMETER, PUBLIC :: RTLD_LAZY=1, RTLD_NOW=2, RTLD_GLOBAL=256, RTLD_LOCAL=0
! Obtained from the output of the previously listed C program
INTERFACE ! All we need is interfaces for the prototypes in <dlfcn.h>
FUNCTION DLOpen(file,mode) RESULT(handle) BIND(C,NAME="dlopen")
! void *dlopen(const char *file, int mode);
USE ISO_C_BINDING
CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: file
! C strings should be declared as character arrays
INTEGER(C_INT), VALUE :: mode
TYPE(C_PTR) :: handle
END FUNCTION
FUNCTION DLSym(handle,name) RESULT(funptr) BIND(C,NAME="dlsym")
! void *dlsym(void *handle, const char *name);
USE ISO_C_BINDING
TYPE(C_PTR), VALUE :: handle
CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: name
TYPE(C_FUNPTR) :: funptr ! A function pointer
END FUNCTION
FUNCTION DLClose(handle) RESULT(status) BIND(C,NAME="dlclose")
! int dlclose(void *handle);
USE ISO_C_BINDING
TYPE(C_PTR), VALUE :: handle
INTEGER(C_INT) :: status
END FUNCTION
FUNCTION DLError() RESULT(error) BIND(C,NAME="dlerror")
! char *dlerror(void);
USE ISO_C_BINDING
TYPE(C_PTR) :: error
END FUNCTION
! dladdr is a Glibc extension, not POSIX
FUNCTION DLAddr(funptr,info) RESULT(output) BIND(C,NAME="dladdr")
! int dladdr(void *addr, Dl_info *info)
USE ISO_C_BINDING
TYPE(C_FUNPTR) :: funptr ! A function pointer
TYPE(C_PTR) :: info
INTEGER(C_INT) :: output
END FUNCTION
END INTERFACE
END MODULE
test.f90
program test
use iso_c_binding
use dlfcn
implicit none
abstract interface
function proto(s,i)
character(len=*) :: s
integer :: i
integer :: proto
end function proto
end interface
procedure(proto), pointer :: my_func
character(kind=c_char,len=1024) :: libname,funname
type(c_ptr) :: handle=c_null_ptr
type(c_funptr) :: funptr=c_null_funptr
type(c_ptr) :: info
libname = 'libblas.so'
funname = 'xerbla_'
handle = dlopen(trim(libname)//c_null_char, int(ior(rtld_global,rtld_lazy),kind=c_int))
if (c_associated(handle)) then
write (6,*) trim(libname),' loaded'
else
write(6,*) 'error loading '//trim(libname)
end if
funptr = dlsym(handle,trim(funname)//c_null_char)
if (c_associated(funptr)) then
call c_f_procpointer(funptr, my_func)
else
my_func => myfunction
end if
write(6,*) dladdr(funptr,info)
write(6,*) dladdr(c_funloc(myfunction),info)
write(6,*) dladdr(c_funloc(my_func),info)
!write(6,*) dladdr(my_func,info)
contains
function myfunction(srname,info)
character(len=*) :: srname
integer :: info
integer :: myfunction
myfunction = 0
end function myfunction
end program test
Compile with:
gfortran dlfcn.f90 test.f90 -ldl -o test
Run:
$ ./test
libblas.so loaded
1
1
0
If I enable the commented-out line, the compiler says:
write(6,*) dladdr(my_func,info)
1
Error: Invalid procedure argument at (1)
which makes sense, because my_func is a Fortran procedure pointer, not a C pointer, as dladdr expects.
The interface for DLAddr in the Fortran source does not match the documented interface of the corresponding C function. The VALUE attribute is required on both arguments.
It is also worth noting that the argument to C_FUNLOC (which is what you need in the ???) needs to be an interoperable procedure, i.e. one that has the BIND attribute. This attribute is missing from the interface used in the procedure pointer declaration in the Fortran code (and also from my_function, if you want that to have the same characteristics).
I'm trying to use a fortran module subroutine in c and cannot get through, here is a simplified version of my problem:
I have one fortran module that contains a subroutine, and the second subroutine uses the module.
!md.f90
module myadd
implicit none
contains
subroutine add1(a) bind(c)
implicit none
integer a
a=a+1
end subroutine add1
end module myadd
!sb.f90
subroutine sq(a) bind(c)
use myadd
implicit none
integer a
call add1(a)
a=a*a
end subroutine sq
Now I want to call the sb function in c:
//main.cpp
extern "C"{ void sb(int * a); }
int main(){
int a=2;
sb(&a);
}
how should I link them together?
I tried something like
ifort -c md.f90 sb.f90
icc sb.o main.cpp
but it gives error
sb.o: In function sq': sb.f90:(.text+0x6): undefined reference to
add1' /tmp/icc40D9n7.o: In function main': main.cpp:(.text+0x2e):
undefined reference tosb'
Does anyone know how to solve the problem?
int main(void){
int a=2;
sb(&a);
return 0;
}
and
module myadd
use iso_c_binding
implicit none
contains
subroutine add1(a) bind(c)
implicit none
integer (c_int),intent (inout) :: a
a=a+1
end subroutine add1
end module myadd
!sb.f90
subroutine sq(a) bind(c, name="sb")
use iso_c_binding
use myadd
implicit none
integer (c_int), intent(inout) :: a
call add1(a)
a=a*a
end subroutine sq
with
gcc -c main.c
gfortran-debug fort_subs.f90 main.o
It is easier to link with the Fortran compiler because it brings in the Fortran libraries.
The reason for your link error is twofold:
you omitted the object file for the source file that holds the module from the final command line (md.o).
you've called sq in the fortran sb in the C++ code.
Fix those and you'll be right to go.
I have a Fortran 90 program which repeatedly calls on a C function. The first time the function is used all goes well, but the second time the code tries to access the function it gives the following error:
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
I am using gfortran v.4.6 on windows, linking to a library to which I have no source code. The library came to me as a DLL and I used gendef and dlltool to create an .a library to link to.
The code looks like:
PROGRAM cmod
USE, INTRINSIC :: ISO_C_BINDING
INTERFACE
LOGICAL (C_BOOL) FUNCTION clover(scen,reg,soil,top,rain,depth,numd,nums,numb, numd,addn,srate,stype,nloss,ploss,ErrStr) BIND (C, name = "ClOvr")
USE, INTRINSIC :: ISO_C_BINDING
INTEGER (C_INT), INTENT(IN), VALUE :: scen,reg,soil,topo,depth
REAL (C_DOUBLE), INTENT(IN), VALUE :: rain,numd,nums,numb,numd
REAL (C_DOUBLE), INTENT(IN), VALUE :: addn,srate
INTEGER (C_INT), INTENT(IN), VALUE :: stype
REAL (C_DOUBLE), INTENT(OUT) :: nloss,ploss
CHARACTER(C_CHAR), INTENT(OUT) :: ErrStr(*)
END FUNCTION clover
END INTERFACE
.....
do
.....
result = clover(a,b,c, d, e, f, g, h, sb, sd, an, sr, st,lossx,lossy,err)
......
result = clover(a,b,c, d, e, f, g, h, sb, sd, an, sr, st,lossx,lossy,err)
end do
END PROGRAM cmod
I don't have the C code, but I am porting from IBM Fortran.
The interface declaration contains these two lines
!DEC$ ATTRIBUTES VALUE :: scen,reg,soil,top,rain,depth,numd,nums,numb,numd,addn,srate,stype
!DEC$ ATTRIBUTES REFERENCE :: lossx,lossy,ErrStr
The IBM fortran uses the following code to load the library and access the function:
pointer (q,clover)
p = loadlibrary("clover.dll")
q = getprocaddress(p, "ClOvr")
So I might be missing something in the translation to GNU fortran
I've found my problem: when I compile, I have to use the -mrtd (sdtcall)
I'm trying to write a wrapper to use the gsl library with Fortran. I have managed to get a simple wrapper to work - the example from http://www.helsinki.fi/~fyl_tlpk/luento/ohj-13-GSL-e.html
Fortran code
program gsltest
implicit none
real(kind=selected_real_kind(12)) :: a = 0.11, res
external :: glsgateway
call gslgateway(a,res)
write(*,*) 'x', a, 'atanh(x)', res
end program gsltest
c function
#include <gsl/gsl_math.h>
void gslgateway_(double *x, double *res){
*res = gsl_atanh(*x);
}
That's all well and good. However, I'm having problems with a more complicated wrapper. I have the following code modified from an example at http://apwillis.staff.shef.ac.uk/aco/freesoftware.html
c wrapper (rng_initialise.c)
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
static gsl_rng* r;
void rng_initialise__(int* s) {
r = gsl_rng_alloc(gsl_rng_taus);
gsl_rng_set(r, (unsigned long int)(*s));
}
Fortran main (main.f90)
PROGRAM main
integer seed
call system_clock(seed)
WRITE (*,*) 'calling rng_initialise'
call rng_initialise(seed)
END PROGRAM main
which I then compile and link by
gcc -c rng_initialise.c
g95 -c main.f90
g95 -o main main.o rng_initialise.o -L/usr/libs -lgsl
When I run this program, I get no output. However, if I comment out the lines inside rng_initialise
...
void rng_initialise__(int* s) {
// r = gsl_rng_alloc(gsl_rng_taus);
// gsl_rng_set(r, (unsigned long int)(*s));
}
then I get output from the Fortran code (it writes 'calling_rng_initialise' to STDOUT).
So, the problem seems to be the calls to gsl_rng_alloc and gsl_rng_set. But I don't get any error messages, and I don't know why they would prevent the Fortran code from doing anything. Any ideas?
As already suggested, the best way to do this is to use the Fortran ISO C Binding because it will instruct Fortran to use the C calling conventions to match the C routines of the GSL library. The ISO C Binding is part of the Fortran 2003 standard and has been available in many Fortran 95 compilers for several years. As part of the standard it makes interfacing Fortran and C, in both directions, portable and much easier than the OS and compiler dependent hacks that used to be necessary. I recommend ignoring instructions that pre-date the ISO C Binding as obsolete.
Generally you won't need to write any C wrapper code to call the GSL library, only Fortran specifications statements to describe the C routine interfaces to Fortran in Fortran syntax. Here is a simple example that calls the GSL routine gsl_cdf_chisq_Q
program cum_chisq_prob
use iso_c_binding
interface GSL_CummulativeChiSq_Prob_Upper
function gsl_cdf_chisq_Q ( x, nu ) bind ( C, name="gsl_cdf_chisq_Q" )
import
real (kind=c_double) :: gsl_cdf_chisq_Q
real (kind=c_double), VALUE, intent (in) :: x
real (kind=c_double), VALUE, intent (in) :: nu
end function gsl_cdf_chisq_Q
end interface GSL_CummulativeChiSq_Prob_Upper
real (kind=c_double) :: chisq_value
real (kind=c_double) :: DoF
real (kind=c_double) :: Upper_Tail_Prob
write ( *, '( / "Calculates cumulative upper-tail probability for Chi-Square distribution." )' )
write ( *, '( "Input Chisq Value, Degrees of Freedom: " )', advance='no' )
read ( *, * ) chisq_value, DoF
Upper_Tail_Prob = gsl_cdf_chisq_Q ( chisq_value, DoF )
write ( *, '( "Probability is:", 1PG17.10 )' ) Upper_Tail_Prob
stop
end program cum_chisq_prob
Even easier: you can find a pre-written library to allow you to call GSL from Fortran at http://www.lrz.de/services/software/mathematik/gsl/fortran/
Most likely you have the linkage between the two routines wrong in some way. If the stack isn't dealt with correctly when you hop through that interface, dang near anything can happen.
I'm not noticing any code on either the Fortran side or the C side specifying the other's calling convention. I'm not an expert with Gnu Fortran, but I know most compilers will require some kind of note that they should be using another compiler's calling convention, or Bad Things may happen.
With just a little web searching, I see that the G95 Fortran manual (PDF) has a nice long section titled "Interfacing with G95 Programs", that appears to go into this in detail. Just from skimming, it looks like you should be using the BIND(C) attribute on your Fortran function declaration for that C routine.
The problem is with the static gsl_rng* r; defined in your C file. But I do not know/understand why the standard does not allow this. After studying the source file of the fgsl package a little bit, I found a tweak that works. The fortran file random_f.f90
module fgsl
use, intrinsic :: iso_c_binding
implicit none
type, bind(C) :: fgsl_rng_type
type(c_ptr) :: gsl_rng_type_ptr = c_null_ptr
end type fgsl_rng_type
type, bind(C) :: fgsl_rng
type(c_ptr) :: gsl_rng_ptr = c_null_ptr
end type fgsl_rng
end module fgsl
PROGRAM call_fgsl_rndm
use, intrinsic :: iso_c_binding
use fgsl
implicit none
interface
subroutine srndm(seed, t, r) bind(C)
import
integer(C_INT) :: seed
type(fgsl_rng) :: r
type(fgsl_rng_type) :: t
end subroutine srndm
function rndm(r) bind(C)
import
real(C_DOUBLE) :: rndm
type(fgsl_rng) :: r
end function rndm
end interface
type(fgsl_rng) :: r
type(fgsl_rng_type) :: t
integer(C_INT) :: seed
real(C_DOUBLE) :: xi
seed = 1
call srndm(seed, t, r)
xi = rndm(r)
print *, xi
xi = rndm(r)
print *, xi
xi = rndm(r)
print *, xi
END PROGRAM
and the C file random_c.c
#include <gsl/gsl_rng.h>
typedef struct{
gsl_rng *gsl_rng_ptr;
} fgsl_rng;
typedef struct{
gsl_rng_type *gsl_rng_type_ptr;
} fgsl_rng_type;
void srndm(int *seed, fgsl_rng_type* t, fgsl_rng* r) {
t->gsl_rng_type_ptr = (gsl_rng_type *) gsl_rng_mt19937; // cast to remove the const qualifier
r->gsl_rng_ptr = gsl_rng_alloc(gsl_rng_mt19937);
gsl_rng_set(r->gsl_rng_ptr, *seed);
}
double rndm(fgsl_rng* r) {
return gsl_rng_uniform(r->gsl_rng_ptr);
}
Although only the pointers in the structures are used, the introduction of fgsl_rng and fgsl_rng_type is necessary. Otherwise, the program will fail. Unfortunately, I still have no clear idea why it has to work this way.