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 259qsavecompat_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 ; retractall(loading(LibFile)), 351 retractall(foreign_predicate(LibFile, _)), 352 close_shared_object(Handle), 353 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 354 throw(error(existence_error(foreign_install_function, 355 install(Path, Entries)), 356 _)) 357 ). 358load_foreign_library(LibFile, _, _) :- 359 retractall(loading(LibFile)), 360 ( error(_Path, E) 361 -> retractall(error(_, _)), 362 throw(E) 363 ; throw(error(existence_error(foreign_library, LibFile), _)) 364 ). 365 366delete_foreign_lib(true, Path) :- 367 \+ current_prolog_flag(res_keep_foreign, true), 368 !, 369 catch(delete_file(Path), _, true). 370delete_foreign_lib(_, _). 371 372 373%! use_foreign_library(+FileSpec) is det. 374%! use_foreign_library(+FileSpec, +Entry:atom) is det. 375% 376% Load and install a foreign library as load_foreign_library/1,2 377% and register the installation using initialization/2 with the 378% option =now=. This is similar to using: 379% 380% == 381% :- initialization(load_foreign_library(foreign(mylib))). 382% == 383% 384% but using the initialization/1 wrapper causes the library to be 385% loaded _after_ loading of the file in which it appears is 386% completed, while use_foreign_library/1 loads the library 387% _immediately_. I.e. the difference is only relevant if the 388% remainder of the file uses functionality of the C-library. 389 390use_foreign_library(FileSpec) :- 391 initialization(load_foreign_library(FileSpec), now). 392 393use_foreign_library(FileSpec, Entry) :- 394 initialization(load_foreign_library(FileSpec, Entry), now). 395 396%! unload_foreign_library(+FileSpec) is det. 397%! unload_foreign_library(+FileSpec, +Exit:atom) is det. 398% 399% Unload a _|shared object|_ or _DLL_. After calling the Exit 400% function, the shared object is removed from the process. The 401% default exit function is composed from =uninstall_=, followed by 402% the file base-name. 403 404unload_foreign_library(LibFile) :- 405 unload_foreign_library(LibFile, default(uninstall)). 406 407unload_foreign_library(LibFile, DefUninstall) :- 408 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 409 410do_unload(LibFile, DefUninstall) :- 411 current_library(LibFile, _, _, Module, Handle), 412 retractall(current_library(LibFile, _, _, _, _)), 413 ( entry(LibFile, DefUninstall, Uninstall), 414 Module:call_shared_object_function(Handle, Uninstall) 415 -> true 416 ; true 417 ), 418 abolish_foreign(LibFile), 419 close_shared_object(Handle). 420 421abolish_foreign(LibFile) :- 422 ( retract(foreign_predicate(LibFile, Module:Head)), 423 functor(Head, Name, Arity), 424 abolish(Module:Name, Arity), 425 fail 426 ; true 427 ). 428 429system:'$foreign_registered'(M, H) :- 430 ( loading(Lib) 431 -> true 432 ; Lib = '<spontaneous>' 433 ), 434 assert(foreign_predicate(Lib, M:H)). 435 436assert_shlib(File, Entry, Path, Module, Handle) :- 437 retractall(current_library(File, _, _, _, _)), 438 asserta(current_library(File, Entry, Path, Module, Handle)). 439 440 441 /******************************* 442 * ADMINISTRATION * 443 *******************************/ 444 445%! current_foreign_library(?File, ?Public) 446% 447% Query currently loaded shared libraries. 448 449current_foreign_library(File, Public) :- 450 current_library(File, _Entry, _Path, _Module, _Handle), 451 findall(Pred, foreign_predicate(File, Pred), Public). 452 453 454 /******************************* 455 * RELOAD * 456 *******************************/ 457 458%! reload_foreign_libraries 459% 460% Reload all foreign libraries loaded (after restore of a state 461% created using qsave_program/2. 462 463reload_foreign_libraries :- 464 findall(lib(File, Entry, Module), 465 ( retract(current_library(File, Entry, _, Module, _)), 466 File \== - 467 ), 468 Libs), 469 reverse(Libs, Reversed), 470 reload_libraries(Reversed). 471 472reload_libraries([]). 473reload_libraries([lib(File, Entry, Module)|T]) :- 474 ( load_foreign_library(File, Module, Entry) 475 -> true 476 ; print_message(error, shlib(File, load_failed)) 477 ), 478 reload_libraries(T). 479 480 481 /******************************* 482 * CLEANUP (WINDOWS ...) * 483 *******************************/ 484 485/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 486Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 487hooks have been executed, and after dieIO(), closing and flushing all 488files has been called. 489 490On Unix, this is not very useful, and can only lead to conflicts. 491- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 492 493unload_all_foreign_libraries :- 494 current_prolog_flag(unload_foreign_libraries, true), 495 !, 496 forall(current_library(File, _, _, _, _), 497 unload_foreign(File)). 498unload_all_foreign_libraries. 499 500%! unload_foreign(+File) 501% 502% Unload the given foreign file and all `spontaneous' foreign 503% predicates created afterwards. Handling these spontaneous 504% predicates is a bit hard, as we do not know who created them and 505% on which library they depend. 506 507unload_foreign(File) :- 508 unload_foreign_library(File), 509 ( clause(foreign_predicate(Lib, M:H), true, Ref), 510 ( Lib == '<spontaneous>' 511 -> functor(H, Name, Arity), 512 abolish(M:Name, Arity), 513 erase(Ref), 514 fail 515 ; ! 516 ) 517 -> true 518 ; true 519 ). 520 521 522%! win_add_dll_directory(+AbsDir) is det. 523% 524% Add AbsDir to the directories where dependent DLLs are searched 525% on Windows systems. 526% 527% @error domain_error(operating_system, windows) if the current OS 528% is not Windows. 529 530win_add_dll_directory(Dir) :- 531 ( current_prolog_flag(windows, true) 532 -> ( catch(win_add_dll_directory(Dir, _), _, fail) 533 -> true 534 ; prolog_to_os_filename(Dir, OSDir), 535 getenv('PATH', Path0), 536 atomic_list_concat([Path0, OSDir], ';', Path), 537 setenv('PATH', Path) 538 ) 539 ; domain_error(operating_system, windows) 540 ). 541 542 /******************************* 543 * MESSAGES * 544 *******************************/ 545 546:- multifile 547 prolog:message//1, 548 prolog:error_message//1. 549 550prologmessage(shlib(LibFile, load_failed)) --> 551 [ '~w: Failed to load file'-[LibFile] ]. 552prologmessage(shlib(not_supported)) --> 553 [ 'Emulator does not support foreign libraries' ]. 554 555prologerror_message(existence_error(foreign_install_function, 556 install(Lib, List))) --> 557 [ 'No install function in ~q'-[Lib], nl, 558 '\tTried: ~q'-[List] 559 ]