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

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 -shared -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(). Below is a simple example file mylib.c, which prints a "hello" message. Note that we use SWI-Prolog's Sprintf() rather than C standard printf() to print the outout through Prolog's current_output stream, making the example work in a windowed environment. The standard C printf() works in a console environment, but this bypasses Prolog's output redirection. Also note the use of the standard C bool type, which is supported in 9.2.x and more actively promoted in the 9.3.x development series.

#include <SWI-Prolog.h>
#include <SWI-Stream.h>
#include <stdbool.h>

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

  if ( PL_get_chars(to, &s, CVT_ALL|REP_UTF8) )
  { Sprintf("hello %Us", s);

    return true;
  }

  return false;
}

install_t
install_mylib(void)
{ 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. The generated mylib.so (or .dll, etc.) must be placed in a directory searched for using the Prolog search path foreign (see absolute_file_name/3). To load this from the current directory, we can use the -p alias=dir option:

swipl -p foreign=. mylib.pl
?- say_hello(world).
hello world
true.

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

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

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

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

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

325:- multifile qsave:compat_arch/2. 326 327qsave:compat_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 *******************************/

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

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

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

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.

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

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 661prolog:message(shlib(LibFile, load_failed)) --> 662 [ '~w: Failed to load file'-[LibFile] ]. 663prolog:message(shlib(not_supported)) --> 664 [ 'Emulator does not support foreign libraries' ]. 665 666prolog:error_message(existence_error(foreign_install_function, 667 install(Lib, List))) --> 668 [ 'No install function in ~q'-[Lib], nl, 669 '\tTried: ~q'-[List] 670 ]