!> Version: experimental
!>
!> Cross-platform run-time loading of shared libraries (`.so` / `.dll` / `.dylib`),
!> in the spirit of `numpy.ctypeslib.load_library`.
!> ([Specification](../page/specs/stdlib_load_library.html))
!>
!> This file is standard Fortran 2008 and needs no preprocessing: the OS-specific
!> calls (`dlopen` / `LoadLibraryExW`, ...) live in `stdlib_load_library_c.c`,
!> which must be compiled and linked with it. Platform *naming* conventions, on
!> the other hand, are resolved in Fortran through `stdlib_system`.
!>
!> ## Example
!>```fortran
!> type(shared_library_type) :: lib
!> procedure(my_iface), pointer :: f
!>
!> lib = load_library("kernels", path="./plugins") ! libkernels.so / kernels.dll / ...
!> call c_f_procpointer(lib%symbol("my_func"), f)
!> call f(...)
!> call lib%close()
!>```
!>
!> Error handling follows the `stdlib` convention: when `err` is present the error
!> is returned through it, otherwise the program stops with an error message.
!>
!> Caveats:
!> * Copying a `shared_library_type` (intrinsic assignment) copies the OS handle.
!> Closing one copy invalidates procedure pointers obtained from any copy.
!> There is deliberately no finalizer: unloading must be explicit.
!> * Exported symbols should use `bind(C, name="...")` so their names do not
!> depend on the compiler that built the library.
!> * `global` (`RTLD_GLOBAL`) has no meaning on Windows and is ignored there.
module stdlib_load_library
use, intrinsic :: iso_c_binding, only: c_ptr, c_funptr, c_int, c_size_t, &
c_null_ptr, c_null_funptr, c_null_char, c_associated
use stdlib_kinds, only: c_char
use stdlib_error, only: state_type, STDLIB_VALUE_ERROR
use stdlib_string_type, only: string_type, char
use stdlib_strings, only: starts_with, to_c_char
use stdlib_system, only: OS_TYPE, OS_WINDOWS, OS_MACOS, join_path, FS_ERROR
implicit none
private
public :: shared_library_type
public :: load_library
public :: library_filename
public :: shared_library_suffix
!> Version: experimental
!>
!> Handle on a loaded shared library.
!> ([Specification](../page/specs/stdlib_load_library.html#shared_library_type))
type :: shared_library_type
private
!> OS handle returned by `dlopen` / `LoadLibraryExW`
type(c_ptr) :: handle = c_null_ptr
!> Path of the file that was actually loaded
character(len=:), allocatable :: path
contains
!> Load a shared library into this handle
procedure :: open => lib_open
!> Address of an exported procedure
procedure :: symbol => lib_symbol
!> Address of an exported variable
procedure :: data => lib_data
!> Test whether a symbol is exported
procedure :: has_symbol => lib_has_symbol
!> Unload the library
procedure :: close => lib_close
!> Test whether a library is currently loaded
procedure :: is_loaded => lib_is_loaded
!> Path of the file that was actually loaded
procedure :: filename => lib_filename
end type shared_library_type
!> Size of the error message buffers filled by the C layer
integer, parameter :: ERRBUF_LEN = 512
! ------------------------------------------------------------------
! C layer (stdlib_load_library_c.c). Error messages are written,
! NUL-terminated, to errbuf.
! ------------------------------------------------------------------
interface
function c_loadlib_open(filename, global, errbuf, errlen) &
bind(C, name="stdlib_loadlib_open") result(handle)
import :: c_ptr, c_char, c_int, c_size_t
character(kind=c_char), intent(in) :: filename(*)
integer(c_int), value :: global
character(kind=c_char), intent(out) :: errbuf(*)
integer(c_size_t), value :: errlen
type(c_ptr) :: handle
end function c_loadlib_open
function c_loadlib_symbol(handle, name, errbuf, errlen) &
bind(C, name="stdlib_loadlib_symbol") result(fptr)
import :: c_ptr, c_funptr, c_char, c_size_t
type(c_ptr), value :: handle
character(kind=c_char), intent(in) :: name(*)
character(kind=c_char), intent(out) :: errbuf(*)
integer(c_size_t), value :: errlen
type(c_funptr) :: fptr
end function c_loadlib_symbol
function c_loadlib_data(handle, name, errbuf, errlen) &
bind(C, name="stdlib_loadlib_data") result(ptr)
import :: c_ptr, c_char, c_size_t
type(c_ptr), value :: handle
character(kind=c_char), intent(in) :: name(*)
character(kind=c_char), intent(out) :: errbuf(*)
integer(c_size_t), value :: errlen
type(c_ptr) :: ptr
end function c_loadlib_data
function c_loadlib_close(handle, errbuf, errlen) &
bind(C, name="stdlib_loadlib_close") result(rc)
import :: c_ptr, c_char, c_int, c_size_t
type(c_ptr), value :: handle
character(kind=c_char), intent(out) :: errbuf(*)
integer(c_size_t), value :: errlen
integer(c_int) :: rc
end function c_loadlib_close
end interface
contains
! ==================================================================
! Public API
! ==================================================================
!> Version: experimental
!>
!> Load a shared library and return a handle on it.
!>
!> `name` may be a bare name (`"kernels"`), a file name (`"libkernels.so.2"`)
!> or a path (`"./plugins/kernels.dll"`). A name without extension is
!> decorated with the platform prefix/suffix. If `path` is given, the library
!> is searched only in that directory; otherwise the OS search rules apply
!> (`LD_LIBRARY_PATH`, rpath, `PATH`, ...).
function load_library(name, path, global, err) result(lib)
!> Library name, file name or path
character(len=*), intent(in) :: name
!> Optional directory to search in, instead of the OS search rules
character(len=*), intent(in), optional :: path
!> Optional flag to make the library symbols available to libraries
!> loaded afterwards (`RTLD_GLOBAL`). Ignored on Windows
logical, intent(in), optional :: global
!> Optional state return flag. On error, if not requested, the code stops
type(state_type), intent(out), optional :: err
!> Handle on the loaded library
type(shared_library_type) :: lib
call lib%open(name, path, global, err)
end function load_library
!> Version: experimental
!>
!> Platform-decorated file name of a library, e.g. `"fft"` -> `"libfft.so"` / `"fft.dll"`.
!> ([Specification](../page/specs/stdlib_load_library.html#library_filename))
function library_filename(name) result(fname)
!> Undecorated library name
character(len=*), intent(in) :: name
!> Platform-specific file name
character(len=:), allocatable :: fname
if (OS_TYPE() == OS_WINDOWS) then
fname = trim(name)//".dll"
else if (starts_with(trim(name), "lib")) then
fname = trim(name)//shared_library_suffix()
else
fname = "lib"//trim(name)//shared_library_suffix()
end if
end function library_filename
!> Version: experimental
!>
!> Shared library file extension on this platform (`".so"`, `".dll"`, `".dylib"`).
!> ([Specification](../page/specs/stdlib_load_library.html#shared_library_suffix))
function shared_library_suffix() result(suffix)
!> Platform-specific extension, dot included
character(len=:), allocatable :: suffix
select case (OS_TYPE())
case (OS_WINDOWS)
suffix = ".dll"
case (OS_MACOS)
suffix = ".dylib"
case default
suffix = ".so"
end select
end function shared_library_suffix
! ==================================================================
! Type-bound procedures
! ==================================================================
!> Load a shared library into an existing handle.
subroutine lib_open(self, name, path, global, err)
!> Handle on the library. Must not be loaded already
class(shared_library_type), intent(inout) :: self
!> Library name, file name or path
character(len=*), intent(in) :: name
!> Optional directory to search in, instead of the OS search rules
character(len=*), intent(in), optional :: path
!> Optional `RTLD_GLOBAL` flag. Ignored on Windows
logical, intent(in), optional :: global
!> Optional state return flag. On error, if not requested, the code stops
type(state_type), intent(out), optional :: err
type(string_type), allocatable :: candidates(:)
character(len=:), allocatable :: full, report, msg
character(kind=c_char) :: errbuf(ERRBUF_LEN)
type(state_type) :: err0
type(c_ptr) :: h
integer(c_int) :: glob
logical :: use_dir
integer :: i
if (c_associated(self%handle)) then
msg = "shared library '"//self%path//"' is already loaded: call close() first"
err0 = state_type('open', STDLIB_VALUE_ERROR, msg)
call err0%handle(err)
return
end if
glob = 0
if (present(global)) then
if (global) glob = 1
end if
use_dir = .false.
if (present(path)) use_dir = len_trim(path) > 0 .and. .not. has_separator(trim(name))
candidates = candidate_names(trim(name)) ! blank-padded buffers are common
report = ""
do i = 1, size(candidates)
if (use_dir) then
full = join_path(trim(path), char(candidates(i)))
else
full = char(candidates(i))
end if
errbuf = c_null_char
h = c_loadlib_open(to_c_char(full), glob, errbuf, size(errbuf, kind=c_size_t))
if (c_associated(h)) then
self%handle = h
self%path = full
return
end if
if (i > 1) report = report//","
msg = from_c_buffer(errbuf)
report = report//" '"//full//"' ("//msg//")"
end do
msg = "cannot load shared library '"//trim(name)//"'; tried"//report
err0 = FS_ERROR(msg)
call err0%update_location('open')
call err0%handle(err)
end subroutine lib_open
!> Address of an exported procedure, to be used with `c_f_procpointer`.
function lib_symbol(self, name, err) result(fptr)
!> Handle on a loaded library
class(shared_library_type), intent(in) :: self
!> Name of the exported procedure
character(len=*), intent(in) :: name
!> Optional state return flag. On error, if not requested, the code stops
type(state_type), intent(out), optional :: err
!> Address of the procedure, `c_null_funptr` on error
type(c_funptr) :: fptr
type(c_ptr) :: unused
type(state_type) :: err0
call lookup(self, name, .false., fptr, unused, err0)
call err0%handle(err)
end function lib_symbol
!> Address of an exported variable, to be used with `c_f_pointer`.
function lib_data(self, name, err) result(ptr)
!> Handle on a loaded library
class(shared_library_type), intent(in) :: self
!> Name of the exported variable
character(len=*), intent(in) :: name
!> Optional state return flag. On error, if not requested, the code stops
type(state_type), intent(out), optional :: err
!> Address of the variable, `c_null_ptr` on error
type(c_ptr) :: ptr
type(c_funptr) :: unused
type(state_type) :: err0
call lookup(self, name, .true., unused, ptr, err0)
call err0%handle(err)
end function lib_data
!> `.true.` if the library is loaded and exports `name`.
function lib_has_symbol(self, name) result(found)
!> Handle on a library
class(shared_library_type), intent(in) :: self
!> Name of the symbol to look for
character(len=*), intent(in) :: name
!> Whether the symbol is exported
logical :: found
type(c_funptr) :: fptr
type(c_ptr) :: unused
type(state_type) :: err0
call lookup(self, name, .false., fptr, unused, err0)
found = err0%ok()
end function lib_has_symbol
!> Unload the library. Procedure pointers obtained from it become invalid.
!> Closing an unloaded handle is a no-op.
subroutine lib_close(self, err)
!> Handle on the library
class(shared_library_type), intent(inout) :: self
!> Optional state return flag. On error, if not requested, the code stops
type(state_type), intent(out), optional :: err
character(kind=c_char) :: errbuf(ERRBUF_LEN)
character(len=:), allocatable :: msg
type(state_type) :: err0
integer(c_int) :: rc
if (.not. c_associated(self%handle)) return
errbuf = c_null_char
rc = c_loadlib_close(self%handle, errbuf, size(errbuf, kind=c_size_t))
msg = "cannot unload shared library '"//self%path//"': "//from_c_buffer(errbuf)
! The handle is dropped whatever the outcome: a failed unload leaves it
! in an unusable state, and retrying would only leak the reference count
self%handle = c_null_ptr
if (allocated(self%path)) deallocate (self%path)
if (rc /= 0) then
err0 = FS_ERROR(msg)
call err0%update_location('close')
call err0%handle(err)
end if
end subroutine lib_close
!> Whether a library is currently loaded into this handle.
pure function lib_is_loaded(self) result(loaded)
!> Handle on a library
class(shared_library_type), intent(in) :: self
!> Whether a library is loaded
logical :: loaded
loaded = c_associated(self%handle)
end function lib_is_loaded
!> Path of the file that was actually loaded (`""` if none).
pure function lib_filename(self) result(fname)
!> Handle on a library
class(shared_library_type), intent(in) :: self
!> Path of the loaded file
character(len=:), allocatable :: fname
if (allocated(self%path)) then
fname = self%path
else
fname = ""
end if
end function lib_filename
! ==================================================================
! Implementation
! ==================================================================
!> Symbol lookup shared by `symbol()`, `data()` and `has_symbol()`.
!> Only one of `fptr` / `ptr` is set, depending on `is_data`.
subroutine lookup(self, name, is_data, fptr, ptr, err)
class(shared_library_type), intent(in) :: self
character(len=*), intent(in) :: name
logical, intent(in) :: is_data
type(c_funptr), intent(out) :: fptr
type(c_ptr), intent(out) :: ptr
type(state_type), intent(out) :: err
character(kind=c_char) :: errbuf(ERRBUF_LEN)
character(len=:), allocatable :: msg
logical :: found
fptr = c_null_funptr
ptr = c_null_ptr
if (.not. c_associated(self%handle)) then
msg = "cannot look up symbol '"//trim(name)//"': no library is loaded"
err = state_type('symbol', STDLIB_VALUE_ERROR, msg)
return
end if
errbuf = c_null_char
if (is_data) then
ptr = c_loadlib_data(self%handle, to_c_char(trim(name)), errbuf, size(errbuf, kind=c_size_t))
found = c_associated(ptr)
else
fptr = c_loadlib_symbol(self%handle, to_c_char(trim(name)), errbuf, size(errbuf, kind=c_size_t))
found = c_associated(fptr)
end if
if (.not. found) then
msg = "symbol '"//trim(name)//"' not found in '"//self%path//"': "//from_c_buffer(errbuf)
err = FS_ERROR(msg)
call err%update_location('symbol')
end if
end subroutine lookup
!> File names to try, in order, for a user-supplied library name.
function candidate_names(name) result(c)
character(len=*), intent(in) :: name
type(string_type), allocatable :: c(:)
character(len=:), allocatable :: dir, base
integer :: isep
isep = last_separator(name)
dir = name(1:isep)
base = name(isep + 1:)
if (index(base, ".") > 0) then
! Already has an extension (libfoo.so.2, foo.dll, ...): use as is
c = [string_type(name)]
return
end if
select case (OS_TYPE())
case (OS_WINDOWS)
! MSVC-style foo.dll first, then MinGW-style libfoo.dll
c = [string_type(dir//base//".dll")]
if (.not. starts_with(base, "lib")) c = [c, string_type(dir//"lib"//base//".dll")]
case (OS_MACOS)
if (starts_with(base, "lib")) then
c = [string_type(dir//base//".dylib"), string_type(dir//base//".so")]
else
c = [string_type(dir//"lib"//base//".dylib"), string_type(dir//base//".dylib"), &
string_type(dir//"lib"//base//".so"), string_type(dir//base//".so")]
end if
case default
if (starts_with(base, "lib")) then
c = [string_type(dir//base//".so")]
else
c = [string_type(dir//"lib"//base//".so"), string_type(dir//base//".so")]
end if
end select
end function candidate_names
!> Path separators accepted by the OS. Unlike `stdlib_system`'s `path_sep`,
!> both `"/"` and `"\"` are recognized on Windows, as both are accepted there.
function is_separator(ch) result(sep)
character, intent(in) :: ch
logical :: sep
sep = ch == "/"
if (.not. sep .and. ch == achar(92)) sep = OS_TYPE() == OS_WINDOWS
end function is_separator
!> Position of the last path separator in `s`, `0` if there is none.
!> `split_path` is not used here: it normalizes the path, whereas the
!> directory prefix must be preserved verbatim to rebuild candidate names.
function last_separator(s) result(isep)
character(len=*), intent(in) :: s
integer :: isep
integer :: i
isep = 0
do i = len(s), 1, -1
if (is_separator(s(i:i))) then
isep = i
return
end if
end do
end function last_separator
!> Whether `s` carries a directory component.
function has_separator(s) result(found)
character(len=*), intent(in) :: s
logical :: found
found = last_separator(s) > 0
end function has_separator
!> NUL-terminated C buffer -> Fortran string.
!> `stdlib_system`'s `to_f_char` is not reused here: it reads from a `c_ptr`
!> of known length, while the C layer fills a caller-provided array.
pure function from_c_buffer(buf) result(s)
character(kind=c_char), intent(in) :: buf(:)
character(len=:), allocatable :: s
integer :: i, n
n = size(buf)
do i = 1, size(buf)
if (buf(i) == c_null_char) then
n = i - 1
exit
end if
end do
allocate (character(len=n) :: s)
do i = 1, n
s(i:i) = buf(i)
end do
end function from_c_buffer
end module stdlib_load_library
