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).

Utility library for loading foreign objects (DLLs, shared objects)

This section discusses the functionality of the (autoload) library(shlib), providing an interface to manage shared libraries. We describe the procedure for using a foreign resource (DLL in Windows and shared object in Unix) called mylib.

First, one must assemble the resource and make it compatible to SWI-Prolog. The details for this vary between platforms. The swipl-ld(1) utility can be used to deal with this in a portable manner. The typical commandline is:

swipl-ld -o mylib file.{c,o,cc,C} ...

Make sure that one of the files provides a global function install_mylib() that initialises the module using calls to PL_register_foreign(). Here is a simple example file mylib.c, which creates a Windows MessageBox:

#include <windows.h>
#include <SWI-Prolog.h>

static foreign_t
pl_say_hello(term_t to)
{ char *a;

  if ( PL_get_atom_chars(to, &a) )
  { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL);

    PL_succeed;
  }

  PL_fail;
}

install_t
install_mylib()
{ PL_register_foreign("say_hello", 1, pl_say_hello, 0);
}

Now write a file mylib.pl:

:- module(mylib, [ say_hello/1 ]).
:- use_foreign_library(foreign(mylib)).

The file mylib.pl can be loaded as a normal Prolog file and provides the predicate defined in C. */

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) ]).

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), _)).

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 ]).

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 ).

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), !.

303:- multifile qsave:compat_arch/2. 304 305qsave:compat_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 *******************************/

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(_, _).

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 *******************************/

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 *******************************/

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.

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)).

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% Environments such as MSYS2 and CONDA install DLLs in some separate 584% directory. We add these directories to the search path for indirect 585% dependencies from ours foreign plugins. 586 587add_dll_directories :- 588 current_prolog_flag(msys2, true), 589 !, 590 env_add_dll_dir('MINGW_PREFIX', '/bin'). 591add_dll_directories :- 592 current_prolog_flag(conda, true), 593 !, 594 env_add_dll_dir('CONDA_PREFIX', '/Library/bin'), 595 ignore(env_add_dll_dir('PREFIX', '/Library/bin')). 596add_dll_directories. 597 598env_add_dll_dir(Var, Postfix) :- 599 getenv(Var, Prefix), 600 atom_concat(Prefix, Postfix, Dir), 601 win_add_dll_directory(Dir). 602 603:- initialization 604 add_dll_directories. 605 606:- endif. 607 608 /******************************* 609 * SEARCH PATH * 610 *******************************/ 611 612:- dynamic 613 user:file_search_path/2. 614:- multifile 615 user:file_search_path/2. 616 617user:file_search_path(foreign, swi(ArchLib)) :- 618 current_prolog_flag(arch, Arch), 619 atom_concat('lib/', Arch, ArchLib). 620user:file_search_path(foreign, swi(SoLib)) :- 621 ( current_prolog_flag(windows, true) 622 -> SoLib = bin 623 ; SoLib = lib 624 ). 625 626 627 /******************************* 628 * MESSAGES * 629 *******************************/ 630 631:- multifile 632 prolog:message//1, 633 prolog:error_message//1. 634 635prolog:message(shlib(LibFile, load_failed)) --> 636 [ '~w: Failed to load file'-[LibFile] ]. 637prolog:message(shlib(not_supported)) --> 638 [ 'Emulator does not support foreign libraries' ]. 639 640prolog:error_message(existence_error(foreign_install_function, 641 install(Lib, List))) --> 642 [ 'No install function in ~q'-[Lib], nl, 643 '\tTried: ~q'-[List] 644 ]