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 310qsavecompat_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 640prologmessage(shlib(LibFile, load_failed)) --> 641 [ '~w: Failed to load file'-[LibFile] ]. 642prologmessage(shlib(not_supported)) --> 643 [ 'Emulator does not support foreign libraries' ]. 644 645prologerror_message(existence_error(foreign_install_function, 646 install(Lib, List))) --> 647 [ 'No install function in ~q'-[Lib], nl, 648 '\tTried: ~q'-[List] 649 ]