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-2020, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(shlib, 38 [ load_foreign_library/1, % :LibFile 39 load_foreign_library/2, % :LibFile, +InstallFunc 40 unload_foreign_library/1, % +LibFile 41 unload_foreign_library/2, % +LibFile, +UninstallFunc 42 current_foreign_library/2, % ?LibFile, ?Public 43 reload_foreign_libraries/0, 44 % Directives 45 use_foreign_library/1, % :LibFile 46 use_foreign_library/2, % :LibFile, +InstallFunc 47 48 win_add_dll_directory/1 % +Dir 49 ]). 50:- autoload(library(error),[existence_error/2,domain_error/2]). 51:- autoload(library(lists),[member/2,reverse/2]). 52 53:- 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. */

110:- meta_predicate 111 load_foreign_library(:), 112 load_foreign_library(:, +). 113 114:- dynamic 115 loading/1, % Lib 116 error/2, % File, Error 117 foreign_predicate/2, % Lib, Pred 118 current_library/5. % Lib, Entry, Path, Module, Handle 119 120:- volatile % Do not store in state 121 loading/1, 122 error/2, 123 foreign_predicate/2, 124 current_library/5. 125 126:- ( current_prolog_flag(open_shared_object, true) 127 -> true 128 ; print_message(warning, shlib(not_supported)) % error? 129 ). 130 131% The flag `res_keep_foreign` prevents deleting temporary files created 132% to load shared objects when set to `true`. This may be needed for 133% debugging purposes. 134 135:- create_prolog_flag(res_keep_foreign, false, 136 [ keep(true) ]).

172find_library(Spec, TmpFile, true) :- 173 '$rc_handle'(Zipper), 174 term_to_atom(Spec, Name), 175 setup_call_cleanup( 176 zip_lock(Zipper), 177 setup_call_cleanup( 178 open_foreign_in_resources(Zipper, Name, In), 179 setup_call_cleanup( 180 tmp_file_stream(binary, TmpFile, Out), 181 copy_stream_data(In, Out), 182 close(Out)), 183 close(In)), 184 zip_unlock(Zipper)), 185 !. 186find_library(Spec, Lib, Copy) :- 187 absolute_file_name(Spec, Lib0, 188 [ file_type(executable), 189 access(read), 190 file_errors(fail) 191 ]), 192 !, 193 lib_to_file(Lib0, Lib, Copy). 194find_library(Spec, Spec, false) :- 195 atom(Spec), 196 !. % use machines finding schema 197find_library(foreign(Spec), Spec, false) :- 198 atom(Spec), 199 !. % use machines finding schema 200find_library(Spec, _, _) :- 201 throw(error(existence_error(source_sink, Spec), _)).

221lib_to_file(Res, TmpFile, true) :- 222 sub_atom(Res, 0, _, _, 'res://'), 223 !, 224 setup_call_cleanup( 225 open(Res, read, In, [type(binary)]), 226 setup_call_cleanup( 227 tmp_file_stream(binary, TmpFile, Out), 228 copy_stream_data(In, Out), 229 close(Out)), 230 close(In)). 231lib_to_file(Lib, Lib, false). 232 233 234open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :- 235 term_to_atom(foreign(Name), ForeignSpecAtom), 236 zipper_members_(Zipper, Entries), 237 entries_for_name(Entries, Name, Entries1), 238 compatible_architecture_lib(Entries1, Name, CompatibleLib), 239 zipper_goto(Zipper, file(CompatibleLib)), 240 zipper_open_current(Zipper, Stream, 241 [ type(binary), 242 release(true) 243 ]).

253zipper_members_(Zipper, Members) :- 254 zipper_goto(Zipper, first), 255 zip_members__(Zipper, Members). 256 257zip_members__(Zipper, [Name|T]) :- 258 zip_file_info_(Zipper, Name, _Attrs), 259 ( zipper_goto(Zipper, next) 260 -> zip_members__(Zipper, T) 261 ; T = [] 262 ).

278compatible_architecture_lib([], _, _) :- !, fail. 279compatible_architecture_lib(Entries, Name, CompatibleLib) :- 280 current_prolog_flag(arch, HostArch), 281 ( member(shlib(EntryArch, Name), Entries), 282 qsave_compat_arch1(HostArch, EntryArch) 283 -> term_to_atom(shlib(EntryArch, Name), CompatibleLib) 284 ; existence_error(arch_compatible_with(Name), HostArch) 285 ). 286 287qsave_compat_arch1(Arch1, Arch2) :- 288 qsave:compat_arch(Arch1, Arch2), !. 289qsave_compat_arch1(Arch1, Arch2) :- 290 qsave:compat_arch(Arch2, Arch1), !.

300:- multifile qsave:compat_arch/2. 301 302qsave:compat_arch(A,A). 303 304entries_for_name([], _, []). 305entries_for_name([H0|T0], Name, [H|T]) :- 306 shlib_atom_to_term(H0, H), 307 match_filespec(Name, H), 308 !, 309 entries_for_name(T0, Name, T). 310entries_for_name([_|T0], Name, T) :- 311 entries_for_name(T0, Name, T). 312 313shlib_atom_to_term(Atom, shlib(Arch, Name)) :- 314 sub_atom(Atom, 0, _, _, 'shlib('), 315 !, 316 term_to_atom(shlib(Arch,Name), Atom). 317shlib_atom_to_term(Atom, Atom). 318 319match_filespec(Name, shlib(_,Name)). 320 321base(Path, Base) :- 322 atomic(Path), 323 !, 324 file_base_name(Path, File), 325 file_name_extension(Base, _Ext, File). 326base(_/Path, Base) :- 327 !, 328 base(Path, Base). 329base(Path, Base) :- 330 Path =.. [_,Arg], 331 base(Arg, Base). 332 333entry(_, Function, Function) :- 334 Function \= default(_), 335 !. 336entry(Spec, default(FuncBase), Function) :- 337 base(Spec, Base), 338 atomic_list_concat([FuncBase, Base], '_', Function). 339entry(_, default(Function), Function). 340 341 /******************************* 342 * (UN)LOADING * 343 *******************************/

369load_foreign_library(Library) :- 370 load_foreign_library(Library, default(install)). 371 372load_foreign_library(Module:LibFile, Entry) :- 373 with_mutex('$foreign', 374 load_foreign_library(LibFile, Module, Entry)). 375 376load_foreign_library(LibFile, _Module, _) :- 377 current_library(LibFile, _, _, _, _), 378 !. 379load_foreign_library(LibFile, Module, DefEntry) :- 380 retractall(error(_, _)), 381 find_library(LibFile, Path, Delete), 382 asserta(loading(LibFile)), 383 retractall(foreign_predicate(LibFile, _)), 384 catch(Module:open_shared_object(Path, Handle), E, true), 385 ( nonvar(E) 386 -> delete_foreign_lib(Delete, Path), 387 assert(error(Path, E)), 388 fail 389 ; delete_foreign_lib(Delete, Path) 390 ), 391 !, 392 ( entry(LibFile, DefEntry, Entry), 393 Module:call_shared_object_function(Handle, Entry) 394 -> retractall(loading(LibFile)), 395 assert_shlib(LibFile, Entry, Path, Module, Handle) 396 ; foreign_predicate(LibFile, _) 397 -> retractall(loading(LibFile)), % C++ object installed predicates 398 assert_shlib(LibFile, 'C++', Path, Module, Handle) 399 ; retractall(loading(LibFile)), 400 retractall(foreign_predicate(LibFile, _)), 401 close_shared_object(Handle), 402 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 403 throw(error(existence_error(foreign_install_function, 404 install(Path, Entries)), 405 _)) 406 ). 407load_foreign_library(LibFile, _, _) :- 408 retractall(loading(LibFile)), 409 ( error(_Path, E) 410 -> retractall(error(_, _)), 411 throw(E) 412 ; throw(error(existence_error(foreign_library, LibFile), _)) 413 ). 414 415delete_foreign_lib(true, Path) :- 416 \+ current_prolog_flag(res_keep_foreign, true), 417 !, 418 catch(delete_file(Path), _, true). 419delete_foreign_lib(_, _).

430unload_foreign_library(LibFile) :- 431 unload_foreign_library(LibFile, default(uninstall)). 432 433unload_foreign_library(LibFile, DefUninstall) :- 434 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 435 436do_unload(LibFile, DefUninstall) :- 437 current_library(LibFile, _, _, Module, Handle), 438 retractall(current_library(LibFile, _, _, _, _)), 439 ( entry(LibFile, DefUninstall, Uninstall), 440 Module:call_shared_object_function(Handle, Uninstall) 441 -> true 442 ; true 443 ), 444 abolish_foreign(LibFile), 445 close_shared_object(Handle). 446 447abolish_foreign(LibFile) :- 448 ( retract(foreign_predicate(LibFile, Module:Head)), 449 functor(Head, Name, Arity), 450 abolish(Module:Name, Arity), 451 fail 452 ; true 453 ). 454 455system:'$foreign_registered'(M, H) :- 456 ( loading(Lib) 457 -> true 458 ; Lib = '<spontaneous>' 459 ), 460 assert(foreign_predicate(Lib, M:H)). 461 462assert_shlib(File, Entry, Path, Module, Handle) :- 463 retractall(current_library(File, _, _, _, _)), 464 asserta(current_library(File, Entry, Path, Module, Handle)). 465 466 467 /******************************* 468 * ADMINISTRATION * 469 *******************************/

475current_foreign_library(File, Public) :- 476 current_library(File, _Entry, _Path, _Module, _Handle), 477 findall(Pred, foreign_predicate(File, Pred), Public). 478 479 480 /******************************* 481 * RELOAD * 482 *******************************/

489reload_foreign_libraries :- 490 findall(lib(File, Entry, Module), 491 ( retract(current_library(File, Entry, _, Module, _)), 492 File \== - 493 ), 494 Libs), 495 reverse(Libs, Reversed), 496 reload_libraries(Reversed). 497 498reload_libraries([]). 499reload_libraries([lib(File, Entry, Module)|T]) :- 500 ( load_foreign_library(File, Module, Entry) 501 -> true 502 ; print_message(error, shlib(File, load_failed)) 503 ), 504 reload_libraries(T). 505 506 507 /******************************* 508 * CLEANUP (WINDOWS ...) * 509 *******************************/ 510 511/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 512Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 513hooks have been executed, and after dieIO(), closing and flushing all 514files has been called. 515 516On Unix, this is not very useful, and can only lead to conflicts. 517- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 518 519unload_all_foreign_libraries :- 520 current_prolog_flag(unload_foreign_libraries, true), 521 !, 522 forall(current_library(File, _, _, _, _), 523 unload_foreign(File)). 524unload_all_foreign_libraries.

533unload_foreign(File) :- 534 unload_foreign_library(File), 535 ( clause(foreign_predicate(Lib, M:H), true, Ref), 536 ( Lib == '<spontaneous>' 537 -> functor(H, Name, Arity), 538 abolish(M:Name, Arity), 539 erase(Ref), 540 fail 541 ; ! 542 ) 543 -> true 544 ; true 545 ).

556win_add_dll_directory(Dir) :- 557 ( current_prolog_flag(windows, true) 558 -> ( catch(win_add_dll_directory(Dir, _), _, fail) 559 -> true 560 ; prolog_to_os_filename(Dir, OSDir), 561 getenv('PATH', Path0), 562 atomic_list_concat([Path0, OSDir], ';', Path), 563 setenv('PATH', Path) 564 ) 565 ; domain_error(operating_system, windows) 566 ). 567 568 /******************************* 569 * MESSAGES * 570 *******************************/ 571 572:- multifile 573 prolog:message//1, 574 prolog:error_message//1. 575 576prolog:message(shlib(LibFile, load_failed)) --> 577 [ '~w: Failed to load file'-[LibFile] ]. 578prolog:message(shlib(not_supported)) --> 579 [ 'Emulator does not support foreign libraries' ]. 580 581prolog:error_message(existence_error(foreign_install_function, 582 install(Lib, List))) --> 583 [ 'No install function in ~q'-[Lib], nl, 584 '\tTried: ~q'-[List] 585 ]