View source with formatted 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).   52
   53/** <module> Utility library for loading foreign objects (DLLs, shared objects)
   54
   55This   section   discusses   the   functionality   of   the   (autoload)
   56library(shlib), providing an interface to   manage  shared libraries. We
   57describe the procedure for using a foreign  resource (DLL in Windows and
   58shared object in Unix) called =mylib=.
   59
   60First, one must  assemble  the  resource   and  make  it  compatible  to
   61SWI-Prolog. The details for this vary between platforms. The swipl-ld(1)
   62utility can be used to deal with this  in a portable manner. The typical
   63commandline is:
   64
   65        ==
   66        swipl-ld -o mylib file.{c,o,cc,C} ...
   67        ==
   68
   69Make  sure  that  one  of   the    files   provides  a  global  function
   70=|install_mylib()|=  that  initialises  the  module    using   calls  to
   71PL_register_foreign(). Here is a  simple   example  file  mylib.c, which
   72creates a Windows MessageBox:
   73
   74    ==
   75    #include <windows.h>
   76    #include <SWI-Prolog.h>
   77
   78    static foreign_t
   79    pl_say_hello(term_t to)
   80    { char *a;
   81
   82      if ( PL_get_atom_chars(to, &a) )
   83      { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL);
   84
   85        PL_succeed;
   86      }
   87
   88      PL_fail;
   89    }
   90
   91    install_t
   92    install_mylib()
   93    { PL_register_foreign("say_hello", 1, pl_say_hello, 0);
   94    }
   95    ==
   96
   97Now write a file mylib.pl:
   98
   99    ==
  100    :- module(mylib, [ say_hello/1 ]).
  101    :- use_foreign_library(foreign(mylib)).
  102    ==
  103
  104The file mylib.pl can be loaded as a normal Prolog file and provides the
  105predicate defined in C.
  106*/
  107
  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                 *******************************/
  142
  143%!  find_library(+LibSpec, -Lib, -Delete) is det.
  144%
  145%   Find a foreign library from LibSpec.  If LibSpec is available as
  146%   a resource, the content of the resource is copied to a temporary
  147%   file and Delete is unified with =true=.
  148
  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), _)).
  179
  180%!  lib_to_file(+Lib0, -Lib, -Copy) is det.
  181%
  182%   If Lib0 is not a regular file  we   need  to  copy it to a temporary
  183%   regular file because dlopen()  and   Windows  LoadLibrary() expect a
  184%   file name. On some systems this can   be  avoided. Roughly using two
  185%   approaches (after discussion with Peter Ludemann):
  186%
  187%     - On FreeBSD there is shm_open() to create an anonymous file in
  188%       memory and than fdlopen() to link this.
  189%     - In general, we could redefine the system calls open(), etc. to
  190%       make dlopen() work on non-files.  This is highly non-portably
  191%       though.
  192%     - We can mount the resource zip using e.g., `fuse-zip` on Linux.
  193%       This however fails if we include the resources as a string in
  194%       the executable.
  195%
  196%   @see https://github.com/fancycode/MemoryModule for Windows
  197
  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                        ]).
  221
  222%!  compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det.
  223%
  224%   Entries is a list of entries  in   the  zip  file, which are already
  225%   filtered to match the  shared  library   identified  by  `Name`. The
  226%   filtering is done by entries_for_name/3.
  227%
  228%   CompatibleLib is the name of the  entry   in  the  zip file which is
  229%   compatible with the  current  architecture.   The  compatibility  is
  230%   determined according to the description in qsave_program/2 using the
  231%   qsave:compat_arch/2 hook.
  232%
  233%   The entries are of the form 'shlib(Arch, Name)'
  234
  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), !.
  248
  249%!  qsave:compat_arch(Arch1, Arch2) is semidet.
  250%
  251%   User definable hook to establish if   Arch1 is compatible with Arch2
  252%   when running a shared object. It is used in saved states produced by
  253%   qsave_program/2 to determine which shared object to load at runtime.
  254%
  255%   @see `foreign` option in qsave_program/2 for more information.
  256
  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                 *******************************/
  296
  297%!  load_foreign_library(:FileSpec) is det.
  298%!  load_foreign_library(:FileSpec, +Entry:atom) is det.
  299%
  300%   Load a _|shared object|_  or  _DLL_.   After  loading  the Entry
  301%   function is called without arguments. The default entry function
  302%   is composed from =install_=,  followed   by  the file base-name.
  303%   E.g.,    the    load-call    below      calls    the    function
  304%   =|install_mylib()|=. If the platform   prefixes extern functions
  305%   with =_=, this prefix is added before calling.
  306%
  307%     ==
  308%           ...
  309%           load_foreign_library(foreign(mylib)),
  310%           ...
  311%     ==
  312%
  313%   @param  FileSpec is a specification for absolute_file_name/3.  If searching
  314%           the file fails, the plain name is passed to the OS to try the default
  315%           method of the OS for locating foreign objects.  The default definition
  316%           of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and
  317%           <prolog home>/bin on Windows.
  318%
  319%   @see    use_foreign_library/1,2 are intended for use in directives.
  320
  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(_, _).
  372
  373
  374%!  use_foreign_library(+FileSpec) is det.
  375%!  use_foreign_library(+FileSpec, +Entry:atom) is det.
  376%
  377%   Load and install a foreign   library as load_foreign_library/1,2
  378%   and register the installation using   initialization/2  with the
  379%   option =now=. This is similar to using:
  380%
  381%     ==
  382%     :- initialization(load_foreign_library(foreign(mylib))).
  383%     ==
  384%
  385%   but using the initialization/1 wrapper causes  the library to be
  386%   loaded _after_ loading of  the  file   in  which  it  appears is
  387%   completed,  while  use_foreign_library/1  loads    the   library
  388%   _immediately_. I.e. the  difference  is   only  relevant  if the
  389%   remainder of the file uses functionality of the C-library.
  390
  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).
  396
  397%!  unload_foreign_library(+FileSpec) is det.
  398%!  unload_foreign_library(+FileSpec, +Exit:atom) is det.
  399%
  400%   Unload a _|shared object|_ or  _DLL_.   After  calling  the Exit
  401%   function, the shared object is  removed   from  the process. The
  402%   default exit function is composed from =uninstall_=, followed by
  403%   the file base-name.
  404
  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                 *******************************/
  445
  446%!  current_foreign_library(?File, ?Public)
  447%
  448%   Query currently loaded shared libraries.
  449
  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                 *******************************/
  458
  459%!  reload_foreign_libraries
  460%
  461%   Reload all foreign libraries loaded (after restore of a state
  462%   created using qsave_program/2.
  463
  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.
  500
  501%!  unload_foreign(+File)
  502%
  503%   Unload the given foreign file and all `spontaneous' foreign
  504%   predicates created afterwards. Handling these spontaneous
  505%   predicates is a bit hard, as we do not know who created them and
  506%   on which library they depend.
  507
  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    ).
  521
  522
  523%!  win_add_dll_directory(+AbsDir) is det.
  524%
  525%   Add AbsDir to the directories where  dependent DLLs are searched
  526%   on Windows systems.
  527%
  528%   @error domain_error(operating_system, windows) if the current OS
  529%   is not Windows.
  530
  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    ]