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-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).   57
   58/** <module> Utility library for loading foreign objects (DLLs, shared objects)
   59
   60This   section   discusses   the   functionality   of   the   (autoload)
   61library(shlib), providing an interface to   manage  shared libraries. We
   62describe the procedure for using a foreign  resource (DLL in Windows and
   63shared object in Unix) called =mylib=.
   64
   65First, one must  assemble  the  resource   and  make  it  compatible  to
   66SWI-Prolog. The details for this vary between platforms. The swipl-ld(1)
   67utility can be used to deal with this  in a portable manner. The typical
   68commandline is:
   69
   70        ==
   71        swipl-ld -o mylib file.{c,o,cc,C} ...
   72        ==
   73
   74Make  sure  that  one  of   the    files   provides  a  global  function
   75=|install_mylib()|=  that  initialises  the  module    using   calls  to
   76PL_register_foreign(). Here is a  simple   example  file  mylib.c, which
   77creates a Windows MessageBox:
   78
   79    ==
   80    #include <windows.h>
   81    #include <SWI-Prolog.h>
   82
   83    static foreign_t
   84    pl_say_hello(term_t to)
   85    { char *a;
   86
   87      if ( PL_get_atom_chars(to, &a) )
   88      { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL);
   89
   90        PL_succeed;
   91      }
   92
   93      PL_fail;
   94    }
   95
   96    install_t
   97    install_mylib()
   98    { PL_register_foreign("say_hello", 1, pl_say_hello, 0);
   99    }
  100    ==
  101
  102Now write a file mylib.pl:
  103
  104    ==
  105    :- module(mylib, [ say_hello/1 ]).
  106    :- use_foreign_library(foreign(mylib)).
  107    ==
  108
  109The file mylib.pl can be loaded as a normal Prolog file and provides the
  110predicate defined in C.
  111*/
  112
  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) ]).  145
  146
  147%!  use_foreign_library(+FileSpec) is det.
  148%!  use_foreign_library(+FileSpec, +Options:list) is det.
  149%
  150%   Load and install a foreign   library as load_foreign_library/1,2 and
  151%   register the installation using  initialization/2   with  the option
  152%   `now`. This is similar to using:
  153%
  154%   ```
  155%   :- initialization(load_foreign_library(foreign(mylib))).
  156%   ```
  157%
  158%   but using the initialization/1 wrapper  causes   the  library  to be
  159%   loaded _after_ loading of the file in which it appears is completed,
  160%   while use_foreign_library/1 loads the   library  _immediately_. I.e.
  161%   the difference is only relevant if the   remainder  of the file uses
  162%   functionality of the C-library.
  163%
  164%   As of SWI-Prolog 8.1.22, use_foreign_library/1,2 is in provided as a
  165%   built-in predicate that, if necessary,   loads  library(shlib). This
  166%   implies that these directives can be used without explicitly loading
  167%   library(shlib) or relying on demand loading.
  168
  169
  170                 /*******************************
  171                 *           DISPATCHING        *
  172                 *******************************/
  173
  174%!  find_library(+LibSpec, -Lib, -Delete) is det.
  175%
  176%   Find a foreign library from LibSpec.  If LibSpec is available as
  177%   a resource, the content of the resource is copied to a temporary
  178%   file and Delete is unified with =true=.
  179
  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), _)).
  210
  211%!  lib_to_file(+Lib0, -Lib, -Copy) is det.
  212%
  213%   If Lib0 is not a regular file  we   need  to  copy it to a temporary
  214%   regular file because dlopen()  and   Windows  LoadLibrary() expect a
  215%   file name. On some systems this can   be  avoided. Roughly using two
  216%   approaches (after discussion with Peter Ludemann):
  217%
  218%     - On FreeBSD there is shm_open() to create an anonymous file in
  219%       memory and than fdlopen() to link this.
  220%     - In general, we could redefine the system calls open(), etc. to
  221%       make dlopen() work on non-files.  This is highly non-portably
  222%       though.
  223%     - We can mount the resource zip using e.g., `fuse-zip` on Linux.
  224%       This however fails if we include the resources as a string in
  225%       the executable.
  226%
  227%   @see https://github.com/fancycode/MemoryModule for Windows
  228
  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                        ]).
  252
  253%!  zipper_members_(+Zipper, -Members) is det.
  254%
  255%   Simplified version of zipper_members/2 from library(zip). We already
  256%   have a lock  on  the  zipper  and   by  moving  this  here  we avoid
  257%   dependency on another library.
  258%
  259%   @tbd: should we cache this?
  260
  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    ).
  271
  272
  273%!  compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det.
  274%
  275%   Entries is a list of entries  in   the  zip  file, which are already
  276%   filtered to match the  shared  library   identified  by  `Name`. The
  277%   filtering is done by entries_for_name/3.
  278%
  279%   CompatibleLib is the name of the  entry   in  the  zip file which is
  280%   compatible with the  current  architecture.   The  compatibility  is
  281%   determined according to the description in qsave_program/2 using the
  282%   qsave:compat_arch/2 hook.
  283%
  284%   The entries are of the form 'shlib(Arch, Name)'
  285
  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), !.
  299
  300%!  qsave:compat_arch(Arch1, Arch2) is semidet.
  301%
  302%   User definable hook to establish if   Arch1 is compatible with Arch2
  303%   when running a shared object. It is used in saved states produced by
  304%   qsave_program/2 to determine which shared object to load at runtime.
  305%
  306%   @see `foreign` option in qsave_program/2 for more information.
  307
  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                 *******************************/
  352
  353%!  load_foreign_library(:FileSpec) is det.
  354%!  load_foreign_library(:FileSpec, +Options:list) is det.
  355%
  356%   Load a _|shared object|_ or _DLL_.  After loading the Entry function
  357%   is called without arguments. The default  entry function is composed
  358%   from =install_=, followed by the file base-name. E.g., the load-call
  359%   below  calls  the  function  =|install_mylib()|=.  If  the  platform
  360%   prefixes extern functions with =_=,  this   prefix  is  added before
  361%   calling. Options provided are below.  Other   options  are passed to
  362%   open_shared_object/3.
  363%
  364%     - install(+Function)
  365%       Installation function to use.  Default is default(install),
  366%       which derives the function from FileSpec.
  367%
  368%   ```
  369%       ...
  370%       load_foreign_library(foreign(mylib)),
  371%       ...
  372%   ```
  373%
  374%   @arg  FileSpec is a specification for absolute_file_name/3.  If searching
  375%         the file fails, the plain name is passed to the OS to try the default
  376%         method of the OS for locating foreign objects.  The default definition
  377%         of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and
  378%         <prolog home>/bin on Windows.
  379%
  380%   @see  use_foreign_library/1,2 are intended for use in directives.
  381
  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(_, _).
  438
  439
  440%!  unload_foreign_library(+FileSpec) is det.
  441%!  unload_foreign_library(+FileSpec, +Exit:atom) is det.
  442%
  443%   Unload a _|shared object|_ or  _DLL_.   After  calling  the Exit
  444%   function, the shared object is  removed   from  the process. The
  445%   default exit function is composed from =uninstall_=, followed by
  446%   the file base-name.
  447
  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                 *******************************/
  488
  489%!  current_foreign_library(?File, ?Public)
  490%
  491%   Query currently loaded shared libraries.
  492
  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                 *******************************/
  501
  502%!  reload_foreign_libraries
  503%
  504%   Reload all foreign libraries loaded (after restore of a state
  505%   created using qsave_program/2.
  506
  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.
  543
  544%!  unload_foreign(+File)
  545%
  546%   Unload the given foreign file and all `spontaneous' foreign
  547%   predicates created afterwards. Handling these spontaneous
  548%   predicates is a bit hard, as we do not know who created them and
  549%   on which library they depend.
  550
  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)).  567
  568%!  win_add_dll_directory(+AbsDir) is det.
  569%
  570%   Add AbsDir to the directories where   dependent DLLs are searched on
  571%   Windows systems. This  call  uses   the  AddDllDirectory()  API when
  572%   provided. On older Windows systems it extends ``%PATH%``.
  573%
  574%   @error existence_error(directory, AbsDir) if the target directory
  575%   does not exist.
  576%   @error domain_error(absolute_file_name, AbsDir) if AbsDir is not an
  577%   absolute file name.
  578
  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    ]