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-2018, 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:- use_module(library(lists), [reverse/2]).   51:- 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. */

  108:- meta_predicate
  109    load_foreign_library(:),
  110    load_foreign_library(:, +),
  111    use_foreign_library(:),
  112    use_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) ]).  137
  138
  139                 /*******************************
  140                 *           DISPATCHING        *
  141                 *******************************/
 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.
  149find_library(Spec, TmpFile, true) :-
  150    '$rc_handle'(Zipper),
  151    term_to_atom(Spec, Name),
  152    setup_call_cleanup(
  153        zip_lock(Zipper),
  154        setup_call_cleanup(
  155            open_foreign_in_resources(Zipper, Name, In),
  156            setup_call_cleanup(
  157                tmp_file_stream(binary, TmpFile, Out),
  158                copy_stream_data(In, Out),
  159                close(Out)),
  160            close(In)),
  161        zip_unlock(Zipper)),
  162    !.
  163find_library(Spec, Lib, Copy) :-
  164    absolute_file_name(Spec, Lib0,
  165                       [ file_type(executable),
  166                         access(read),
  167                         file_errors(fail)
  168                       ]),
  169    !,
  170    lib_to_file(Lib0, Lib, Copy).
  171find_library(Spec, Spec, false) :-
  172    atom(Spec),
  173    !.                  % use machines finding schema
  174find_library(foreign(Spec), Spec, false) :-
  175    atom(Spec),
  176    !.                  % use machines finding schema
  177find_library(Spec, _, _) :-
  178    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
  198lib_to_file(Res, TmpFile, true) :-
  199    sub_atom(Res, 0, _, _, 'res://'),
  200    !,
  201    setup_call_cleanup(
  202        open(Res, read, In, [type(binary)]),
  203        setup_call_cleanup(
  204            tmp_file_stream(binary, TmpFile, Out),
  205            copy_stream_data(In, Out),
  206            close(Out)),
  207        close(In)).
  208lib_to_file(Lib, Lib, false).
  209
  210
  211open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :-
  212    term_to_atom(foreign(Name), ForeignSpecAtom),
  213    zipper_members(Zipper, Entries),
  214    entries_for_name(Name, Entries, Entries1),
  215    compatible_architecture_lib(Entries1, Name, CompatibleLib),
  216    zipper_goto(Zipper, file(CompatibleLib)),
  217    zipper_open_current(Zipper, Stream,
  218                        [ type(binary),
  219                          release(true)
  220                        ]).
 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 compat_arch/2 hook.

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

  235compatible_architecture_lib([], _, _) :- !, fail.
  236compatible_architecture_lib(Entries, Name, CompatibleLib) :-
  237    current_prolog_flag(arch, HostArch),
  238    (   member(shlib(EntryArch, Name), Entries),
  239        qsave_compat_arch1(HostArch, EntryArch)
  240    ->  term_to_atom(shlib(EntryArch, Name), CompatibleLib)
  241    ;   existence_error(arch_compatible_with(Name), HostArch)
  242    ).
  243
  244qsave_compat_arch1(Arch1, Arch2) :-
  245    qsave:compat_arch(Arch1, Arch2), !.
  246qsave_compat_arch1(Arch1, Arch2) :-
  247    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.
  257:- multifile qsave:compat_arch/2.  258
  259qsave:compat_arch(A,A).
  260
  261shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
  262    sub_atom(Atom, 0, _, _, 'shlib('),
  263    !,
  264    term_to_atom(shlib(Arch,Name), Atom).
  265shlib_atom_to_term(Atom, Atom).
  266
  267match_filespec(Name, shlib(_,Name)).
  268
  269entries_for_name(Name, Entries, Filtered) :-
  270    maplist(shlib_atom_to_term, Entries, Entries1),
  271    include(match_filespec(Name), Entries1, Filtered).
  272
  273base(Path, Base) :-
  274    atomic(Path),
  275    !,
  276    file_base_name(Path, File),
  277    file_name_extension(Base, _Ext, File).
  278base(_/Path, Base) :-
  279    !,
  280    base(Path, Base).
  281base(Path, Base) :-
  282    Path =.. [_,Arg],
  283    base(Arg, Base).
  284
  285entry(_, Function, Function) :-
  286    Function \= default(_),
  287    !.
  288entry(Spec, default(FuncBase), Function) :-
  289    base(Spec, Base),
  290    atomic_list_concat([FuncBase, Base], '_', Function).
  291entry(_, default(Function), Function).
  292
  293                 /*******************************
  294                 *          (UN)LOADING         *
  295                 *******************************/
 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.
  321load_foreign_library(Library) :-
  322    load_foreign_library(Library, default(install)).
  323
  324load_foreign_library(Module:LibFile, Entry) :-
  325    with_mutex('$foreign',
  326               load_foreign_library(LibFile, Module, Entry)).
  327
  328load_foreign_library(LibFile, _Module, _) :-
  329    current_library(LibFile, _, _, _, _),
  330    !.
  331load_foreign_library(LibFile, Module, DefEntry) :-
  332    retractall(error(_, _)),
  333    find_library(LibFile, Path, Delete),
  334    asserta(loading(LibFile)),
  335    retractall(foreign_predicate(LibFile, _)),
  336    catch(Module:open_shared_object(Path, Handle), E, true),
  337    (   nonvar(E)
  338    ->  delete_foreign_lib(Delete, Path),
  339        assert(error(Path, E)),
  340        fail
  341    ;   delete_foreign_lib(Delete, Path)
  342    ),
  343    !,
  344    (   entry(LibFile, DefEntry, Entry),
  345        Module:call_shared_object_function(Handle, Entry)
  346    ->  retractall(loading(LibFile)),
  347        assert_shlib(LibFile, Entry, Path, Module, Handle)
  348    ;   foreign_predicate(LibFile, _)
  349    ->  retractall(loading(LibFile)),    % C++ object installed predicates
  350        assert_shlib(LibFile, 'C++', Path, Module, Handle)
  351    ;   retractall(loading(LibFile)),
  352        retractall(foreign_predicate(LibFile, _)),
  353        close_shared_object(Handle),
  354        findall(Entry, entry(LibFile, DefEntry, Entry), Entries),
  355        throw(error(existence_error(foreign_install_function,
  356                                    install(Path, Entries)),
  357                    _))
  358    ).
  359load_foreign_library(LibFile, _, _) :-
  360    retractall(loading(LibFile)),
  361    (   error(_Path, E)
  362    ->  retractall(error(_, _)),
  363        throw(E)
  364    ;   throw(error(existence_error(foreign_library, LibFile), _))
  365    ).
  366
  367delete_foreign_lib(true, Path) :-
  368    \+ current_prolog_flag(res_keep_foreign, true),
  369    !,
  370    catch(delete_file(Path), _, true).
  371delete_foreign_lib(_, _).
 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.

  391use_foreign_library(FileSpec) :-
  392    initialization(load_foreign_library(FileSpec), now).
  393
  394use_foreign_library(FileSpec, Entry) :-
  395    initialization(load_foreign_library(FileSpec, Entry), now).
 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.
  405unload_foreign_library(LibFile) :-
  406    unload_foreign_library(LibFile, default(uninstall)).
  407
  408unload_foreign_library(LibFile, DefUninstall) :-
  409    with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
  410
  411do_unload(LibFile, DefUninstall) :-
  412    current_library(LibFile, _, _, Module, Handle),
  413    retractall(current_library(LibFile, _, _, _, _)),
  414    (   entry(LibFile, DefUninstall, Uninstall),
  415        Module:call_shared_object_function(Handle, Uninstall)
  416    ->  true
  417    ;   true
  418    ),
  419    abolish_foreign(LibFile),
  420    close_shared_object(Handle).
  421
  422abolish_foreign(LibFile) :-
  423    (   retract(foreign_predicate(LibFile, Module:Head)),
  424        functor(Head, Name, Arity),
  425        abolish(Module:Name, Arity),
  426        fail
  427    ;   true
  428    ).
  429
  430system:'$foreign_registered'(M, H) :-
  431    (   loading(Lib)
  432    ->  true
  433    ;   Lib = '<spontaneous>'
  434    ),
  435    assert(foreign_predicate(Lib, M:H)).
  436
  437assert_shlib(File, Entry, Path, Module, Handle) :-
  438    retractall(current_library(File, _, _, _, _)),
  439    asserta(current_library(File, Entry, Path, Module, Handle)).
  440
  441
  442                 /*******************************
  443                 *       ADMINISTRATION         *
  444                 *******************************/
 current_foreign_library(?File, ?Public)
Query currently loaded shared libraries.
  450current_foreign_library(File, Public) :-
  451    current_library(File, _Entry, _Path, _Module, _Handle),
  452    findall(Pred, foreign_predicate(File, Pred), Public).
  453
  454
  455                 /*******************************
  456                 *            RELOAD            *
  457                 *******************************/
 reload_foreign_libraries
Reload all foreign libraries loaded (after restore of a state created using qsave_program/2.
  464reload_foreign_libraries :-
  465    findall(lib(File, Entry, Module),
  466            (   retract(current_library(File, Entry, _, Module, _)),
  467                File \== -
  468            ),
  469            Libs),
  470    reverse(Libs, Reversed),
  471    reload_libraries(Reversed).
  472
  473reload_libraries([]).
  474reload_libraries([lib(File, Entry, Module)|T]) :-
  475    (   load_foreign_library(File, Module, Entry)
  476    ->  true
  477    ;   print_message(error, shlib(File, load_failed))
  478    ),
  479    reload_libraries(T).
  480
  481
  482                 /*******************************
  483                 *     CLEANUP (WINDOWS ...)    *
  484                 *******************************/
  485
  486/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  487Called from Halt() in pl-os.c (if it  is defined), *after* all at_halt/1
  488hooks have been executed, and after   dieIO(),  closing and flushing all
  489files has been called.
  490
  491On Unix, this is not very useful, and can only lead to conflicts.
  492- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  493
  494unload_all_foreign_libraries :-
  495    current_prolog_flag(unload_foreign_libraries, true),
  496    !,
  497    forall(current_library(File, _, _, _, _),
  498           unload_foreign(File)).
  499unload_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.
  508unload_foreign(File) :-
  509    unload_foreign_library(File),
  510    (   clause(foreign_predicate(Lib, M:H), true, Ref),
  511        (   Lib == '<spontaneous>'
  512        ->  functor(H, Name, Arity),
  513            abolish(M:Name, Arity),
  514            erase(Ref),
  515            fail
  516        ;   !
  517        )
  518    ->  true
  519    ;   true
  520    ).
 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.
  531win_add_dll_directory(Dir) :-
  532    (   current_prolog_flag(windows, true)
  533    ->  (   catch(win_add_dll_directory(Dir, _), _, fail)
  534        ->  true
  535        ;   prolog_to_os_filename(Dir, OSDir),
  536            getenv('PATH', Path0),
  537            atomic_list_concat([Path0, OSDir], ';', Path),
  538            setenv('PATH', Path)
  539        )
  540    ;   domain_error(operating_system, windows)
  541    ).
  542
  543                 /*******************************
  544                 *            MESSAGES          *
  545                 *******************************/
  546
  547:- multifile
  548    prolog:message//1,
  549    prolog:error_message//1.  550
  551prolog:message(shlib(LibFile, load_failed)) -->
  552    [ '~w: Failed to load file'-[LibFile] ].
  553prolog:message(shlib(not_supported)) -->
  554    [ 'Emulator does not support foreign libraries' ].
  555
  556prolog:error_message(existence_error(foreign_install_function,
  557                                     install(Lib, List))) -->
  558    [ 'No install function in ~q'-[Lib], nl,
  559      '\tTried: ~q'-[List]
  560    ]