Динамические библиотеки Fortran, загрузка во время выполнения?

Question

Возможно ли, чтобы программа Fortran загружала библиотеку Fortran во время выполнения? Если это так, можно ли изменить функцию и перекомпилировать только библиотеку, чтобы первоначально скомпилированная программа вызывала измененную функцию в библиотеке во время выполнения?

Если кто-то может предоставить минимальный рабочий пример того, как это можно было бы добиться, это было бы здорово.

Answer 1

Вот некоторые несколько ссылок, которые могут быть полезны:

• Это page on rosettacode.org, который дает полный пример с подробной информацией и обсуждения реализации на Linux и MacOS
• Это intel forum post где Стив Лайонел дать несколько советов о том, как это сделать динамическая загрузка с ifort
• это IBM page с большим объяснения динамических библиотек и их использования

Если вам нужен небольшой код для понимания, продолжайте читать. Несколько дней назад я играл с динамической загрузкой. Мой тестовый код ниже может помочь вам. Однако я работаю в среде linux, и вам, возможно, придется немного приспособить здесь кое-что для работы в среде OS X. rosettacode.org link выше поможет вам.

Вот код для тестовой динамической Lib

[username@hostname:~/test]$cat test.f90 

module test 
    use, intrinsic :: iso_c_binding 
contains 
    subroutine t_times2(v_in, v_out) bind(c, name='t_times2') 
     integer, intent(in) :: v_in 
     integer, intent(out) :: v_out 
     ! 
     v_out=v_in*2 
    end subroutine t_times2 
    ! 
    subroutine t_square(v_in, v_out) bind(c, name='t_square') 
     integer(c_int), intent(in) :: v_in 
     integer(c_int), intent(out) :: v_out 
     ! 
     v_out=v_in**2 
    end subroutine t_square 
end module test 

Составлено в

[username@hostname:~/test]$gfortran -c test.f90 
[username@hostname:~/test]$gfortran -shared -o test.so test.o 

Вот тестовая программа

[username@hostname:~/test]$cat example.f90 
program example 
    use :: iso_c_binding 
implicit none 

    integer(c_int), parameter :: rtld_lazy=1 ! value extracte from the C header file 
    integer(c_int), parameter :: rtld_now=2 ! value extracte from the C header file 
    ! 
    ! interface to linux API 
    interface 
     function dlopen(filename,mode) bind(c,name="dlopen") 
      ! void *dlopen(const char *filename, int mode); 
      use iso_c_binding 
      implicit none 
      type(c_ptr) :: dlopen 
      character(c_char), intent(in) :: filename(*) 
      integer(c_int), value :: mode 
     end function 

     function dlsym(handle,name) bind(c,name="dlsym") 
      ! void *dlsym(void *handle, const char *name); 
      use iso_c_binding 
      implicit none 
      type(c_funptr) :: dlsym 
      type(c_ptr), value :: handle 
      character(c_char), intent(in) :: name(*) 
     end function 

     function dlclose(handle) bind(c,name="dlclose") 
      ! int dlclose(void *handle); 
      use iso_c_binding 
      implicit none 
      integer(c_int) :: dlclose 
      type(c_ptr), value :: handle 
     end function 
    end interface 

    ! Define interface of call-back routine. 
    abstract interface 
     subroutine called_proc (i, i2) bind(c) 
      use, intrinsic :: iso_c_binding 
      integer(c_int), intent(in) :: i 
      integer(c_int), intent(out) :: i2 
     end subroutine called_proc 
    end interface 

    ! testing the dynamic loading 
    integer i, i2 
    type(c_funptr) :: proc_addr 
    type(c_ptr) :: handle 
    character(256) :: pName, lName 

    procedure(called_proc), bind(c), pointer :: proc 
    ! 
    i = 15 

    handle=dlopen("./test.so"//c_null_char, RTLD_LAZY) 
    if (.not. c_associated(handle))then 
     print*, 'Unable to load DLL ./test.so' 
     stop 
    end if 
    ! 
    proc_addr=dlsym(handle, "t_times2"//c_null_char) 
    if (.not. c_associated(proc_addr))then 
     write(*,*) 'Unable to load the procedure t_times2' 
     stop 
    end if 
    call c_f_procpointer(proc_addr, proc) 
    call proc(i,i2) 
    write(*,*) "t_times2, i2=", i2 
    ! 
    proc_addr=dlsym(handle, "t_square"//c_null_char) 
    if (.not. c_associated(proc_addr))then 
     write(*,*)'Unable to load the procedure t_square' 
     stop 
    end if 
    call c_f_procpointer(proc_addr, proc) 
    call proc(i,i2) 
    write(*,*) "t_square, i2=", i2 
contains 
end program example 

Составитель и работать как:

[username@hostname:~/test]$gfortran -o example example.f90 -ldl 
[username@hostname:~/test]$./example 
t_times2, i2=   30 
t_square, i2=   225 
[username@hostname:~/test]$