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-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(shlib,
   38          [ load_foreign_library/1,     % :LibFile
   39            load_foreign_library/2,     % :LibFile, +InstallFunc
   40            unload_foreign_library/1,   % +LibFile
   41            unload_foreign_library/2,   % +LibFile, +UninstallFunc
   42            current_foreign_library/2,  % ?LibFile, ?Public
   43            reload_foreign_libraries/0,
   44                                        % Directives
   45            use_foreign_library/1,      % :LibFile
   46            use_foreign_library/2,      % :LibFile, +InstallFunc
   47
   48            win_add_dll_directory/1     % +Dir
   49          ]).   50:- autoload(library(error),[existence_error/2,domain_error/2]).   51:- autoload(library(lists),[member/2,reverse/2]).   52
   53:- 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. */

  110:- meta_predicate
  111    load_foreign_library(:),
  112    load_foreign_library(:, +).  113
  114:- dynamic
  115    loading/1,                      % Lib
  116    error/2,                        % File, Error
  117    foreign_predicate/2,            % Lib, Pred
  118    current_library/5.              % Lib, Entry, Path, Module, Handle
  119
  120:- volatile                             % Do not store in state
  121    loading/1,
  122    error/2,
  123    foreign_predicate/2,
  124    current_library/5.  125
  126:- (   current_prolog_flag(open_shared_object, true)
  127   ->  true
  128   ;   print_message(warning, shlib(not_supported)) % error?
  129   ).  130
  131% The flag `res_keep_foreign` prevents deleting  temporary files created
  132% to load shared objects when set  to   `true`.  This  may be needed for
  133% debugging purposes.
  134
  135:- create_prolog_flag(res_keep_foreign, false,
  136                      [ 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.

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

  278compatible_architecture_lib([], _, _) :- !, fail.
  279compatible_architecture_lib(Entries, Name, CompatibleLib) :-
  280    current_prolog_flag(arch, HostArch),
  281    (   member(shlib(EntryArch, Name), Entries),
  282        qsave_compat_arch1(HostArch, EntryArch)
  283    ->  term_to_atom(shlib(EntryArch, Name), CompatibleLib)
  284    ;   existence_error(arch_compatible_with(Name), HostArch)
  285    ).
  286
  287qsave_compat_arch1(Arch1, Arch2) :-
  288    qsave:compat_arch(Arch1, Arch2), !.
  289qsave_compat_arch1(Arch1, Arch2) :-
  290    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.
  300:- multifile qsave:compat_arch/2.  301
  302qsave:compat_arch(A,A).
  303
  304entries_for_name([], _, []).
  305entries_for_name([H0|T0], Name, [H|T]) :-
  306    shlib_atom_to_term(H0, H),
  307    match_filespec(Name, H),
  308    !,
  309    entries_for_name(T0, Name, T).
  310entries_for_name([_|T0], Name, T) :-
  311    entries_for_name(T0, Name, T).
  312
  313shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
  314    sub_atom(Atom, 0, _, _, 'shlib('),
  315    !,
  316    term_to_atom(shlib(Arch,Name), Atom).
  317shlib_atom_to_term(Atom, Atom).
  318
  319match_filespec(Name, shlib(_,Name)).
  320
  321base(Path, Base) :-
  322    atomic(Path),
  323    !,
  324    file_base_name(Path, File),
  325    file_name_extension(Base, _Ext, File).
  326base(_/Path, Base) :-
  327    !,
  328    base(Path, Base).
  329base(Path, Base) :-
  330    Path =.. [_,Arg],
  331    base(Arg, Base).
  332
  333entry(_, Function, Function) :-
  334    Function \= default(_),
  335    !.
  336entry(Spec, default(FuncBase), Function) :-
  337    base(Spec, Base),
  338    atomic_list_concat([FuncBase, Base], '_', Function).
  339entry(_, default(Function), Function).
  340
  341                 /*******************************
  342                 *          (UN)LOADING         *
  343                 *******************************/
 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.
  369load_foreign_library(Library) :-
  370    load_foreign_library(Library, default(install)).
  371
  372load_foreign_library(Module:LibFile, Entry) :-
  373    with_mutex('$foreign',
  374               load_foreign_library(LibFile, Module, Entry)).
  375
  376load_foreign_library(LibFile, _Module, _) :-
  377    current_library(LibFile, _, _, _, _),
  378    !.
  379load_foreign_library(LibFile, Module, DefEntry) :-
  380    retractall(error(_, _)),
  381    find_library(LibFile, Path, Delete),
  382    asserta(loading(LibFile)),
  383    retractall(foreign_predicate(LibFile, _)),
  384    catch(Module:open_shared_object(Path, Handle), E, true),
  385    (   nonvar(E)
  386    ->  delete_foreign_lib(Delete, Path),
  387        assert(error(Path, E)),
  388        fail
  389    ;   delete_foreign_lib(Delete, Path)
  390    ),
  391    !,
  392    (   entry(LibFile, DefEntry, Entry),
  393        Module:call_shared_object_function(Handle, Entry)
  394    ->  retractall(loading(LibFile)),
  395        assert_shlib(LibFile, Entry, Path, Module, Handle)
  396    ;   foreign_predicate(LibFile, _)
  397    ->  retractall(loading(LibFile)),    % C++ object installed predicates
  398        assert_shlib(LibFile, 'C++', Path, Module, Handle)
  399    ;   retractall(loading(LibFile)),
  400        retractall(foreign_predicate(LibFile, _)),
  401        close_shared_object(Handle),
  402        findall(Entry, entry(LibFile, DefEntry, Entry), Entries),
  403        throw(error(existence_error(foreign_install_function,
  404                                    install(Path, Entries)),
  405                    _))
  406    ).
  407load_foreign_library(LibFile, _, _) :-
  408    retractall(loading(LibFile)),
  409    (   error(_Path, E)
  410    ->  retractall(error(_, _)),
  411        throw(E)
  412    ;   throw(error(existence_error(foreign_library, LibFile), _))
  413    ).
  414
  415delete_foreign_lib(true, Path) :-
  416    \+ current_prolog_flag(res_keep_foreign, true),
  417    !,
  418    catch(delete_file(Path), _, true).
  419delete_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.
  430unload_foreign_library(LibFile) :-
  431    unload_foreign_library(LibFile, default(uninstall)).
  432
  433unload_foreign_library(LibFile, DefUninstall) :-
  434    with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
  435
  436do_unload(LibFile, DefUninstall) :-
  437    current_library(LibFile, _, _, Module, Handle),
  438    retractall(current_library(LibFile, _, _, _, _)),
  439    (   entry(LibFile, DefUninstall, Uninstall),
  440        Module:call_shared_object_function(Handle, Uninstall)
  441    ->  true
  442    ;   true
  443    ),
  444    abolish_foreign(LibFile),
  445    close_shared_object(Handle).
  446
  447abolish_foreign(LibFile) :-
  448    (   retract(foreign_predicate(LibFile, Module:Head)),
  449        functor(Head, Name, Arity),
  450        abolish(Module:Name, Arity),
  451        fail
  452    ;   true
  453    ).
  454
  455system:'$foreign_registered'(M, H) :-
  456    (   loading(Lib)
  457    ->  true
  458    ;   Lib = '<spontaneous>'
  459    ),
  460    assert(foreign_predicate(Lib, M:H)).
  461
  462assert_shlib(File, Entry, Path, Module, Handle) :-
  463    retractall(current_library(File, _, _, _, _)),
  464    asserta(current_library(File, Entry, Path, Module, Handle)).
  465
  466
  467                 /*******************************
  468                 *       ADMINISTRATION         *
  469                 *******************************/
 current_foreign_library(?File, ?Public)
Query currently loaded shared libraries.
  475current_foreign_library(File, Public) :-
  476    current_library(File, _Entry, _Path, _Module, _Handle),
  477    findall(Pred, foreign_predicate(File, Pred), Public).
  478
  479
  480                 /*******************************
  481                 *            RELOAD            *
  482                 *******************************/
 reload_foreign_libraries
Reload all foreign libraries loaded (after restore of a state created using qsave_program/2.
  489reload_foreign_libraries :-
  490    findall(lib(File, Entry, Module),
  491            (   retract(current_library(File, Entry, _, Module, _)),
  492                File \== -
  493            ),
  494            Libs),
  495    reverse(Libs, Reversed),
  496    reload_libraries(Reversed).
  497
  498reload_libraries([]).
  499reload_libraries([lib(File, Entry, Module)|T]) :-
  500    (   load_foreign_library(File, Module, Entry)
  501    ->  true
  502    ;   print_message(error, shlib(File, load_failed))
  503    ),
  504    reload_libraries(T).
  505
  506
  507                 /*******************************
  508                 *     CLEANUP (WINDOWS ...)    *
  509                 *******************************/
  510
  511/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  512Called from Halt() in pl-os.c (if it  is defined), *after* all at_halt/1
  513hooks have been executed, and after   dieIO(),  closing and flushing all
  514files has been called.
  515
  516On Unix, this is not very useful, and can only lead to conflicts.
  517- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  518
  519unload_all_foreign_libraries :-
  520    current_prolog_flag(unload_foreign_libraries, true),
  521    !,
  522    forall(current_library(File, _, _, _, _),
  523           unload_foreign(File)).
  524unload_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.
  533unload_foreign(File) :-
  534    unload_foreign_library(File),
  535    (   clause(foreign_predicate(Lib, M:H), true, Ref),
  536        (   Lib == '<spontaneous>'
  537        ->  functor(H, Name, Arity),
  538            abolish(M:Name, Arity),
  539            erase(Ref),
  540            fail
  541        ;   !
  542        )
  543    ->  true
  544    ;   true
  545    ).
 win_add_dll_directory(+AbsDir) is det
Add AbsDir to the directories where dependent DLLs are searched on Windows systems.
Errors
- domain_error(operating_system, windows) if the current OS is not Windows.
  556win_add_dll_directory(Dir) :-
  557    (   current_prolog_flag(windows, true)
  558    ->  (   catch(win_add_dll_directory(Dir, _), _, fail)
  559        ->  true
  560        ;   prolog_to_os_filename(Dir, OSDir),
  561            getenv('PATH', Path0),
  562            atomic_list_concat([Path0, OSDir], ';', Path),
  563            setenv('PATH', Path)
  564        )
  565    ;   domain_error(operating_system, windows)
  566    ).
  567
  568                 /*******************************
  569                 *            MESSAGES          *
  570                 *******************************/
  571
  572:- multifile
  573    prolog:message//1,
  574    prolog:error_message//1.  575
  576prolog:message(shlib(LibFile, load_failed)) -->
  577    [ '~w: Failed to load file'-[LibFile] ].
  578prolog:message(shlib(not_supported)) -->
  579    [ 'Emulator does not support foreign libraries' ].
  580
  581prolog:error_message(existence_error(foreign_install_function,
  582                                     install(Lib, List))) -->
  583    [ 'No install function in ~q'-[Lib], nl,
  584      '\tTried: ~q'-[List]
  585    ]