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