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). 54 55/** <module> Utility library for loading foreign objects (DLLs, shared objects) 56 57This section discusses the functionality of the (autoload) 58library(shlib), providing an interface to manage shared libraries. We 59describe the procedure for using a foreign resource (DLL in Windows and 60shared object in Unix) called =mylib=. 61 62First, one must assemble the resource and make it compatible to 63SWI-Prolog. The details for this vary between platforms. The swipl-ld(1) 64utility can be used to deal with this in a portable manner. The typical 65commandline is: 66 67 == 68 swipl-ld -o mylib file.{c,o,cc,C} ... 69 == 70 71Make sure that one of the files provides a global function 72=|install_mylib()|= that initialises the module using calls to 73PL_register_foreign(). Here is a simple example file mylib.c, which 74creates a Windows MessageBox: 75 76 == 77 #include <windows.h> 78 #include <SWI-Prolog.h> 79 80 static foreign_t 81 pl_say_hello(term_t to) 82 { char *a; 83 84 if ( PL_get_atom_chars(to, &a) ) 85 { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL); 86 87 PL_succeed; 88 } 89 90 PL_fail; 91 } 92 93 install_t 94 install_mylib() 95 { PL_register_foreign("say_hello", 1, pl_say_hello, 0); 96 } 97 == 98 99Now write a file mylib.pl: 100 101 == 102 :- module(mylib, [ say_hello/1 ]). 103 :- use_foreign_library(foreign(mylib)). 104 == 105 106The file mylib.pl can be loaded as a normal Prolog file and provides the 107predicate defined in C. 108*/ 109 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) ]). 137 138 139%! use_foreign_library(+FileSpec) is det. 140%! use_foreign_library(+FileSpec, +Entry:atom) is det. 141% 142% Load and install a foreign library as load_foreign_library/1,2 and 143% register the installation using initialization/2 with the option 144% `now`. This is similar to using: 145% 146% ``` 147% :- initialization(load_foreign_library(foreign(mylib))). 148% ``` 149% 150% but using the initialization/1 wrapper causes the library to be 151% loaded _after_ loading of the file in which it appears is completed, 152% while use_foreign_library/1 loads the library _immediately_. I.e. 153% the difference is only relevant if the remainder of the file uses 154% functionality of the C-library. 155% 156% As of SWI-Prolog 8.1.22, use_foreign_library/1,2 is in provided as a 157% built-in predicate that, if necessary, loads library(shlib). This 158% implies that these directives can be used without explicitly loading 159% library(shlib) or relying on demand loading. 160 161 162 /******************************* 163 * DISPATCHING * 164 *******************************/ 165 166%! find_library(+LibSpec, -Lib, -Delete) is det. 167% 168% Find a foreign library from LibSpec. If LibSpec is available as 169% a resource, the content of the resource is copied to a temporary 170% file and Delete is unified with =true=. 171 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), _)). 202 203%! lib_to_file(+Lib0, -Lib, -Copy) is det. 204% 205% If Lib0 is not a regular file we need to copy it to a temporary 206% regular file because dlopen() and Windows LoadLibrary() expect a 207% file name. On some systems this can be avoided. Roughly using two 208% approaches (after discussion with Peter Ludemann): 209% 210% - On FreeBSD there is shm_open() to create an anonymous file in 211% memory and than fdlopen() to link this. 212% - In general, we could redefine the system calls open(), etc. to 213% make dlopen() work on non-files. This is highly non-portably 214% though. 215% - We can mount the resource zip using e.g., `fuse-zip` on Linux. 216% This however fails if we include the resources as a string in 217% the executable. 218% 219% @see https://github.com/fancycode/MemoryModule for Windows 220 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 ]). 244 245%! zipper_members_(+Zipper, -Members) is det. 246% 247% Simplified version of zipper_members/2 from library(zip). We already 248% have a lock on the zipper and by moving this here we avoid 249% dependency on another library. 250% 251% @tbd: should we cache this? 252 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 ). 263 264 265%! compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det. 266% 267% Entries is a list of entries in the zip file, which are already 268% filtered to match the shared library identified by `Name`. The 269% filtering is done by entries_for_name/3. 270% 271% CompatibleLib is the name of the entry in the zip file which is 272% compatible with the current architecture. The compatibility is 273% determined according to the description in qsave_program/2 using the 274% qsave:compat_arch/2 hook. 275% 276% The entries are of the form 'shlib(Arch, Name)' 277 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), !. 291 292%! qsave:compat_arch(Arch1, Arch2) is semidet. 293% 294% User definable hook to establish if Arch1 is compatible with Arch2 295% when running a shared object. It is used in saved states produced by 296% qsave_program/2 to determine which shared object to load at runtime. 297% 298% @see `foreign` option in qsave_program/2 for more information. 299 300:- multifile qsave:compat_arch/2. 301 302qsavecompat_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 *******************************/ 344 345%! load_foreign_library(:FileSpec) is det. 346%! load_foreign_library(:FileSpec, +Entry:atom) is det. 347% 348% Load a _|shared object|_ or _DLL_. After loading the Entry 349% function is called without arguments. The default entry function 350% is composed from =install_=, followed by the file base-name. 351% E.g., the load-call below calls the function 352% =|install_mylib()|=. If the platform prefixes extern functions 353% with =_=, this prefix is added before calling. 354% 355% == 356% ... 357% load_foreign_library(foreign(mylib)), 358% ... 359% == 360% 361% @param FileSpec is a specification for absolute_file_name/3. If searching 362% the file fails, the plain name is passed to the OS to try the default 363% method of the OS for locating foreign objects. The default definition 364% of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and 365% <prolog home>/bin on Windows. 366% 367% @see use_foreign_library/1,2 are intended for use in directives. 368 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(_, _). 420 421 422%! unload_foreign_library(+FileSpec) is det. 423%! unload_foreign_library(+FileSpec, +Exit:atom) is det. 424% 425% Unload a _|shared object|_ or _DLL_. After calling the Exit 426% function, the shared object is removed from the process. The 427% default exit function is composed from =uninstall_=, followed by 428% the file base-name. 429 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 *******************************/ 470 471%! current_foreign_library(?File, ?Public) 472% 473% Query currently loaded shared libraries. 474 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 *******************************/ 483 484%! reload_foreign_libraries 485% 486% Reload all foreign libraries loaded (after restore of a state 487% created using qsave_program/2. 488 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. 525 526%! unload_foreign(+File) 527% 528% Unload the given foreign file and all `spontaneous' foreign 529% predicates created afterwards. Handling these spontaneous 530% predicates is a bit hard, as we do not know who created them and 531% on which library they depend. 532 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 ). 546 547 548%! win_add_dll_directory(+AbsDir) is det. 549% 550% Add AbsDir to the directories where dependent DLLs are searched 551% on Windows systems. 552% 553% @error domain_error(operating_system, windows) if the current OS 554% is not Windows. 555 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 576prologmessage(shlib(LibFile, load_failed)) --> 577 [ '~w: Failed to load file'-[LibFile] ]. 578prologmessage(shlib(not_supported)) --> 579 [ 'Emulator does not support foreign libraries' ]. 580 581prologerror_message(existence_error(foreign_install_function, 582 install(Lib, List))) --> 583 [ 'No install function in ~q'-[Lib], nl, 584 '\tTried: ~q'-[List] 585 ]