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). 49 50/** <module> Utility library for loading foreign objects (DLLs, shared objects) 51 52This section discusses the functionality of the (autoload) 53library(shlib), providing an interface to manage shared libraries. We 54describe the procedure for using a foreign resource (DLL in Windows and 55shared object in Unix) called =mylib=. 56 57First, one must assemble the resource and make it compatible to 58SWI-Prolog. The details for this vary between platforms. The swipl-ld(1) 59utility can be used to deal with this in a portable manner. The typical 60commandline is: 61 62 == 63 swipl-ld -o mylib file.{c,o,cc,C} ... 64 == 65 66Make sure that one of the files provides a global function 67=|install_mylib()|= that initialises the module using calls to 68PL_register_foreign(). Here is a simple example file mylib.c, which 69creates a Windows MessageBox: 70 71 == 72 #include <windows.h> 73 #include <SWI-Prolog.h> 74 75 static foreign_t 76 pl_say_hello(term_t to) 77 { char *a; 78 79 if ( PL_get_atom_chars(to, &a) ) 80 { MessageBox(NULL, a, "DLL test", MB_OK|MB_TASKMODAL); 81 82 PL_succeed; 83 } 84 85 PL_fail; 86 } 87 88 install_t 89 install_mylib() 90 { PL_register_foreign("say_hello", 1, pl_say_hello, 0); 91 } 92 == 93 94Now write a file mylib.pl: 95 96 == 97 :- module(mylib, [ say_hello/1 ]). 98 :- use_foreign_library(foreign(mylib)). 99 == 100 101The file mylib.pl can be loaded as a normal Prolog file and provides the 102predicate defined in C. 103*/ 104 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 *******************************/ 132 133%! find_library(+LibSpec, -Lib, -Delete) is det. 134% 135% Find a foreign library from LibSpec. If LibSpec is available as 136% a resource, the content of the resource is copied to a temporary 137% file and Delete is unified with =true=. 138 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 *******************************/ 189 190%! load_foreign_library(:FileSpec) is det. 191%! load_foreign_library(:FileSpec, +Entry:atom) is det. 192% 193% Load a _|shared object|_ or _DLL_. After loading the Entry 194% function is called without arguments. The default entry function 195% is composed from =install_=, followed by the file base-name. 196% E.g., the load-call below calls the function 197% =|install_mylib()|=. If the platform prefixes extern functions 198% with =_=, this prefix is added before calling. 199% 200% == 201% ... 202% load_foreign_library(foreign(mylib)), 203% ... 204% == 205% 206% @param FileSpec is a specification for absolute_file_name/3. If searching 207% the file fails, the plain name is passed to the OS to try the default 208% method of the OS for locating foreign objects. The default definition 209% of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and 210% <prolog home>/bin on Windows. 211% 212% @see use_foreign_library/1,2 are intended for use in directives. 213 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(_, _). 262 263 264%! use_foreign_library(+FileSpec) is det. 265%! use_foreign_library(+FileSpec, +Entry:atom) is det. 266% 267% Load and install a foreign library as load_foreign_library/1,2 268% and register the installation using initialization/2 with the 269% option =now=. This is similar to using: 270% 271% == 272% :- initialization(load_foreign_library(foreign(mylib))). 273% == 274% 275% but using the initialization/1 wrapper causes the library to be 276% loaded _after_ loading of the file in which it appears is 277% completed, while use_foreign_library/1 loads the library 278% _immediately_. I.e. the difference is only relevant if the 279% remainder of the file uses functionality of the C-library. 280 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). 286 287%! unload_foreign_library(+FileSpec) is det. 288%! unload_foreign_library(+FileSpec, +Exit:atom) is det. 289% 290% Unload a _|shared object|_ or _DLL_. After calling the Exit 291% function, the shared object is removed from the process. The 292% default exit function is composed from =uninstall_=, followed by 293% the file base-name. 294 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 *******************************/ 335 336%! current_foreign_library(?File, ?Public) 337% 338% Query currently loaded shared libraries. 339 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 *******************************/ 348 349%! reload_foreign_libraries 350% 351% Reload all foreign libraries loaded (after restore of a state 352% created using qsave_program/2. 353 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. 390 391%! unload_foreign(+File) 392% 393% Unload the given foreign file and all `spontaneous' foreign 394% predicates created afterwards. Handling these spontaneous 395% predicates is a bit hard, as we do not know who created them and 396% on which library they depend. 397 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 420prologmessage(shlib(LibFile, load_failed)) --> 421 [ '~w: Failed to load file'-[LibFile] ]. 422prologmessage(shlib(not_supported)) --> 423 [ 'Emulator does not support foreign libraries' ]. 424 425prologerror_message(existence_error(foreign_install_function, 426 install(Lib, List))) --> 427 [ 'No install function in ~q'-[Lib], nl, 428 '\tTried: ~q'-[List] 429 ].