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-2018, 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:- use_module(library(lists), [reverse/2]). 51:- 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. */

108:- meta_predicate 109 load_foreign_library(:), 110 load_foreign_library(:, +), 111 use_foreign_library(:), 112 use_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) ]). 137 138 139 /******************************* 140 * DISPATCHING * 141 *******************************/

149find_library(Spec, TmpFile, true) :- 150 '$rc_handle'(Zipper), 151 term_to_atom(Spec, Name), 152 setup_call_cleanup( 153 zip_lock(Zipper), 154 setup_call_cleanup( 155 open_foreign_in_resources(Zipper, Name, In), 156 setup_call_cleanup( 157 tmp_file_stream(binary, TmpFile, Out), 158 copy_stream_data(In, Out), 159 close(Out)), 160 close(In)), 161 zip_unlock(Zipper)), 162 !. 163find_library(Spec, Lib, Copy) :- 164 absolute_file_name(Spec, Lib0, 165 [ file_type(executable), 166 access(read), 167 file_errors(fail) 168 ]), 169 !, 170 lib_to_file(Lib0, Lib, Copy). 171find_library(Spec, Spec, false) :- 172 atom(Spec), 173 !. % use machines finding schema 174find_library(foreign(Spec), Spec, false) :- 175 atom(Spec), 176 !. % use machines finding schema 177find_library(Spec, _, _) :- 178 throw(error(existence_error(source_sink, Spec), _)).

198lib_to_file(Res, TmpFile, true) :- 199 sub_atom(Res, 0, _, _, 'res://'), 200 !, 201 setup_call_cleanup( 202 open(Res, read, In, [type(binary)]), 203 setup_call_cleanup( 204 tmp_file_stream(binary, TmpFile, Out), 205 copy_stream_data(In, Out), 206 close(Out)), 207 close(In)). 208lib_to_file(Lib, Lib, false). 209 210 211open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :- 212 term_to_atom(foreign(Name), ForeignSpecAtom), 213 zipper_members(Zipper, Entries), 214 entries_for_name(Name, Entries, Entries1), 215 compatible_architecture_lib(Entries1, Name, CompatibleLib), 216 zipper_goto(Zipper, file(CompatibleLib)), 217 zipper_open_current(Zipper, Stream, 218 [ type(binary), 219 release(true) 220 ]).

235compatible_architecture_lib([], _, _) :- !, fail. 236compatible_architecture_lib(Entries, Name, CompatibleLib) :- 237 current_prolog_flag(arch, HostArch), 238 ( member(shlib(EntryArch, Name), Entries), 239 qsave_compat_arch1(HostArch, EntryArch) 240 -> term_to_atom(shlib(EntryArch, Name), CompatibleLib) 241 ; existence_error(arch_compatible_with(Name), HostArch) 242 ). 243 244qsave_compat_arch1(Arch1, Arch2) :- 245 qsave:compat_arch(Arch1, Arch2), !. 246qsave_compat_arch1(Arch1, Arch2) :- 247 qsave:compat_arch(Arch2, Arch1), !.

257:- multifile qsave:compat_arch/2. 258 259qsave:compat_arch(A,A). 260 261shlib_atom_to_term(Atom, shlib(Arch, Name)) :- 262 sub_atom(Atom, 0, _, _, 'shlib('), 263 !, 264 term_to_atom(shlib(Arch,Name), Atom). 265shlib_atom_to_term(Atom, Atom). 266 267match_filespec(Name, shlib(_,Name)). 268 269entries_for_name(Name, Entries, Filtered) :- 270 maplist(shlib_atom_to_term, Entries, Entries1), 271 include(match_filespec(Name), Entries1, Filtered). 272 273base(Path, Base) :- 274 atomic(Path), 275 !, 276 file_base_name(Path, File), 277 file_name_extension(Base, _Ext, File). 278base(_/Path, Base) :- 279 !, 280 base(Path, Base). 281base(Path, Base) :- 282 Path =.. [_,Arg], 283 base(Arg, Base). 284 285entry(_, Function, Function) :- 286 Function \= default(_), 287 !. 288entry(Spec, default(FuncBase), Function) :- 289 base(Spec, Base), 290 atomic_list_concat([FuncBase, Base], '_', Function). 291entry(_, default(Function), Function). 292 293 /******************************* 294 * (UN)LOADING * 295 *******************************/

321load_foreign_library(Library) :- 322 load_foreign_library(Library, default(install)). 323 324load_foreign_library(Module:LibFile, Entry) :- 325 with_mutex('$foreign', 326 load_foreign_library(LibFile, Module, Entry)). 327 328load_foreign_library(LibFile, _Module, _) :- 329 current_library(LibFile, _, _, _, _), 330 !. 331load_foreign_library(LibFile, Module, DefEntry) :- 332 retractall(error(_, _)), 333 find_library(LibFile, Path, Delete), 334 asserta(loading(LibFile)), 335 retractall(foreign_predicate(LibFile, _)), 336 catch(Module:open_shared_object(Path, Handle), E, true), 337 ( nonvar(E) 338 -> delete_foreign_lib(Delete, Path), 339 assert(error(Path, E)), 340 fail 341 ; delete_foreign_lib(Delete, Path) 342 ), 343 !, 344 ( entry(LibFile, DefEntry, Entry), 345 Module:call_shared_object_function(Handle, Entry) 346 -> retractall(loading(LibFile)), 347 assert_shlib(LibFile, Entry, Path, Module, Handle) 348 ; foreign_predicate(LibFile, _) 349 -> retractall(loading(LibFile)) % C++ object installed predicates 350 ; retractall(loading(LibFile)), 351 retractall(foreign_predicate(LibFile, _)), 352 close_shared_object(Handle), 353 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 354 throw(error(existence_error(foreign_install_function, 355 install(Path, Entries)), 356 _)) 357 ). 358load_foreign_library(LibFile, _, _) :- 359 retractall(loading(LibFile)), 360 ( error(_Path, E) 361 -> retractall(error(_, _)), 362 throw(E) 363 ; throw(error(existence_error(foreign_library, LibFile), _)) 364 ). 365 366delete_foreign_lib(true, Path) :- 367 \+ current_prolog_flag(res_keep_foreign, true), 368 !, 369 catch(delete_file(Path), _, true). 370delete_foreign_lib(_, _).

390use_foreign_library(FileSpec) :- 391 initialization(load_foreign_library(FileSpec), now). 392 393use_foreign_library(FileSpec, Entry) :- 394 initialization(load_foreign_library(FileSpec, Entry), now).

404unload_foreign_library(LibFile) :- 405 unload_foreign_library(LibFile, default(uninstall)). 406 407unload_foreign_library(LibFile, DefUninstall) :- 408 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 409 410do_unload(LibFile, DefUninstall) :- 411 current_library(LibFile, _, _, Module, Handle), 412 retractall(current_library(LibFile, _, _, _, _)), 413 ( entry(LibFile, DefUninstall, Uninstall), 414 Module:call_shared_object_function(Handle, Uninstall) 415 -> true 416 ; true 417 ), 418 abolish_foreign(LibFile), 419 close_shared_object(Handle). 420 421abolish_foreign(LibFile) :- 422 ( retract(foreign_predicate(LibFile, Module:Head)), 423 functor(Head, Name, Arity), 424 abolish(Module:Name, Arity), 425 fail 426 ; true 427 ). 428 429system:'$foreign_registered'(M, H) :- 430 ( loading(Lib) 431 -> true 432 ; Lib = '<spontaneous>' 433 ), 434 assert(foreign_predicate(Lib, M:H)). 435 436assert_shlib(File, Entry, Path, Module, Handle) :- 437 retractall(current_library(File, _, _, _, _)), 438 asserta(current_library(File, Entry, Path, Module, Handle)). 439 440 441 /******************************* 442 * ADMINISTRATION * 443 *******************************/

449current_foreign_library(File, Public) :- 450 current_library(File, _Entry, _Path, _Module, _Handle), 451 findall(Pred, foreign_predicate(File, Pred), Public). 452 453 454 /******************************* 455 * RELOAD * 456 *******************************/

463reload_foreign_libraries :- 464 findall(lib(File, Entry, Module), 465 ( retract(current_library(File, Entry, _, Module, _)), 466 File \== - 467 ), 468 Libs), 469 reverse(Libs, Reversed), 470 reload_libraries(Reversed). 471 472reload_libraries([]). 473reload_libraries([lib(File, Entry, Module)|T]) :- 474 ( load_foreign_library(File, Module, Entry) 475 -> true 476 ; print_message(error, shlib(File, load_failed)) 477 ), 478 reload_libraries(T). 479 480 481 /******************************* 482 * CLEANUP (WINDOWS ...) * 483 *******************************/ 484 485/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 486Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 487hooks have been executed, and after dieIO(), closing and flushing all 488files has been called. 489 490On Unix, this is not very useful, and can only lead to conflicts. 491- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 492 493unload_all_foreign_libraries :- 494 current_prolog_flag(unload_foreign_libraries, true), 495 !, 496 forall(current_library(File, _, _, _, _), 497 unload_foreign(File)). 498unload_all_foreign_libraries.

507unload_foreign(File) :- 508 unload_foreign_library(File), 509 ( clause(foreign_predicate(Lib, M:H), true, Ref), 510 ( Lib == '<spontaneous>' 511 -> functor(H, Name, Arity), 512 abolish(M:Name, Arity), 513 erase(Ref), 514 fail 515 ; ! 516 ) 517 -> true 518 ; true 519 ).

530win_add_dll_directory(Dir) :- 531 ( current_prolog_flag(windows, true) 532 -> ( catch(win_add_dll_directory(Dir, _), _, fail) 533 -> true 534 ; prolog_to_os_filename(Dir, OSDir), 535 getenv('PATH', Path0), 536 atomic_list_concat([Path0, OSDir], ';', Path), 537 setenv('PATH', Path) 538 ) 539 ; domain_error(operating_system, windows) 540 ). 541 542 /******************************* 543 * MESSAGES * 544 *******************************/ 545 546:- multifile 547 prolog:message//1, 548 prolog:error_message//1. 549 550prolog:message(shlib(LibFile, load_failed)) --> 551 [ '~w: Failed to load file'-[LibFile] ]. 552prolog:message(shlib(not_supported)) --> 553 [ 'Emulator does not support foreign libraries' ]. 554 555prolog:error_message(existence_error(foreign_install_function, 556 install(Lib, List))) --> 557 [ 'No install function in ~q'-[Lib], nl, 558 '\tTried: ~q'-[List] 559 ]