View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1995-2023, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(shlib,
   39          [ load_foreign_library/1,     % :LibFile
   40            load_foreign_library/2,     % :LibFile, +Options
   41            unload_foreign_library/1,   % +LibFile
   42            unload_foreign_library/2,   % +LibFile, +UninstallFunc
   43            current_foreign_library/2,  % ?LibFile, ?Public
   44            reload_foreign_libraries/0,
   45                                        % Directives
   46            use_foreign_library/1,      % :LibFile
   47            use_foreign_library/2       % :LibFile, +Options
   48          ]).   49:- if(current_predicate(win_add_dll_directory/2)).   50:- export(win_add_dll_directory/1).   51:- endif.   52
   53:- autoload(library(error),[existence_error/2]).   54:- autoload(library(lists),[member/2,reverse/2]).   55
   56:- set_prolog_flag(generate_debug_info, false).

Utility library for loading foreign objects (DLLs, shared objects)

This section discusses the functionality of the (autoload) library(shlib), providing an interface to manage shared libraries. We describe the procedure for using a foreign resource (DLL in Windows and shared object in Unix) called mylib.

First, one must assemble the resource and make it compatible to SWI-Prolog. The details for this vary between platforms. The swipl-ld(1) utility can be used to deal with this in a portable manner. The typical commandline is:

swipl-ld -o mylib file.{c,o,cc,C} ...

Make sure that one of the files provides a global function install_mylib() that initialises the module using calls to PL_register_foreign(). Here is a simple example file mylib.c, which creates a Windows MessageBox:

#include <windows.h>
#include <SWI-Prolog.h>

static foreign_t
pl_say_hello(term_t to)
{ char *a;

  if ( PL_get_atom_chars(to, &a) )
  { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL);

    PL_succeed;
  }

  PL_fail;
}

install_t
install_mylib()
{ PL_register_foreign("say_hello", 1, pl_say_hello, 0);
}

Now write a file mylib.pl:

:- module(mylib, [ say_hello/1 ]).
:- use_foreign_library(foreign(mylib)).

The file mylib.pl can be loaded as a normal Prolog file and provides the predicate defined in C. */

  113:- meta_predicate
  114    load_foreign_library(:),
  115    load_foreign_library(:, +).  116
  117:- dynamic
  118    loading/1,                      % Lib
  119    error/2,                        % File, Error
  120    foreign_predicate/2,            % Lib, Pred
  121    current_library/5.              % Lib, Entry, Path, Module, Handle
  122
  123:- volatile                             % Do not store in state
  124    loading/1,
  125    error/2,
  126    foreign_predicate/2,
  127    current_library/5.  128
  129:- '$notransact'((loading/1,
  130                  error/2,
  131                  foreign_predicate/2,
  132                  current_library/5)).  133
  134:- (   current_prolog_flag(open_shared_object, true)
  135   ->  true
  136   ;   print_message(warning, shlib(not_supported)) % error?
  137   ).  138
  139% The flag `res_keep_foreign` prevents deleting  temporary files created
  140% to load shared objects when set  to   `true`.  This  may be needed for
  141% debugging purposes.
  142
  143:- create_prolog_flag(res_keep_foreign, false,
  144                      [ keep(true) ]).
 use_foreign_library(+FileSpec) is det
 use_foreign_library(+FileSpec, +Options:list) is det
Load and install a foreign library as load_foreign_library/1,2 and register the installation using initialization/2 with the option now. This is similar to using:
:- initialization(load_foreign_library(foreign(mylib))).

but using the initialization/1 wrapper causes the library to be loaded after loading of the file in which it appears is completed, while use_foreign_library/1 loads the library immediately. I.e. the difference is only relevant if the remainder of the file uses functionality of the C-library.

As of SWI-Prolog 8.1.22, use_foreign_library/1,2 is in provided as a built-in predicate that, if necessary, loads library(shlib). This implies that these directives can be used without explicitly loading library(shlib) or relying on demand loading.

  170                 /*******************************
  171                 *           DISPATCHING        *
  172                 *******************************/
 find_library(+LibSpec, -Lib, -Delete) is det
Find a foreign library from LibSpec. If LibSpec is available as a resource, the content of the resource is copied to a temporary file and Delete is unified with true.
  180find_library(Spec, TmpFile, true) :-
  181    '$rc_handle'(Zipper),
  182    term_to_atom(Spec, Name),
  183    setup_call_cleanup(
  184        zip_lock(Zipper),
  185        setup_call_cleanup(
  186            open_foreign_in_resources(Zipper, Name, In),
  187            setup_call_cleanup(
  188                tmp_file_stream(binary, TmpFile, Out),
  189                copy_stream_data(In, Out),
  190                close(Out)),
  191            close(In)),
  192        zip_unlock(Zipper)),
  193    !.
  194find_library(Spec, Lib, Copy) :-
  195    absolute_file_name(Spec, Lib0,
  196                       [ file_type(executable),
  197                         access(read),
  198                         file_errors(fail)
  199                       ]),
  200    !,
  201    lib_to_file(Lib0, Lib, Copy).
  202find_library(Spec, Spec, false) :-
  203    atom(Spec),
  204    !.                  % use machines finding schema
  205find_library(foreign(Spec), Spec, false) :-
  206    atom(Spec),
  207    !.                  % use machines finding schema
  208find_library(Spec, _, _) :-
  209    throw(error(existence_error(source_sink, Spec), _)).
 lib_to_file(+Lib0, -Lib, -Copy) is det
If Lib0 is not a regular file we need to copy it to a temporary regular file because dlopen() and Windows LoadLibrary() expect a file name. On some systems this can be avoided. Roughly using two approaches (after discussion with Peter Ludemann):
See also
- https://github.com/fancycode/MemoryModule for Windows
  229lib_to_file(Res, TmpFile, true) :-
  230    sub_atom(Res, 0, _, _, 'res://'),
  231    !,
  232    setup_call_cleanup(
  233        open(Res, read, In, [type(binary)]),
  234        setup_call_cleanup(
  235            tmp_file_stream(binary, TmpFile, Out),
  236            copy_stream_data(In, Out),
  237            close(Out)),
  238        close(In)).
  239lib_to_file(Lib, Lib, false).
  240
  241
  242open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :-
  243    term_to_atom(foreign(Name), ForeignSpecAtom),
  244    zipper_members_(Zipper, Entries),
  245    entries_for_name(Entries, Name, Entries1),
  246    compatible_architecture_lib(Entries1, Name, CompatibleLib),
  247    zipper_goto(Zipper, file(CompatibleLib)),
  248    zipper_open_current(Zipper, Stream,
  249                        [ type(binary),
  250                          release(true)
  251                        ]).
 zipper_members_(+Zipper, -Members) is det
Simplified version of zipper_members/2 from library(zip). We already have a lock on the zipper and by moving this here we avoid dependency on another library.
To be done
- : should we cache this?
  261zipper_members_(Zipper, Members) :-
  262    zipper_goto(Zipper, first),
  263    zip_members__(Zipper, Members).
  264
  265zip_members__(Zipper, [Name|T]) :-
  266    zip_file_info_(Zipper, Name, _Attrs),
  267    (   zipper_goto(Zipper, next)
  268    ->  zip_members__(Zipper, T)
  269    ;   T = []
  270    ).
 compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det
Entries is a list of entries in the zip file, which are already filtered to match the shared library identified by Name. The filtering is done by entries_for_name/3.

CompatibleLib is the name of the entry in the zip file which is compatible with the current architecture. The compatibility is determined according to the description in qsave_program/2 using the qsave:compat_arch/2 hook.

The entries are of the form 'shlib(Arch, Name)'

  286compatible_architecture_lib([], _, _) :- !, fail.
  287compatible_architecture_lib(Entries, Name, CompatibleLib) :-
  288    current_prolog_flag(arch, HostArch),
  289    (   member(shlib(EntryArch, Name), Entries),
  290        qsave_compat_arch1(HostArch, EntryArch)
  291    ->  term_to_atom(shlib(EntryArch, Name), CompatibleLib)
  292    ;   existence_error(arch_compatible_with(Name), HostArch)
  293    ).
  294
  295qsave_compat_arch1(Arch1, Arch2) :-
  296    qsave:compat_arch(Arch1, Arch2), !.
  297qsave_compat_arch1(Arch1, Arch2) :-
  298    qsave:compat_arch(Arch2, Arch1), !.
 qsave:compat_arch(Arch1, Arch2) is semidet
User definable hook to establish if Arch1 is compatible with Arch2 when running a shared object. It is used in saved states produced by qsave_program/2 to determine which shared object to load at runtime.
See also
- foreign option in qsave_program/2 for more information.
  308:- multifile qsave:compat_arch/2.  309
  310qsave:compat_arch(A,A).
  311
  312entries_for_name([], _, []).
  313entries_for_name([H0|T0], Name, [H|T]) :-
  314    shlib_atom_to_term(H0, H),
  315    match_filespec(Name, H),
  316    !,
  317    entries_for_name(T0, Name, T).
  318entries_for_name([_|T0], Name, T) :-
  319    entries_for_name(T0, Name, T).
  320
  321shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
  322    sub_atom(Atom, 0, _, _, 'shlib('),
  323    !,
  324    term_to_atom(shlib(Arch,Name), Atom).
  325shlib_atom_to_term(Atom, Atom).
  326
  327match_filespec(Name, shlib(_,Name)).
  328
  329base(Path, Base) :-
  330    atomic(Path),
  331    !,
  332    file_base_name(Path, File),
  333    file_name_extension(Base, _Ext, File).
  334base(_/Path, Base) :-
  335    !,
  336    base(Path, Base).
  337base(Path, Base) :-
  338    Path =.. [_,Arg],
  339    base(Arg, Base).
  340
  341entry(_, Function, Function) :-
  342    Function \= default(_),
  343    !.
  344entry(Spec, default(FuncBase), Function) :-
  345    base(Spec, Base),
  346    atomic_list_concat([FuncBase, Base], '_', Function).
  347entry(_, default(Function), Function).
  348
  349                 /*******************************
  350                 *          (UN)LOADING         *
  351                 *******************************/
 load_foreign_library(:FileSpec) is det
 load_foreign_library(:FileSpec, +Options:list) is det
Load a shared object or DLL. After loading the Entry function is called without arguments. The default entry function is composed from =install_=, followed by the file base-name. E.g., the load-call below calls the function install_mylib(). If the platform prefixes extern functions with =_=, this prefix is added before calling. Options provided are below. Other options are passed to open_shared_object/3.
install(+Function)
Installation function to use. Default is default(install), which derives the function from FileSpec.
    ...
    load_foreign_library(foreign(mylib)),
    ...
Arguments:
FileSpec- is a specification for absolute_file_name/3. If searching the file fails, the plain name is passed to the OS to try the default method of the OS for locating foreign objects. The default definition of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and <prolog home>/bin on Windows.
See also
- use_foreign_library/1,2 are intended for use in directives.
  382load_foreign_library(Library) :-
  383    load_foreign_library(Library, []).
  384
  385load_foreign_library(Module:LibFile, InstallOrOptions) :-
  386    (   is_list(InstallOrOptions)
  387    ->  Options = InstallOrOptions
  388    ;   Options = [install(InstallOrOptions)]
  389    ),
  390    with_mutex('$foreign',
  391               load_foreign_library(LibFile, Module, Options)).
  392
  393load_foreign_library(LibFile, _Module, _) :-
  394    current_library(LibFile, _, _, _, _),
  395    !.
  396load_foreign_library(LibFile, Module, Options) :-
  397    retractall(error(_, _)),
  398    find_library(LibFile, Path, Delete),
  399    asserta(loading(LibFile)),
  400    retractall(foreign_predicate(LibFile, _)),
  401    catch(Module:open_shared_object(Path, Handle, Options), E, true),
  402    (   nonvar(E)
  403    ->  delete_foreign_lib(Delete, Path),
  404        assert(error(Path, E)),
  405        fail
  406    ;   delete_foreign_lib(Delete, Path)
  407    ),
  408    !,
  409    '$option'(install(DefEntry), Options, default(install)),
  410    (   entry(LibFile, DefEntry, Entry),
  411        Module:call_shared_object_function(Handle, Entry)
  412    ->  retractall(loading(LibFile)),
  413        assert_shlib(LibFile, Entry, Path, Module, Handle)
  414    ;   foreign_predicate(LibFile, _)
  415    ->  retractall(loading(LibFile)),    % C++ object installed predicates
  416        assert_shlib(LibFile, 'C++', Path, Module, Handle)
  417    ;   retractall(loading(LibFile)),
  418        retractall(foreign_predicate(LibFile, _)),
  419        close_shared_object(Handle),
  420        findall(Entry, entry(LibFile, DefEntry, Entry), Entries),
  421        throw(error(existence_error(foreign_install_function,
  422                                    install(Path, Entries)),
  423                    _))
  424    ).
  425load_foreign_library(LibFile, _, _) :-
  426    retractall(loading(LibFile)),
  427    (   error(_Path, E)
  428    ->  retractall(error(_, _)),
  429        throw(E)
  430    ;   throw(error(existence_error(foreign_library, LibFile), _))
  431    ).
  432
  433delete_foreign_lib(true, Path) :-
  434    \+ current_prolog_flag(res_keep_foreign, true),
  435    !,
  436    catch(delete_file(Path), _, true).
  437delete_foreign_lib(_, _).
 unload_foreign_library(+FileSpec) is det
 unload_foreign_library(+FileSpec, +Exit:atom) is det
Unload a shared object or DLL. After calling the Exit function, the shared object is removed from the process. The default exit function is composed from =uninstall_=, followed by the file base-name.
  448unload_foreign_library(LibFile) :-
  449    unload_foreign_library(LibFile, default(uninstall)).
  450
  451unload_foreign_library(LibFile, DefUninstall) :-
  452    with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
  453
  454do_unload(LibFile, DefUninstall) :-
  455    current_library(LibFile, _, _, Module, Handle),
  456    retractall(current_library(LibFile, _, _, _, _)),
  457    (   entry(LibFile, DefUninstall, Uninstall),
  458        Module:call_shared_object_function(Handle, Uninstall)
  459    ->  true
  460    ;   true
  461    ),
  462    abolish_foreign(LibFile),
  463    close_shared_object(Handle).
  464
  465abolish_foreign(LibFile) :-
  466    (   retract(foreign_predicate(LibFile, Module:Head)),
  467        functor(Head, Name, Arity),
  468        abolish(Module:Name, Arity),
  469        fail
  470    ;   true
  471    ).
  472
  473system:'$foreign_registered'(M, H) :-
  474    (   loading(Lib)
  475    ->  true
  476    ;   Lib = '<spontaneous>'
  477    ),
  478    assert(foreign_predicate(Lib, M:H)).
  479
  480assert_shlib(File, Entry, Path, Module, Handle) :-
  481    retractall(current_library(File, _, _, _, _)),
  482    asserta(current_library(File, Entry, Path, Module, Handle)).
  483
  484
  485                 /*******************************
  486                 *       ADMINISTRATION         *
  487                 *******************************/
 current_foreign_library(?File, ?Public)
Query currently loaded shared libraries.
  493current_foreign_library(File, Public) :-
  494    current_library(File, _Entry, _Path, _Module, _Handle),
  495    findall(Pred, foreign_predicate(File, Pred), Public).
  496
  497
  498                 /*******************************
  499                 *            RELOAD            *
  500                 *******************************/
 reload_foreign_libraries
Reload all foreign libraries loaded (after restore of a state created using qsave_program/2.
  507reload_foreign_libraries :-
  508    findall(lib(File, Entry, Module),
  509            (   retract(current_library(File, Entry, _, Module, _)),
  510                File \== -
  511            ),
  512            Libs),
  513    reverse(Libs, Reversed),
  514    reload_libraries(Reversed).
  515
  516reload_libraries([]).
  517reload_libraries([lib(File, Entry, Module)|T]) :-
  518    (   load_foreign_library(File, Module, Entry)
  519    ->  true
  520    ;   print_message(error, shlib(File, load_failed))
  521    ),
  522    reload_libraries(T).
  523
  524
  525                 /*******************************
  526                 *     CLEANUP (WINDOWS ...)    *
  527                 *******************************/
  528
  529/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  530Called from Halt() in pl-os.c (if it  is defined), *after* all at_halt/1
  531hooks have been executed, and after   dieIO(),  closing and flushing all
  532files has been called.
  533
  534On Unix, this is not very useful, and can only lead to conflicts.
  535- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  536
  537unload_all_foreign_libraries :-
  538    current_prolog_flag(unload_foreign_libraries, true),
  539    !,
  540    forall(current_library(File, _, _, _, _),
  541           unload_foreign(File)).
  542unload_all_foreign_libraries.
 unload_foreign(+File)
Unload the given foreign file and all `spontaneous' foreign predicates created afterwards. Handling these spontaneous predicates is a bit hard, as we do not know who created them and on which library they depend.
  551unload_foreign(File) :-
  552    unload_foreign_library(File),
  553    (   clause(foreign_predicate(Lib, M:H), true, Ref),
  554        (   Lib == '<spontaneous>'
  555        ->  functor(H, Name, Arity),
  556            abolish(M:Name, Arity),
  557            erase(Ref),
  558            fail
  559        ;   !
  560        )
  561    ->  true
  562    ;   true
  563    ).
  564
  565
  566:- if(current_predicate(win_add_dll_directory/2)).
 win_add_dll_directory(+AbsDir) is det
Add AbsDir to the directories where dependent DLLs are searched on Windows systems. This call uses the AddDllDirectory() API when provided. On older Windows systems it extends %PATH%.
Errors
- existence_error(directory, AbsDir) if the target directory does not exist.
- domain_error(absolute_file_name, AbsDir) if AbsDir is not an absolute file name.
  579win_add_dll_directory(Dir) :-
  580    win_add_dll_directory(Dir, _),
  581    !.
  582win_add_dll_directory(Dir) :-
  583    prolog_to_os_filename(Dir, OSDir),
  584    getenv('PATH', Path0),
  585    atomic_list_concat([Path0, OSDir], ';', Path),
  586    setenv('PATH', Path).
  587
  588% Environments such as MSYS2 and  CONDA   install  DLLs in some separate
  589% directory. We add these directories to   the  search path for indirect
  590% dependencies from ours foreign plugins.
  591
  592add_dll_directories :-
  593    current_prolog_flag(msys2, true),
  594    !,
  595    env_add_dll_dir('MINGW_PREFIX', '/bin').
  596add_dll_directories :-
  597    current_prolog_flag(conda, true),
  598    !,
  599    env_add_dll_dir('CONDA_PREFIX', '/Library/bin'),
  600    ignore(env_add_dll_dir('PREFIX', '/Library/bin')).
  601add_dll_directories.
  602
  603env_add_dll_dir(Var, Postfix) :-
  604    getenv(Var, Prefix),
  605    atom_concat(Prefix, Postfix, Dir),
  606    win_add_dll_directory(Dir).
  607
  608:- initialization
  609    add_dll_directories.  610
  611:- endif.  612
  613		 /*******************************
  614		 *          SEARCH PATH		*
  615		 *******************************/
  616
  617:- dynamic
  618    user:file_search_path/2.  619:- multifile
  620    user:file_search_path/2.  621
  622user:file_search_path(foreign, swi(ArchLib)) :-
  623    current_prolog_flag(arch, Arch),
  624    atom_concat('lib/', Arch, ArchLib).
  625user:file_search_path(foreign, swi(SoLib)) :-
  626    (   current_prolog_flag(windows, true)
  627    ->  SoLib = bin
  628    ;   SoLib = lib
  629    ).
  630
  631
  632                 /*******************************
  633                 *            MESSAGES          *
  634                 *******************************/
  635
  636:- multifile
  637    prolog:message//1,
  638    prolog:error_message//1.  639
  640prolog:message(shlib(LibFile, load_failed)) -->
  641    [ '~w: Failed to load file'-[LibFile] ].
  642prolog:message(shlib(not_supported)) -->
  643    [ 'Emulator does not support foreign libraries' ].
  644
  645prolog:error_message(existence_error(foreign_install_function,
  646                                     install(Lib, List))) -->
  647    [ 'No install function in ~q'-[Lib], nl,
  648      '\tTried: ~q'-[List]
  649    ]