Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Beginner
48 Views

Passing a string from Fortran DLL to a Fortran program

Jump to solution

Hi all,
I have a DLL written in Fortran and I want to write a main program (always in Fortran) accessing some of the subroutines included in the DLL. I followed the guide provided by Intel, and this is my code for creating the DLL:

module mymodule
contains
    subroutine test1(myinput,myoutput)! bind(c, name='test1')
        !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE, ALIAS:"test1" :: test1
        real*8             , intent(in)    :: myinput
        real*8             , intent(out)   :: myoutput
        !DEC$ ATTRIBUTES REFERENCE :: myinput,myoutput
        !
        myoutput = 10*myinput
        !
        write (*,*) 'Myoutput is ( inside DLL) = ', myoutput
        !
    end subroutine test1
    !
    subroutine test2(myinput,myoutput,mystring)! bind(c, name='test2')
        !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE, ALIAS:"test2" :: test2
        real*8             , intent(in)    :: myinput
        real*8             , intent(out)   :: myoutput
        character(256)     , intent(out)   :: mystring
        !DEC$ ATTRIBUTES REFERENCE :: myinput,myoutput,mystring
        !
        myoutput = 10*myinput
        !
        mystring = 'Hello'
        !
        write (*,*) 'Myoutput is ( inside DLL) = ', myoutput
        write (*,*) 'Mystring is ( inside DLL) = ', trim(adjustl(mystring))
        !
    end subroutine test2
end module

My main is like this:
 

program main1
    use kernel32 ! Declares Windows API routines
    use, intrinsic :: iso_c_binding
    implicit none
    !
    real*8             :: myinput,myoutput
    character(256)     :: mystring
    !
    ABSTRACT INTERFACE
        SUBROUTINE subtest(aa,bb)
        !DEC$ ATTRIBUTES STDCALL,REFERENCE :: subtest
            use, intrinsic :: iso_c_binding
            real*8             , intent(in)    :: aa
            real*8             , intent(out)   :: bb
        END SUBROUTINE subtest
    END INTERFACE
    !
    PROCEDURE(subtest), pointer :: sub1
    !
    integer(C_INTPTR_T)             :: p_sub1
    !
    integer(HANDLE)                 :: dll_handle
    integer(BOOL)                   :: free_status
    !
    write (*,'(A)') "Loading Library..."
    dll_handle = LoadLibrary(lpLibFileName="PATH\mydll.dll"//C_NULL_CHAR)
    ! Check for errors
    if (dll_handle == NULL) then
        ! Failure
        write (*,*) 'DLL NOT FOUND'
        STOP
    endif
    !
    ! Look up the routine address
    write (*,'(A)') "Getting routine address..."
    p_sub1 = GetProcAddress (hModule=dll_handle,lpProcName="test1"//C_NULL_CHAR)
    if (p_sub1 == NULL) then
        ! Failure
        write (*,*) 'FAIL LOOKING UP ROUTINE'
        STOP
    end if
    !
    call C_F_PROCPOINTER (TRANSFER(p_sub1, C_NULL_FUNPTR), sub1)
    !
    myinput = 6
    !
    ! Now call the function
    call sub1(myinput,myoutput)
    !
    write(*,*) 'Myoutput is (outside DLL) = ', myoutput
    !
    ! Unload the library.  This will be done automatically on program
    ! exit but it's good practice anyway
    write(*,'(/A)') "Unloading library..."
    free_status = FreeLibrary (hLibModule=dll_handle)
    if (free_status == 0)  then
        write (*,*) 'FAIL UNLOADING DLL'
        STOP
    endif
end program

And everything is working. If I change my main for calling the other subroutines, containing the string, I obtain an error while debugging: "Run-Time Check Failure #0 - The value of ESP was not properly saved across a function call.  This is usually a result of calling a function declared with one calling convention with a function pointer declared with a different calling convention."

This is the code:

program main2
    use kernel32 ! Declares Windows API routines
    use, intrinsic :: iso_c_binding
    implicit none
    !
    real*8             :: myinput,myoutput
    character(256)     :: mystring
    !
    ABSTRACT INTERFACE
        SUBROUTINE subtest(aa,bb,cc)
        !DEC$ ATTRIBUTES STDCALL,REFERENCE :: subtest
            use, intrinsic :: iso_c_binding
            real*8             , intent(in)    :: aa
            real*8             , intent(out)   :: bb
            character(256)     , intent(out)   :: cc
        END SUBROUTINE subtest
    END INTERFACE
    !
    PROCEDURE(subtest), pointer :: sub2
    !
    integer(C_INTPTR_T)             :: p_sub2
    !
    integer(HANDLE)                 :: dll_handle
    integer(BOOL)                   :: free_status
    !
    write (*,'(A)') "Loading Library..."
    dll_handle = LoadLibrary(lpLibFileName="C:\Users\212744206\Desktop\HTSFlib\HTSFlib\Debug\HTSFlib.dll"//C_NULL_CHAR)
    ! Check for errors
    if (dll_handle == NULL) then
        ! Failure
        write (*,*) 'DLL NOT FOUND'
        STOP
    endif
    !
    ! Look up the routine address
    write (*,'(A)') "Getting routine address..."
    p_sub2 = GetProcAddress (hModule=dll_handle,lpProcName="test2"//C_NULL_CHAR)
    if (p_sub2 == NULL) then
        ! Failure
        write (*,*) 'FAIL LOOKING UP ROUTINE'
        STOP
    end if
    !
    call C_F_PROCPOINTER (TRANSFER(p_sub2, C_NULL_FUNPTR), sub2)
    !
    myinput = 6
    !
    ! Now call the function
    call sub2(myinput,myoutput,mystring)
    !
    write(*,*) 'Myoutput is (outside DLL) = ', myoutput
    write(*,*) 'Mystring is (outside DLL) = ', trim(adjustl(mystring))
    !
    ! Unload the library.  This will be done automatically on program
    ! exit but it's good practice anyway
    write(*,'(/A)') "Unloading library..."
    free_status = FreeLibrary (hLibModule=dll_handle)
    if (free_status == 0)  then
        write (*,*) 'FAIL UNLOADING DLL'
        STOP
    endif
end program

What am I doing wrong? What is the correct procedure for accessing the string? Consider that I am compiling everything at 32bit, and I am using STDCALL because the same DLL has to be read also from VBA.

Thank you

Lorenzo

0 Kudos

Accepted Solutions
Highlighted
Black Belt Retired Employee
48 Views

You forgot to add:

!DEC$ ATTRIBUTES REFERENCE :: cc

in your abstract interface for subtest. This causes the main program to push four elements on the stack (the string length is the fourth) but the subroutine is popping only three, creating stack corruption. Because of your use of procedure pointers, you don't get the normal linker check of the @n suffix.

View solution in original post

0 Kudos
12 Replies
Highlighted
48 Views

Can you make a single routine with an optional argument for the string?

Jim Dempsey

0 Kudos
Highlighted
Black Belt Retired Employee
49 Views

You forgot to add:

!DEC$ ATTRIBUTES REFERENCE :: cc

in your abstract interface for subtest. This causes the main program to push four elements on the stack (the string length is the fourth) but the subroutine is popping only three, creating stack corruption. Because of your use of procedure pointers, you don't get the normal linker check of the @n suffix.

View solution in original post

0 Kudos
Highlighted
Beginner
48 Views

Steve, as always happens, you are right. However it is not clear to me why i need to specify REFERENCE for the string argument. Is it because with REFERENCE option the string is passed without length?

Thank you so much

 

Lorenzo

0 Kudos
Highlighted
Black Belt Retired Employee
48 Views

CHARACTER is a bit confusing in this case. The REFERENCE on the routine only overrides STDCALL's change of default to VALUE. When passing character data, you still get a length unless the character argument itself has REFERENCE. Please see https://software.intel.com/en-us/fortran-compiler-developer-guide-and-reference-attributes for the details.

0 Kudos
Highlighted
Honored Contributor I
48 Views

Lorenzo W. wrote:

.. I have a DLL written in Fortran and I want to write a main program (always in Fortran) accessing some of the subroutines included in the DLL ..

@Lorenzo W.,

If you are able to change existing subroutines or working on writing new subroutines and your scenario is indeed as you state above, you may want to consider standard Fortran code only with default conventions ; that is, go with portable approach as much as possible rather than use Microsoft-specific STDCALL convention and/or compiler-specific compilation directives.

0 Kudos
Highlighted
Black Belt Retired Employee
48 Views

He also has to call the DLL routine from VBA, which means STDCALL (though maybe there's a way to declare a C convention in VBA? I don't know.)

0 Kudos
Highlighted
Honored Contributor I
48 Views

Steve Lionel (Ret.) (Blackbelt) wrote:

He also has to call the DLL routine from VBA, which means STDCALL (though maybe there's a way to declare a C convention in VBA? I don't know.)

I missed out on the point about VBA in a 32-bit environment.  In that case there's no doing way with the STDCALL convention per Microsoft.  But coders, if they are so inclined, can still try to limit the stuff that is extraneous to a language, say only make an allowance for 'IDIR$ ATTRIBUTES STDCA:LL :: procname' directive in their code.

 

 

0 Kudos
Highlighted
Black Belt Retired Employee
48 Views

Right, and Intel Fortran now allows you to say ATTRIBUTES STDCALL and BIND(C) for a procedure. In the early implementations, this combination was not accepted.

0 Kudos
Highlighted
Honored Contributor I
48 Views

Steve Lionel (Ret.) (Blackbelt) wrote:

Right, and Intel Fortran now allows you to say ATTRIBUTES STDCALL and BIND(C) for a procedure. In the early implementations, this combination was not accepted.

if the Intel Fortran team and the product and documentation writers are reading this, hopefully they will be inclined to follow up and update the examples or include additional ones (such as toward the DLL with VBA case) that employ as much standard Fortran via C bindings as possible.

Same holds for Intel Fortran's kernel32.f90 e.g., the offered interface for GetProcAddress should really be as following so the users don't need to do the silly 'casting' using TRANSFER intrinsic of the GetProcAddress function result to arrive at the Fortran procedure pointer with C_F_PROCPOINTER function.

module Kernel32

   use, intrinsic :: iso_c_binding, only : HMODULE => c_intptr_t, c_char, c_funptr

   interface

      function GetProcAddress( DllHandle, ProcName ) bind(C, name='GetProcAddress') result(RetVal)
         !DIR$ ATTRIBUTES STDCALL :: GetProcAddress

      ! Microsoft function prototype
      ! https://docs.microsoft.com/en-us/windows/win32/api/libloaderapi/nf-libloaderapi-getprocaddress
      ! FARPROC GetProcAddress(
      !   HMODULE hModule,
      !   LPCSTR  lpProcName
      ! );

         import :: HMODULE, c_char, c_funptr

         !.. Argument list
         integer(HMODULE), intent(in), value :: DllHandle
         character(kind=c_char), intent(in)  :: ProcName(*)
         !.. Function result
         type(c_funptr) :: RetVal

      end function GetProcAddress

   end interface

end module

 

0 Kudos
Highlighted
Black Belt Retired Employee
48 Views

"Heck no!" to your suggested rewrite of GetProcAddress. That would instantly break untold numbers of existing programs. You may have noticed a lot of entries in KERNEL32 use BIND(C). I spent months working on this in my last year or so at Intel, adding hundreds of new entry points and cleaning up some old ones. But I took care never to introduce an incompatibility.

0 Kudos
Highlighted
Honored Contributor I
48 Views

Steve Lionel (Ret.) (Blackbelt) wrote:

"Heck no!" to your suggested rewrite of GetProcAddress. .. never to introduce an incompatibility.

Heck, the Intel team would only be limited by its failure of imagination.  There are any number options the Intel team can bring to bear should it be so inclined to help advance its customers and reduce vulnerabilities, the simplest one to consider first will be generic interfaces.  The matter is only one of Intel team having a will to delight its customers.

 

0 Kudos
Highlighted
Black Belt Retired Employee
48 Views

Generic interfaces are used - we added a lot to deal with bad Microsoft definitions of character arguments, and added IGNORE_LOC to make it transparent that some args are pass-by-reference. But you can't do generic resolution based on function result type.

0 Kudos