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

105:- meta_predicate 106 load_foreign_library(:), 107 load_foreign_library(:, +), 108 use_foreign_library(:), 109 use_foreign_library(:, +). 110 111:- dynamic 112 loading/1, % Lib 113 error/2, % File, Error 114 foreign_predicate/2, % Lib, Pred 115 current_library/5. % Lib, Entry, Path, Module, Handle 116 117:- volatile % Do not store in state 118 loading/1, 119 error/2, 120 foreign_predicate/2, 121 current_library/5. 122 123:- ( current_prolog_flag(open_shared_object, true) 124 -> true 125 ; print_message(warning, shlib(not_supported)) % error? 126 ). 127 128 129 /******************************* 130 * DISPATCHING * 131 *******************************/

139find_library(Spec, TmpFile, true) :- 140 '$rc_handle'(RC), 141 term_to_atom(Spec, Name), 142 setup_call_cleanup( 143 '$rc_open'(RC, Name, shared, read, In), 144 setup_call_cleanup( 145 tmp_file_stream(binary, TmpFile, Out), 146 copy_stream_data(In, Out), 147 close(Out)), 148 close(In)), 149 !. 150find_library(Spec, Lib, false) :- 151 absolute_file_name(Spec, Lib, 152 [ file_type(executable), 153 access(read), 154 file_errors(fail) 155 ]), 156 !. 157find_library(Spec, Spec, false) :- 158 atom(Spec), 159 !. % use machines finding schema 160find_library(foreign(Spec), Spec, false) :- 161 atom(Spec), 162 !. % use machines finding schema 163find_library(Spec, _, _) :- 164 throw(error(existence_error(source_sink, Spec), _)). 165 166base(Path, Base) :- 167 atomic(Path), 168 !, 169 file_base_name(Path, File), 170 file_name_extension(Base, _Ext, File). 171base(_/Path, Base) :- 172 !, 173 base(Path, Base). 174base(Path, Base) :- 175 Path =.. [_,Arg], 176 base(Arg, Base). 177 178entry(_, Function, Function) :- 179 Function \= default(_), 180 !. 181entry(Spec, default(FuncBase), Function) :- 182 base(Spec, Base), 183 atomic_list_concat([FuncBase, Base], '_', Function). 184entry(_, default(Function), Function). 185 186 /******************************* 187 * (UN)LOADING * 188 *******************************/

214load_foreign_library(Library) :- 215 load_foreign_library(Library, default(install)). 216 217load_foreign_library(Module:LibFile, Entry) :- 218 with_mutex('$foreign', 219 load_foreign_library(LibFile, Module, Entry)). 220 221load_foreign_library(LibFile, _Module, _) :- 222 current_library(LibFile, _, _, _, _), 223 !. 224load_foreign_library(LibFile, Module, DefEntry) :- 225 retractall(error(_, _)), 226 find_library(LibFile, Path, Delete), 227 asserta(loading(LibFile)), 228 retractall(foreign_predicate(LibFile, _)), 229 catch(Module:open_shared_object(Path, Handle), E, true), 230 ( nonvar(E) 231 -> delete_foreign_lib(Delete, Path), 232 assert(error(Path, E)), 233 fail 234 ; delete_foreign_lib(Delete, Path) 235 ), 236 !, 237 ( entry(LibFile, DefEntry, Entry), 238 Module:call_shared_object_function(Handle, Entry) 239 -> retractall(loading(LibFile)), 240 assert_shlib(LibFile, Entry, Path, Module, Handle) 241 ; foreign_predicate(LibFile, _) 242 -> retractall(loading(LibFile)) % C++ object installed predicates 243 ; retractall(loading(LibFile)), 244 retractall(foreign_predicate(LibFile, _)), 245 close_shared_object(Handle), 246 findall(Entry, entry(LibFile, DefEntry, Entry), Entries), 247 throw(error(existence_error(foreign_install_function, 248 install(Path, Entries)), 249 _)) 250 ). 251load_foreign_library(LibFile, _, _) :- 252 retractall(loading(LibFile)), 253 ( error(_Path, E) 254 -> retractall(error(_, _)), 255 throw(E) 256 ; throw(error(existence_error(foreign_library, LibFile), _)) 257 ). 258 259delete_foreign_lib(true, Path) :- 260 catch(delete_file(Path), _, true). 261delete_foreign_lib(_, _).

281use_foreign_library(FileSpec) :- 282 initialization(load_foreign_library(FileSpec), now). 283 284use_foreign_library(FileSpec, Entry) :- 285 initialization(load_foreign_library(FileSpec, Entry), now).

295unload_foreign_library(LibFile) :- 296 unload_foreign_library(LibFile, default(uninstall)). 297 298unload_foreign_library(LibFile, DefUninstall) :- 299 with_mutex('$foreign', do_unload(LibFile, DefUninstall)). 300 301do_unload(LibFile, DefUninstall) :- 302 current_library(LibFile, _, _, Module, Handle), 303 retractall(current_library(LibFile, _, _, _, _)), 304 ( entry(LibFile, DefUninstall, Uninstall), 305 Module:call_shared_object_function(Handle, Uninstall) 306 -> true 307 ; true 308 ), 309 abolish_foreign(LibFile), 310 close_shared_object(Handle). 311 312abolish_foreign(LibFile) :- 313 ( retract(foreign_predicate(LibFile, Module:Head)), 314 functor(Head, Name, Arity), 315 abolish(Module:Name, Arity), 316 fail 317 ; true 318 ). 319 320system:'$foreign_registered'(M, H) :- 321 ( loading(Lib) 322 -> true 323 ; Lib = '<spontaneous>' 324 ), 325 assert(foreign_predicate(Lib, M:H)). 326 327assert_shlib(File, Entry, Path, Module, Handle) :- 328 retractall(current_library(File, _, _, _, _)), 329 asserta(current_library(File, Entry, Path, Module, Handle)). 330 331 332 /******************************* 333 * ADMINISTRATION * 334 *******************************/

340current_foreign_library(File, Public) :- 341 current_library(File, _Entry, _Path, _Module, _Handle), 342 findall(Pred, foreign_predicate(File, Pred), Public). 343 344 345 /******************************* 346 * RELOAD * 347 *******************************/

354reload_foreign_libraries :- 355 findall(lib(File, Entry, Module), 356 ( retract(current_library(File, Entry, _, Module, _)), 357 File \== - 358 ), 359 Libs), 360 reverse(Libs, Reversed), 361 reload_libraries(Reversed). 362 363reload_libraries([]). 364reload_libraries([lib(File, Entry, Module)|T]) :- 365 ( load_foreign_library(File, Module, Entry) 366 -> true 367 ; print_message(error, shlib(File, load_failed)) 368 ), 369 reload_libraries(T). 370 371 372 /******************************* 373 * CLEANUP (WINDOWS ...) * 374 *******************************/ 375 376/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 377Called from Halt() in pl-os.c (if it is defined), *after* all at_halt/1 378hooks have been executed, and after dieIO(), closing and flushing all 379files has been called. 380 381On Unix, this is not very useful, and can only lead to conflicts. 382- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 383 384unload_all_foreign_libraries :- 385 current_prolog_flag(unload_foreign_libraries, true), 386 !, 387 forall(current_library(File, _, _, _, _), 388 unload_foreign(File)). 389unload_all_foreign_libraries.

398unload_foreign(File) :- 399 unload_foreign_library(File), 400 ( clause(foreign_predicate(Lib, M:H), true, Ref), 401 ( Lib == '<spontaneous>' 402 -> functor(H, Name, Arity), 403 abolish(M:Name, Arity), 404 erase(Ref), 405 fail 406 ; ! 407 ) 408 -> true 409 ; true 410 ). 411 412 /******************************* 413 * MESSAGES * 414 *******************************/ 415 416:- multifile 417 prolog:message//1, 418 prolog:error_message//1. 419 420prolog:message(shlib(LibFile, load_failed)) --> 421 [ '~w: Failed to load file'-[LibFile] ]. 422prolog:message(shlib(not_supported)) --> 423 [ 'Emulator does not support foreign libraries' ]. 424 425prolog:error_message(existence_error(foreign_install_function, 426 install(Lib, List))) --> 427 [ 'No install function in ~q'-[Lib], nl, 428 '\tTried: ~q'-[List] 429 ]