- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi,
I have an existing Fortran module which provides interfaces to another dll (let say dll1, also written in Fortran). For each procedure exported from dll1, I have a local procedure which loads the dll if not already loaded and retrieves the procedure pointer using the GetProcAddress method. In the current version the value is assigned to an integer pointer associated to the procedure.
Something like:
interface
subroutine Dll_GetNumericalParameters(CRIT,EPSC,CLIM,NAPM,ALPHA)
!dec$ attributes stdcall :: Dll_GetNumericalParameters
!dec$ attributes reference :: CRIT, EPSC, CLIM, NAPM, ALPHA
integer(4), intent(out) :: NAPM
real(8), intent(out) :: CRIT, CLIM, EPSC, ALPHA
end subroutine Dll_GetNumericalParameters
end interface
pointer(PTR_GetNumericalParameters, Dll_GetNumericalParameters)
The pointer is initialized with:
if (hLib == 0) then
hLib = LoadLibrary(dll1_name)
if (hLib == 0) then
call SysErrorMessage(GetLastError(), DllName)
call RaiseException(#EFFFFFFF, EXCEPTION_NONCONTINUABLE, 0, NULL)
end if
end if
PTR_GetNumericalParameters = GetProcAddress(hLib, "GetNumericalParameters"C)
hLib being the handle of the DLL dll1. This last part of code in located into a single procedure which is called for every method of dll1 I want to access.
Today (mainly because the use of integer pointers is not compliant with the Fortran standard), I would like to use the procedure pointers, in the form of:
interface
subroutine Dll_GetNumericalParameters(CRIT,EPSC,CLIM,NAPM,ALPHA)
!dec$ attributes stdcall :: Dll_GetNumericalParameters
!dec$ attributes reference :: CRIT, EPSC, CLIM, NAPM, ALPHA
integer(4), intent(out) :: NAPM
real(8), intent(out) :: CRIT, CLIM, EPSC, LPHA
end subroutine Dll_GetNumericalParameters
end interface
procedure(Dll_GetNumericalParameters), pointer :: PTR_GetNumericalParameters
But I don't know how to translate the pointer initialization code. Any suggestions?
In the past, Steve Lionel, aka Dr Fortran, gave me a code template showing how to use procedure pointers but the pointer initialization was performed directly inside the routine. I was able to use this method for some fortran modules but my goal today is to avoid rewriting the same initialization code for tens of interface procedures.
Bets regards,
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I use a helper routine to make is more friendly for the Fortran:
! example usage
call GetProcAddress_helper( istat, hLib, procptr1, "ProccName" ) ! proc in dll have names
call GetProcAddress_helper( istat, hLib, procptr2, ord=3_handle ) ! proc in dll is ordinal number 3
subroutine GetProcAddress_helper( istat, lib_hnd, procptr, procname, ord )
use, intrinsic :: ISO_C_BINDING, only: C_LOC, C_NULL_FUNPTR, C_F_PROCPOINTER, C_INTPTR_T
integer, intent(out) :: istat ! exit status OK is 0
integer(handle), intent(in) :: lib_hnd ! handle to dll file
procedure(), intent(inout), pointer :: procptr ! pointer to proc in dll
character(*), intent(in), optional :: procname ! we find proc pointer value by name or ordinal number
integer(handle), intent(in), optional :: ord ! ordinal number
character(256), target :: gbuf
integer(C_INTPTR_T) :: lp_func, iptr
istat = -1 ! error status bad
if ( present(procname) ) then ! do name if present
gbuf = trim(procname)//achar(0)
iptr = transfer( C_LOC(gbuf), 0_C_INTPTR_T )
elseif ( present(ord) ) then ! if no name check if there is an ordinal
iptr = ord
else ! duff call no name and no ordinal
return
endif
lp_func = GetProcAddress(lib_hnd, iptr )
if( lp_func == 0 ) RETURN
call C_F_PROCPOINTER (TRANSFER(lp_func, C_NULL_FUNPTR), procptr )
istat = 0 ! error status good
end subroutine GetProcAddress_helper
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Just a corrigendum of my previous initialization code, which should be:
logical(4) function LoadModuleEx(DllName, ProcName, hLib, PTR_Proc) result(rc)
.../...
if (hLib == 0) then
hLib = LoadLibrary(DllName)
if (hLib == 0) then
call SysErrorMessage(GetLastError(), DllName)
call RaiseException(#EFFFFFFF, EXCEPTION_NONCONTINUABLE, 0, NULL)
end if
end if
PTR_Proc = GetProcAddress(hLib, trim(ProcName)//char(0))
.../...
rc = ...
Function which is called for each procedure of dll1 I want to get a pointer to.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I use a helper routine to make is more friendly for the Fortran:
! example usage
call GetProcAddress_helper( istat, hLib, procptr1, "ProccName" ) ! proc in dll have names
call GetProcAddress_helper( istat, hLib, procptr2, ord=3_handle ) ! proc in dll is ordinal number 3
subroutine GetProcAddress_helper( istat, lib_hnd, procptr, procname, ord )
use, intrinsic :: ISO_C_BINDING, only: C_LOC, C_NULL_FUNPTR, C_F_PROCPOINTER, C_INTPTR_T
integer, intent(out) :: istat ! exit status OK is 0
integer(handle), intent(in) :: lib_hnd ! handle to dll file
procedure(), intent(inout), pointer :: procptr ! pointer to proc in dll
character(*), intent(in), optional :: procname ! we find proc pointer value by name or ordinal number
integer(handle), intent(in), optional :: ord ! ordinal number
character(256), target :: gbuf
integer(C_INTPTR_T) :: lp_func, iptr
istat = -1 ! error status bad
if ( present(procname) ) then ! do name if present
gbuf = trim(procname)//achar(0)
iptr = transfer( C_LOC(gbuf), 0_C_INTPTR_T )
elseif ( present(ord) ) then ! if no name check if there is an ordinal
iptr = ord
else ! duff call no name and no ordinal
return
endif
lp_func = GetProcAddress(lib_hnd, iptr )
if( lp_func == 0 ) RETURN
call C_F_PROCPOINTER (TRANSFER(lp_func, C_NULL_FUNPTR), procptr )
istat = 0 ! error status good
end subroutine GetProcAddress_helper
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you Steve and Andrew,
This helped me a lot, especially in the way I can declare a procedure pointer as an argument, I didn't know I could declare something like:
procedure(), pointer, intent(inout) :: ProcPtr
This was, indeed, my main concern.
Thanky you guys,
Best regards,

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page