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:- '$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) ]).

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

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

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

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

308:- multifile qsave:compat_arch/2. 309 310qsave:compat_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 *******************************/

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

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

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

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.

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

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