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-2022, 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, +InstallFunc
   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, +InstallFunc
   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:- (   current_prolog_flag(open_shared_object, true)
  130   ->  true
  131   ;   print_message(warning, shlib(not_supported)) % error?
  132   ).  133
  134% The flag `res_keep_foreign` prevents deleting  temporary files created
  135% to load shared objects when set  to   `true`.  This  may be needed for
  136% debugging purposes.
  137
  138:- create_prolog_flag(res_keep_foreign, false,
  139                      [ keep(true) ]).
 use_foreign_library(+FileSpec) is det
 use_foreign_library(+FileSpec, +Entry:atom) 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.

  165                 /*******************************
  166                 *           DISPATCHING        *
  167                 *******************************/
 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.
  175find_library(Spec, TmpFile, true) :-
  176    '$rc_handle'(Zipper),
  177    term_to_atom(Spec, Name),
  178    setup_call_cleanup(
  179        zip_lock(Zipper),
  180        setup_call_cleanup(
  181            open_foreign_in_resources(Zipper, Name, In),
  182            setup_call_cleanup(
  183                tmp_file_stream(binary, TmpFile, Out),
  184                copy_stream_data(In, Out),
  185                close(Out)),
  186            close(In)),
  187        zip_unlock(Zipper)),
  188    !.
  189find_library(Spec, Lib, Copy) :-
  190    absolute_file_name(Spec, Lib0,
  191                       [ file_type(executable),
  192                         access(read),
  193                         file_errors(fail)
  194                       ]),
  195    !,
  196    lib_to_file(Lib0, Lib, Copy).
  197find_library(Spec, Spec, false) :-
  198    atom(Spec),
  199    !.                  % use machines finding schema
  200find_library(foreign(Spec), Spec, false) :-
  201    atom(Spec),
  202    !.                  % use machines finding schema
  203find_library(Spec, _, _) :-
  204    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
  224lib_to_file(Res, TmpFile, true) :-
  225    sub_atom(Res, 0, _, _, 'res://'),
  226    !,
  227    setup_call_cleanup(
  228        open(Res, read, In, [type(binary)]),
  229        setup_call_cleanup(
  230            tmp_file_stream(binary, TmpFile, Out),
  231            copy_stream_data(In, Out),
  232            close(Out)),
  233        close(In)).
  234lib_to_file(Lib, Lib, false).
  235
  236
  237open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :-
  238    term_to_atom(foreign(Name), ForeignSpecAtom),
  239    zipper_members_(Zipper, Entries),
  240    entries_for_name(Entries, Name, Entries1),
  241    compatible_architecture_lib(Entries1, Name, CompatibleLib),
  242    zipper_goto(Zipper, file(CompatibleLib)),
  243    zipper_open_current(Zipper, Stream,
  244                        [ type(binary),
  245                          release(true)
  246                        ]).
 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?
  256zipper_members_(Zipper, Members) :-
  257    zipper_goto(Zipper, first),
  258    zip_members__(Zipper, Members).
  259
  260zip_members__(Zipper, [Name|T]) :-
  261    zip_file_info_(Zipper, Name, _Attrs),
  262    (   zipper_goto(Zipper, next)
  263    ->  zip_members__(Zipper, T)
  264    ;   T = []
  265    ).
 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)'

  281compatible_architecture_lib([], _, _) :- !, fail.
  282compatible_architecture_lib(Entries, Name, CompatibleLib) :-
  283    current_prolog_flag(arch, HostArch),
  284    (   member(shlib(EntryArch, Name), Entries),
  285        qsave_compat_arch1(HostArch, EntryArch)
  286    ->  term_to_atom(shlib(EntryArch, Name), CompatibleLib)
  287    ;   existence_error(arch_compatible_with(Name), HostArch)
  288    ).
  289
  290qsave_compat_arch1(Arch1, Arch2) :-
  291    qsave:compat_arch(Arch1, Arch2), !.
  292qsave_compat_arch1(Arch1, Arch2) :-
  293    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.
  303:- multifile qsave:compat_arch/2.  304
  305qsave:compat_arch(A,A).
  306
  307entries_for_name([], _, []).
  308entries_for_name([H0|T0], Name, [H|T]) :-
  309    shlib_atom_to_term(H0, H),
  310    match_filespec(Name, H),
  311    !,
  312    entries_for_name(T0, Name, T).
  313entries_for_name([_|T0], Name, T) :-
  314    entries_for_name(T0, Name, T).
  315
  316shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
  317    sub_atom(Atom, 0, _, _, 'shlib('),
  318    !,
  319    term_to_atom(shlib(Arch,Name), Atom).
  320shlib_atom_to_term(Atom, Atom).
  321
  322match_filespec(Name, shlib(_,Name)).
  323
  324base(Path, Base) :-
  325    atomic(Path),
  326    !,
  327    file_base_name(Path, File),
  328    file_name_extension(Base, _Ext, File).
  329base(_/Path, Base) :-
  330    !,
  331    base(Path, Base).
  332base(Path, Base) :-
  333    Path =.. [_,Arg],
  334    base(Arg, Base).
  335
  336entry(_, Function, Function) :-
  337    Function \= default(_),
  338    !.
  339entry(Spec, default(FuncBase), Function) :-
  340    base(Spec, Base),
  341    atomic_list_concat([FuncBase, Base], '_', Function).
  342entry(_, default(Function), Function).
  343
  344                 /*******************************
  345                 *          (UN)LOADING         *
  346                 *******************************/
 load_foreign_library(:FileSpec) is det
 load_foreign_library(:FileSpec, +Entry:atom) 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.
      ...
      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.
  372load_foreign_library(Library) :-
  373    load_foreign_library(Library, default(install)).
  374
  375load_foreign_library(Module:LibFile, Entry) :-
  376    with_mutex('$foreign',
  377               load_foreign_library(LibFile, Module, Entry)).
  378
  379load_foreign_library(LibFile, _Module, _) :-
  380    current_library(LibFile, _, _, _, _),
  381    !.
  382load_foreign_library(LibFile, Module, DefEntry) :-
  383    retractall(error(_, _)),
  384    find_library(LibFile, Path, Delete),
  385    asserta(loading(LibFile)),
  386    retractall(foreign_predicate(LibFile, _)),
  387    catch(Module:open_shared_object(Path, Handle), E, true),
  388    (   nonvar(E)
  389    ->  delete_foreign_lib(Delete, Path),
  390        assert(error(Path, E)),
  391        fail
  392    ;   delete_foreign_lib(Delete, Path)
  393    ),
  394    !,
  395    (   entry(LibFile, DefEntry, Entry),
  396        Module:call_shared_object_function(Handle, Entry)
  397    ->  retractall(loading(LibFile)),
  398        assert_shlib(LibFile, Entry, Path, Module, Handle)
  399    ;   foreign_predicate(LibFile, _)
  400    ->  retractall(loading(LibFile)),    % C++ object installed predicates
  401        assert_shlib(LibFile, 'C++', Path, Module, Handle)
  402    ;   retractall(loading(LibFile)),
  403        retractall(foreign_predicate(LibFile, _)),
  404        close_shared_object(Handle),
  405        findall(Entry, entry(LibFile, DefEntry, Entry), Entries),
  406        throw(error(existence_error(foreign_install_function,
  407                                    install(Path, Entries)),
  408                    _))
  409    ).
  410load_foreign_library(LibFile, _, _) :-
  411    retractall(loading(LibFile)),
  412    (   error(_Path, E)
  413    ->  retractall(error(_, _)),
  414        throw(E)
  415    ;   throw(error(existence_error(foreign_library, LibFile), _))
  416    ).
  417
  418delete_foreign_lib(true, Path) :-
  419    \+ current_prolog_flag(res_keep_foreign, true),
  420    !,
  421    catch(delete_file(Path), _, true).
  422delete_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.
  433unload_foreign_library(LibFile) :-
  434    unload_foreign_library(LibFile, default(uninstall)).
  435
  436unload_foreign_library(LibFile, DefUninstall) :-
  437    with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
  438
  439do_unload(LibFile, DefUninstall) :-
  440    current_library(LibFile, _, _, Module, Handle),
  441    retractall(current_library(LibFile, _, _, _, _)),
  442    (   entry(LibFile, DefUninstall, Uninstall),
  443        Module:call_shared_object_function(Handle, Uninstall)
  444    ->  true
  445    ;   true
  446    ),
  447    abolish_foreign(LibFile),
  448    close_shared_object(Handle).
  449
  450abolish_foreign(LibFile) :-
  451    (   retract(foreign_predicate(LibFile, Module:Head)),
  452        functor(Head, Name, Arity),
  453        abolish(Module:Name, Arity),
  454        fail
  455    ;   true
  456    ).
  457
  458system:'$foreign_registered'(M, H) :-
  459    (   loading(Lib)
  460    ->  true
  461    ;   Lib = '<spontaneous>'
  462    ),
  463    assert(foreign_predicate(Lib, M:H)).
  464
  465assert_shlib(File, Entry, Path, Module, Handle) :-
  466    retractall(current_library(File, _, _, _, _)),
  467    asserta(current_library(File, Entry, Path, Module, Handle)).
  468
  469
  470                 /*******************************
  471                 *       ADMINISTRATION         *
  472                 *******************************/
 current_foreign_library(?File, ?Public)
Query currently loaded shared libraries.
  478current_foreign_library(File, Public) :-
  479    current_library(File, _Entry, _Path, _Module, _Handle),
  480    findall(Pred, foreign_predicate(File, Pred), Public).
  481
  482
  483                 /*******************************
  484                 *            RELOAD            *
  485                 *******************************/
 reload_foreign_libraries
Reload all foreign libraries loaded (after restore of a state created using qsave_program/2.
  492reload_foreign_libraries :-
  493    findall(lib(File, Entry, Module),
  494            (   retract(current_library(File, Entry, _, Module, _)),
  495                File \== -
  496            ),
  497            Libs),
  498    reverse(Libs, Reversed),
  499    reload_libraries(Reversed).
  500
  501reload_libraries([]).
  502reload_libraries([lib(File, Entry, Module)|T]) :-
  503    (   load_foreign_library(File, Module, Entry)
  504    ->  true
  505    ;   print_message(error, shlib(File, load_failed))
  506    ),
  507    reload_libraries(T).
  508
  509
  510                 /*******************************
  511                 *     CLEANUP (WINDOWS ...)    *
  512                 *******************************/
  513
  514/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  515Called from Halt() in pl-os.c (if it  is defined), *after* all at_halt/1
  516hooks have been executed, and after   dieIO(),  closing and flushing all
  517files has been called.
  518
  519On Unix, this is not very useful, and can only lead to conflicts.
  520- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  521
  522unload_all_foreign_libraries :-
  523    current_prolog_flag(unload_foreign_libraries, true),
  524    !,
  525    forall(current_library(File, _, _, _, _),
  526           unload_foreign(File)).
  527unload_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.
  536unload_foreign(File) :-
  537    unload_foreign_library(File),
  538    (   clause(foreign_predicate(Lib, M:H), true, Ref),
  539        (   Lib == '<spontaneous>'
  540        ->  functor(H, Name, Arity),
  541            abolish(M:Name, Arity),
  542            erase(Ref),
  543            fail
  544        ;   !
  545        )
  546    ->  true
  547    ;   true
  548    ).
  549
  550
  551:- 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.
  564win_add_dll_directory(Dir) :-
  565    win_add_dll_directory(Dir, _),
  566    !.
  567win_add_dll_directory(Dir) :-
  568    prolog_to_os_filename(Dir, OSDir),
  569    getenv('PATH', Path0),
  570    atomic_list_concat([Path0, OSDir], ';', Path),
  571    setenv('PATH', Path).
  572
  573% Under MSYS2, the program is invoked from a bash, with the dll
  574% dependencies (zlib1.dll etc.) in %MINGW_PREFIX%/bin instead of
  575% the installation directory). Here we add this folder to the dll
  576% search path. If MINGW_PREFIX is undefined, the directive is
  577% skipped.
  578
  579add_mingw_dll_directory :-
  580    (   getenv('MINGW_PREFIX', Prefix)
  581    ->  format(atom(Bin), '~w/bin', [Prefix]),
  582        win_add_dll_directory(Bin)
  583    ;   true
  584    ).
  585
  586:- initialization(add_mingw_dll_directory).  587
  588:- endif.  589
  590                 /*******************************
  591                 *            MESSAGES          *
  592                 *******************************/
  593
  594:- multifile
  595    prolog:message//1,
  596    prolog:error_message//1.  597
  598prolog:message(shlib(LibFile, load_failed)) -->
  599    [ '~w: Failed to load file'-[LibFile] ].
  600prolog:message(shlib(not_supported)) -->
  601    [ 'Emulator does not support foreign libraries' ].
  602
  603prolog:error_message(existence_error(foreign_install_function,
  604                                     install(Lib, List))) -->
  605    [ 'No install function in ~q'-[Lib], nl,
  606      '\tTried: ~q'-[List]
  607    ]