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, +InstallFunc 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, +InstallFunc 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, +Entry:atom) 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, +Entry:atom) is det. 350% 351% Load a _|shared object|_ or _DLL_. After loading the Entry 352% function is called without arguments. The default entry function 353% is composed from =install_=, followed by the file base-name. 354% E.g., the load-call below calls the function 355% =|install_mylib()|=. If the platform prefixes extern functions 356% with =_=, this prefix is added before calling. 357% 358% == 359% ... 360% load_foreign_library(foreign(mylib)), 361% ... 362% == 363% 364% @param FileSpec is a specification for absolute_file_name/3. If searching 365% the file fails, the plain name is passed to the OS to try the default 366% method of the OS for locating foreign objects. The default definition 367% of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and 368% <prolog home>/bin on Windows. 369% 370% @see use_foreign_library/1,2 are intended for use in directives. 371 372load_foreign_library(Library) :- 373 load_foreign_library(Library, default(install)). 374 375load_foreign_library(Module:LibFile, Entry) :- 376 with_mutex('$foreign', 377 load_foreign_library(LibFile, Module, Entry)). 378 379load_foreign_library(LibFile, _Module, _) :- 380 current_library(LibFile, _, _, _, _), 381 !. 382load_foreign_library(LibFile, Module, DefEntry) :- 383 retractall(error(_, _)), 384 find_library(LibFile, Path, Delete), 385 asserta(loading(LibFile)), 386 retractall(foreign_predicate(LibFile, _)), 387 catch(Module:open_shared_object(Path, Handle), E, true), 388 ( nonvar(E) 389 -> delete_foreign_lib(Delete, Path), 390 assert(error(Path, E)), 391 fail 392 ; delete_foreign_lib(Delete, Path) 393 ), 394 !, 395 ( entry(LibFile, DefEntry, Entry), 396 Module:call_shared_object_function(Handle, Entry) 397 -> retractall(loading(LibFile)), 398 assert_shlib(LibFile, Entry, Path, Module, Handle) 399 ; foreign_predicate(LibFile, _) 400 -> retractall(loading(LibFile)), % C++ object installed predicates 401 assert_shlib(LibFile, 'C++', Path, Module, Handle) 402 ; retractall(loading(LibFile)), 403 retractall(foreign_predicate(LibFile, _)), 404 close_shared_object(Handle), 405 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 406 throw(error(existence_error(foreign_install_function, 407 install(Path, Entries)), 408 _)) 409 ). 410load_foreign_library(LibFile, _, _) :- 411 retractall(loading(LibFile)), 412 ( error(_Path, E) 413 -> retractall(error(_, _)), 414 throw(E) 415 ; throw(error(existence_error(foreign_library, LibFile), _)) 416 ). 417 418delete_foreign_lib(true, Path) :- 419 \+ current_prolog_flag(res_keep_foreign, true), 420 !, 421 catch(delete_file(Path), _, true). 422delete_foreign_lib(_, _). 423 424 425%! unload_foreign_library(+FileSpec) is det. 426%! unload_foreign_library(+FileSpec, +Exit:atom) is det. 427% 428% Unload a _|shared object|_ or _DLL_. After calling the Exit 429% function, the shared object is removed from the process. The 430% default exit function is composed from =uninstall_=, followed by 431% the file base-name. 432 433unload_foreign_library(LibFile) :- 434 unload_foreign_library(LibFile, default(uninstall)). 435 436unload_foreign_library(LibFile, DefUninstall) :- 437 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 438 439do_unload(LibFile, DefUninstall) :- 440 current_library(LibFile, _, _, Module, Handle), 441 retractall(current_library(LibFile, _, _, _, _)), 442 ( entry(LibFile, DefUninstall, Uninstall), 443 Module:call_shared_object_function(Handle, Uninstall) 444 -> true 445 ; true 446 ), 447 abolish_foreign(LibFile), 448 close_shared_object(Handle). 449 450abolish_foreign(LibFile) :- 451 ( retract(foreign_predicate(LibFile, Module:Head)), 452 functor(Head, Name, Arity), 453 abolish(Module:Name, Arity), 454 fail 455 ; true 456 ). 457 458system:'$foreign_registered'(M, H) :- 459 ( loading(Lib) 460 -> true 461 ; Lib = '<spontaneous>' 462 ), 463 assert(foreign_predicate(Lib, M:H)). 464 465assert_shlib(File, Entry, Path, Module, Handle) :- 466 retractall(current_library(File, _, _, _, _)), 467 asserta(current_library(File, Entry, Path, Module, Handle)). 468 469 470 /******************************* 471 * ADMINISTRATION * 472 *******************************/ 473 474%! current_foreign_library(?File, ?Public) 475% 476% Query currently loaded shared libraries. 477 478current_foreign_library(File, Public) :- 479 current_library(File, _Entry, _Path, _Module, _Handle), 480 findall(Pred, foreign_predicate(File, Pred), Public). 481 482 483 /******************************* 484 * RELOAD * 485 *******************************/ 486 487%! reload_foreign_libraries 488% 489% Reload all foreign libraries loaded (after restore of a state 490% created using qsave_program/2. 491 492reload_foreign_libraries :- 493 findall(lib(File, Entry, Module), 494 ( retract(current_library(File, Entry, _, Module, _)), 495 File \== - 496 ), 497 Libs), 498 reverse(Libs, Reversed), 499 reload_libraries(Reversed). 500 501reload_libraries([]). 502reload_libraries([lib(File, Entry, Module)|T]) :- 503 ( load_foreign_library(File, Module, Entry) 504 -> true 505 ; print_message(error, shlib(File, load_failed)) 506 ), 507 reload_libraries(T). 508 509 510 /******************************* 511 * CLEANUP (WINDOWS ...) * 512 *******************************/ 513 514/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 515Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 516hooks have been executed, and after dieIO(), closing and flushing all 517files has been called. 518 519On Unix, this is not very useful, and can only lead to conflicts. 520- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 521 522unload_all_foreign_libraries :- 523 current_prolog_flag(unload_foreign_libraries, true), 524 !, 525 forall(current_library(File, _, _, _, _), 526 unload_foreign(File)). 527unload_all_foreign_libraries. 528 529%! unload_foreign(+File) 530% 531% Unload the given foreign file and all `spontaneous' foreign 532% predicates created afterwards. Handling these spontaneous 533% predicates is a bit hard, as we do not know who created them and 534% on which library they depend. 535 536unload_foreign(File) :- 537 unload_foreign_library(File), 538 ( clause(foreign_predicate(Lib, M:H), true, Ref), 539 ( Lib == '<spontaneous>' 540 -> functor(H, Name, Arity), 541 abolish(M:Name, Arity), 542 erase(Ref), 543 fail 544 ; ! 545 ) 546 -> true 547 ; true 548 ). 549 550 551:- if(current_predicate(win_add_dll_directory/2)). 552 553%! win_add_dll_directory(+AbsDir) is det. 554% 555% Add AbsDir to the directories where dependent DLLs are searched on 556% Windows systems. This call uses the AddDllDirectory() API when 557% provided. On older Windows systems it extends ``%PATH%``. 558% 559% @error existence_error(directory, AbsDir) if the target directory 560% does not exist. 561% @error domain_error(absolute_file_name, AbsDir) if AbsDir is not an 562% absolute file name. 563 564win_add_dll_directory(Dir) :- 565 win_add_dll_directory(Dir, _), 566 !. 567win_add_dll_directory(Dir) :- 568 prolog_to_os_filename(Dir, OSDir), 569 getenv('PATH', Path0), 570 atomic_list_concat([Path0, OSDir], ';', Path), 571 setenv('PATH', Path). 572 573% Under MSYS2, the program is invoked from a bash, with the dll 574% dependencies (zlib1.dll etc.) in %MINGW_PREFIX%/bin instead of 575% the installation directory). Here we add this folder to the dll 576% search path. 577 578add_mingw_dll_directory :- 579 current_prolog_flag(msys2, true), 580 !, 581 getenv('MINGW_PREFIX', Prefix), 582 atomic_list_concat([Prefix, bin], /, Bin), 583 win_add_dll_directory(Bin). 584 585add_mingw_dll_directory. 586 587:- initialization(add_mingw_dll_directory). 588 589:- endif. 590 591 /******************************* 592 * MESSAGES * 593 *******************************/ 594 595:- multifile 596 prolog:message//1, 597 prolog:error_message//1. 598 599prologmessage(shlib(LibFile, load_failed)) --> 600 [ '~w: Failed to load file'-[LibFile] ]. 601prologmessage(shlib(not_supported)) --> 602 [ 'Emulator does not support foreign libraries' ]. 603 604prologerror_message(existence_error(foreign_install_function, 605 install(Lib, List))) --> 606 [ 'No install function in ~q'-[Lib], nl, 607 '\tTried: ~q'-[List] 608 ]