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

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

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

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

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

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.

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

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 599prolog:message(shlib(LibFile, load_failed)) --> 600 [ '~w: Failed to load file'-[LibFile] ]. 601prolog:message(shlib(not_supported)) --> 602 [ 'Emulator does not support foreign libraries' ]. 603 604prolog:error_message(existence_error(foreign_install_function, 605 install(Lib, List))) --> 606 [ 'No install function in ~q'-[Lib], nl, 607 '\tTried: ~q'-[List] 608 ]