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-2022, 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:- ( current_prolog_flag(open_shared_object, true) 130 -> true 131 ; print_message(warning, shlib(not_supported)) % error? 132 ). 133 134% The flag `res_keep_foreign` prevents deleting temporary files created 135% to load shared objects when set to `true`. This may be needed for 136% debugging purposes. 137 138:- create_prolog_flag(res_keep_foreign, false, 139 [ keep(true) ]). 140 141 142%! use_foreign_library(+FileSpec) is det. 143%! use_foreign_library(+FileSpec, +Options:list) is det. 144% 145% Load and install a foreign library as load_foreign_library/1,2 and 146% register the installation using initialization/2 with the option 147% `now`. This is similar to using: 148% 149% ``` 150% :- initialization(load_foreign_library(foreign(mylib))). 151% ``` 152% 153% but using the initialization/1 wrapper causes the library to be 154% loaded _after_ loading of the file in which it appears is completed, 155% while use_foreign_library/1 loads the library _immediately_. I.e. 156% the difference is only relevant if the remainder of the file uses 157% functionality of the C-library. 158% 159% As of SWI-Prolog 8.1.22, use_foreign_library/1,2 is in provided as a 160% built-in predicate that, if necessary, loads library(shlib). This 161% implies that these directives can be used without explicitly loading 162% library(shlib) or relying on demand loading. 163 164 165 /******************************* 166 * DISPATCHING * 167 *******************************/ 168 169%! find_library(+LibSpec, -Lib, -Delete) is det. 170% 171% Find a foreign library from LibSpec. If LibSpec is available as 172% a resource, the content of the resource is copied to a temporary 173% file and Delete is unified with =true=. 174 175find_library(Spec, TmpFile, true) :- 176 '$rc_handle'(Zipper), 177 term_to_atom(Spec, Name), 178 setup_call_cleanup( 179 zip_lock(Zipper), 180 setup_call_cleanup( 181 open_foreign_in_resources(Zipper, Name, In), 182 setup_call_cleanup( 183 tmp_file_stream(binary, TmpFile, Out), 184 copy_stream_data(In, Out), 185 close(Out)), 186 close(In)), 187 zip_unlock(Zipper)), 188 !. 189find_library(Spec, Lib, Copy) :- 190 absolute_file_name(Spec, Lib0, 191 [ file_type(executable), 192 access(read), 193 file_errors(fail) 194 ]), 195 !, 196 lib_to_file(Lib0, Lib, Copy). 197find_library(Spec, Spec, false) :- 198 atom(Spec), 199 !. % use machines finding schema 200find_library(foreign(Spec), Spec, false) :- 201 atom(Spec), 202 !. % use machines finding schema 203find_library(Spec, _, _) :- 204 throw(error(existence_error(source_sink, Spec), _)). 205 206%! lib_to_file(+Lib0, -Lib, -Copy) is det. 207% 208% If Lib0 is not a regular file we need to copy it to a temporary 209% regular file because dlopen() and Windows LoadLibrary() expect a 210% file name. On some systems this can be avoided. Roughly using two 211% approaches (after discussion with Peter Ludemann): 212% 213% - On FreeBSD there is shm_open() to create an anonymous file in 214% memory and than fdlopen() to link this. 215% - In general, we could redefine the system calls open(), etc. to 216% make dlopen() work on non-files. This is highly non-portably 217% though. 218% - We can mount the resource zip using e.g., `fuse-zip` on Linux. 219% This however fails if we include the resources as a string in 220% the executable. 221% 222% @see https://github.com/fancycode/MemoryModule for Windows 223 224lib_to_file(Res, TmpFile, true) :- 225 sub_atom(Res, 0, _, _, 'res://'), 226 !, 227 setup_call_cleanup( 228 open(Res, read, In, [type(binary)]), 229 setup_call_cleanup( 230 tmp_file_stream(binary, TmpFile, Out), 231 copy_stream_data(In, Out), 232 close(Out)), 233 close(In)). 234lib_to_file(Lib, Lib, false). 235 236 237open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :- 238 term_to_atom(foreign(Name), ForeignSpecAtom), 239 zipper_members_(Zipper, Entries), 240 entries_for_name(Entries, Name, Entries1), 241 compatible_architecture_lib(Entries1, Name, CompatibleLib), 242 zipper_goto(Zipper, file(CompatibleLib)), 243 zipper_open_current(Zipper, Stream, 244 [ type(binary), 245 release(true) 246 ]). 247 248%! zipper_members_(+Zipper, -Members) is det. 249% 250% Simplified version of zipper_members/2 from library(zip). We already 251% have a lock on the zipper and by moving this here we avoid 252% dependency on another library. 253% 254% @tbd: should we cache this? 255 256zipper_members_(Zipper, Members) :- 257 zipper_goto(Zipper, first), 258 zip_members__(Zipper, Members). 259 260zip_members__(Zipper, [Name|T]) :- 261 zip_file_info_(Zipper, Name, _Attrs), 262 ( zipper_goto(Zipper, next) 263 -> zip_members__(Zipper, T) 264 ; T = [] 265 ). 266 267 268%! compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det. 269% 270% Entries is a list of entries in the zip file, which are already 271% filtered to match the shared library identified by `Name`. The 272% filtering is done by entries_for_name/3. 273% 274% CompatibleLib is the name of the entry in the zip file which is 275% compatible with the current architecture. The compatibility is 276% determined according to the description in qsave_program/2 using the 277% qsave:compat_arch/2 hook. 278% 279% The entries are of the form 'shlib(Arch, Name)' 280 281compatible_architecture_lib([], _, _) :- !, fail. 282compatible_architecture_lib(Entries, Name, CompatibleLib) :- 283 current_prolog_flag(arch, HostArch), 284 ( member(shlib(EntryArch, Name), Entries), 285 qsave_compat_arch1(HostArch, EntryArch) 286 -> term_to_atom(shlib(EntryArch, Name), CompatibleLib) 287 ; existence_error(arch_compatible_with(Name), HostArch) 288 ). 289 290qsave_compat_arch1(Arch1, Arch2) :- 291 qsave:compat_arch(Arch1, Arch2), !. 292qsave_compat_arch1(Arch1, Arch2) :- 293 qsave:compat_arch(Arch2, Arch1), !. 294 295%! qsave:compat_arch(Arch1, Arch2) is semidet. 296% 297% User definable hook to establish if Arch1 is compatible with Arch2 298% when running a shared object. It is used in saved states produced by 299% qsave_program/2 to determine which shared object to load at runtime. 300% 301% @see `foreign` option in qsave_program/2 for more information. 302 303:- multifile qsave:compat_arch/2. 304 305qsavecompat_arch(A,A). 306 307entries_for_name([], _, []). 308entries_for_name([H0|T0], Name, [H|T]) :- 309 shlib_atom_to_term(H0, H), 310 match_filespec(Name, H), 311 !, 312 entries_for_name(T0, Name, T). 313entries_for_name([_|T0], Name, T) :- 314 entries_for_name(T0, Name, T). 315 316shlib_atom_to_term(Atom, shlib(Arch, Name)) :- 317 sub_atom(Atom, 0, _, _, 'shlib('), 318 !, 319 term_to_atom(shlib(Arch,Name), Atom). 320shlib_atom_to_term(Atom, Atom). 321 322match_filespec(Name, shlib(_,Name)). 323 324base(Path, Base) :- 325 atomic(Path), 326 !, 327 file_base_name(Path, File), 328 file_name_extension(Base, _Ext, File). 329base(_/Path, Base) :- 330 !, 331 base(Path, Base). 332base(Path, Base) :- 333 Path =.. [_,Arg], 334 base(Arg, Base). 335 336entry(_, Function, Function) :- 337 Function \= default(_), 338 !. 339entry(Spec, default(FuncBase), Function) :- 340 base(Spec, Base), 341 atomic_list_concat([FuncBase, Base], '_', Function). 342entry(_, default(Function), Function). 343 344 /******************************* 345 * (UN)LOADING * 346 *******************************/ 347 348%! load_foreign_library(:FileSpec) is det. 349%! load_foreign_library(:FileSpec, +Options:list) is det. 350% 351% Load a _|shared object|_ or _DLL_. After loading the Entry function 352% is called without arguments. The default entry function is composed 353% from =install_=, followed by the file base-name. E.g., the load-call 354% below calls the function =|install_mylib()|=. If the platform 355% prefixes extern functions with =_=, this prefix is added before 356% calling. Options provided are below. Other options are passed to 357% open_shared_object/3. 358% 359% - install(+Function) 360% Installation function to use. Default is default(install), 361% which derives the function from FileSpec. 362% 363% ``` 364% ... 365% load_foreign_library(foreign(mylib)), 366% ... 367% ``` 368% 369% @arg FileSpec is a specification for absolute_file_name/3. If searching 370% the file fails, the plain name is passed to the OS to try the default 371% method of the OS for locating foreign objects. The default definition 372% of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and 373% <prolog home>/bin on Windows. 374% 375% @see use_foreign_library/1,2 are intended for use in directives. 376 377load_foreign_library(Library) :- 378 load_foreign_library(Library, []). 379 380load_foreign_library(Module:LibFile, InstallOrOptions) :- 381 ( is_list(InstallOrOptions) 382 -> Options = InstallOrOptions 383 ; Options = [install(InstallOrOptions)] 384 ), 385 with_mutex('$foreign', 386 load_foreign_library(LibFile, Module, Options)). 387 388load_foreign_library(LibFile, _Module, _) :- 389 current_library(LibFile, _, _, _, _), 390 !. 391load_foreign_library(LibFile, Module, Options) :- 392 retractall(error(_, _)), 393 find_library(LibFile, Path, Delete), 394 asserta(loading(LibFile)), 395 retractall(foreign_predicate(LibFile, _)), 396 catch(Module:open_shared_object(Path, Handle, Options), E, true), 397 ( nonvar(E) 398 -> delete_foreign_lib(Delete, Path), 399 assert(error(Path, E)), 400 fail 401 ; delete_foreign_lib(Delete, Path) 402 ), 403 !, 404 '$option'(install(DefEntry), Options, default(install)), 405 ( entry(LibFile, DefEntry, Entry), 406 Module:call_shared_object_function(Handle, Entry) 407 -> retractall(loading(LibFile)), 408 assert_shlib(LibFile, Entry, Path, Module, Handle) 409 ; foreign_predicate(LibFile, _) 410 -> retractall(loading(LibFile)), % C++ object installed predicates 411 assert_shlib(LibFile, 'C++', Path, Module, Handle) 412 ; retractall(loading(LibFile)), 413 retractall(foreign_predicate(LibFile, _)), 414 close_shared_object(Handle), 415 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 416 throw(error(existence_error(foreign_install_function, 417 install(Path, Entries)), 418 _)) 419 ). 420load_foreign_library(LibFile, _, _) :- 421 retractall(loading(LibFile)), 422 ( error(_Path, E) 423 -> retractall(error(_, _)), 424 throw(E) 425 ; throw(error(existence_error(foreign_library, LibFile), _)) 426 ). 427 428delete_foreign_lib(true, Path) :- 429 \+ current_prolog_flag(res_keep_foreign, true), 430 !, 431 catch(delete_file(Path), _, true). 432delete_foreign_lib(_, _). 433 434 435%! unload_foreign_library(+FileSpec) is det. 436%! unload_foreign_library(+FileSpec, +Exit:atom) is det. 437% 438% Unload a _|shared object|_ or _DLL_. After calling the Exit 439% function, the shared object is removed from the process. The 440% default exit function is composed from =uninstall_=, followed by 441% the file base-name. 442 443unload_foreign_library(LibFile) :- 444 unload_foreign_library(LibFile, default(uninstall)). 445 446unload_foreign_library(LibFile, DefUninstall) :- 447 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 448 449do_unload(LibFile, DefUninstall) :- 450 current_library(LibFile, _, _, Module, Handle), 451 retractall(current_library(LibFile, _, _, _, _)), 452 ( entry(LibFile, DefUninstall, Uninstall), 453 Module:call_shared_object_function(Handle, Uninstall) 454 -> true 455 ; true 456 ), 457 abolish_foreign(LibFile), 458 close_shared_object(Handle). 459 460abolish_foreign(LibFile) :- 461 ( retract(foreign_predicate(LibFile, Module:Head)), 462 functor(Head, Name, Arity), 463 abolish(Module:Name, Arity), 464 fail 465 ; true 466 ). 467 468system:'$foreign_registered'(M, H) :- 469 ( loading(Lib) 470 -> true 471 ; Lib = '<spontaneous>' 472 ), 473 assert(foreign_predicate(Lib, M:H)). 474 475assert_shlib(File, Entry, Path, Module, Handle) :- 476 retractall(current_library(File, _, _, _, _)), 477 asserta(current_library(File, Entry, Path, Module, Handle)). 478 479 480 /******************************* 481 * ADMINISTRATION * 482 *******************************/ 483 484%! current_foreign_library(?File, ?Public) 485% 486% Query currently loaded shared libraries. 487 488current_foreign_library(File, Public) :- 489 current_library(File, _Entry, _Path, _Module, _Handle), 490 findall(Pred, foreign_predicate(File, Pred), Public). 491 492 493 /******************************* 494 * RELOAD * 495 *******************************/ 496 497%! reload_foreign_libraries 498% 499% Reload all foreign libraries loaded (after restore of a state 500% created using qsave_program/2. 501 502reload_foreign_libraries :- 503 findall(lib(File, Entry, Module), 504 ( retract(current_library(File, Entry, _, Module, _)), 505 File \== - 506 ), 507 Libs), 508 reverse(Libs, Reversed), 509 reload_libraries(Reversed). 510 511reload_libraries([]). 512reload_libraries([lib(File, Entry, Module)|T]) :- 513 ( load_foreign_library(File, Module, Entry) 514 -> true 515 ; print_message(error, shlib(File, load_failed)) 516 ), 517 reload_libraries(T). 518 519 520 /******************************* 521 * CLEANUP (WINDOWS ...) * 522 *******************************/ 523 524/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 525Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 526hooks have been executed, and after dieIO(), closing and flushing all 527files has been called. 528 529On Unix, this is not very useful, and can only lead to conflicts. 530- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 531 532unload_all_foreign_libraries :- 533 current_prolog_flag(unload_foreign_libraries, true), 534 !, 535 forall(current_library(File, _, _, _, _), 536 unload_foreign(File)). 537unload_all_foreign_libraries. 538 539%! unload_foreign(+File) 540% 541% Unload the given foreign file and all `spontaneous' foreign 542% predicates created afterwards. Handling these spontaneous 543% predicates is a bit hard, as we do not know who created them and 544% on which library they depend. 545 546unload_foreign(File) :- 547 unload_foreign_library(File), 548 ( clause(foreign_predicate(Lib, M:H), true, Ref), 549 ( Lib == '<spontaneous>' 550 -> functor(H, Name, Arity), 551 abolish(M:Name, Arity), 552 erase(Ref), 553 fail 554 ; ! 555 ) 556 -> true 557 ; true 558 ). 559 560 561:- if(current_predicate(win_add_dll_directory/2)). 562 563%! win_add_dll_directory(+AbsDir) is det. 564% 565% Add AbsDir to the directories where dependent DLLs are searched on 566% Windows systems. This call uses the AddDllDirectory() API when 567% provided. On older Windows systems it extends ``%PATH%``. 568% 569% @error existence_error(directory, AbsDir) if the target directory 570% does not exist. 571% @error domain_error(absolute_file_name, AbsDir) if AbsDir is not an 572% absolute file name. 573 574win_add_dll_directory(Dir) :- 575 win_add_dll_directory(Dir, _), 576 !. 577win_add_dll_directory(Dir) :- 578 prolog_to_os_filename(Dir, OSDir), 579 getenv('PATH', Path0), 580 atomic_list_concat([Path0, OSDir], ';', Path), 581 setenv('PATH', Path). 582 583% Under MSYS2, the program is invoked from a bash, with the dll 584% dependencies (zlib1.dll etc.) in %MINGW_PREFIX%/bin instead of 585% the installation directory). Here we add this folder to the dll 586% search path. 587 588add_mingw_dll_directory :- 589 current_prolog_flag(msys2, true), 590 !, 591 getenv('MINGW_PREFIX', Prefix), 592 atomic_list_concat([Prefix, bin], /, Bin), 593 win_add_dll_directory(Bin). 594 595add_mingw_dll_directory. 596 597:- initialization(add_mingw_dll_directory). 598 599:- endif. 600 601 /******************************* 602 * MESSAGES * 603 *******************************/ 604 605:- multifile 606 prolog:message//1, 607 prolog:error_message//1. 608 609prologmessage(shlib(LibFile, load_failed)) --> 610 [ '~w: Failed to load file'-[LibFile] ]. 611prologmessage(shlib(not_supported)) --> 612 [ 'Emulator does not support foreign libraries' ]. 613 614prologerror_message(existence_error(foreign_install_function, 615 install(Lib, List))) --> 616 [ 'No install function in ~q'-[Lib], nl, 617 '\tTried: ~q'-[List] 618 ]