414 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
			
		
		
	
	
			414 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
| /*  $Id$
 | |
| 
 | |
|     Part of SWI-Prolog
 | |
| 
 | |
|     Author:        Jan Wielemaker
 | |
|     E-mail:        J.Wielemaker@cs.vu.nl
 | |
|     WWW:           http://www.swi-prolog.org
 | |
|     Copyright (C): 1985-2009, University of Amsterdam
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or
 | |
|     modify it under the terms of the GNU General Public License
 | |
|     as published by the Free Software Foundation; either version 2
 | |
|     of the License, or (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     You should have received a copy of the GNU Lesser General Public
 | |
|     License along with this library; if not, write to the Free Software
 | |
|     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 | |
| 
 | |
|     As a special exception, if you link this library with other files,
 | |
|     compiled with a Free Software compiler, to produce an executable, this
 | |
|     library does not by itself cause the resulting executable to be covered
 | |
|     by the GNU General Public License. This exception does not however
 | |
|     invalidate any other reasons why the executable file might be covered by
 | |
|     the GNU General Public License.
 | |
| */
 | |
| 
 | |
| :- module(shlib,
 | |
| 	  [ load_foreign_library/1,	% :LibFile
 | |
| 	    load_foreign_library/2,	% :LibFile, +InstallFunc
 | |
| 	    unload_foreign_library/1,	% +LibFile
 | |
| 	    unload_foreign_library/2,	% +LibFile, +UninstallFunc
 | |
| 	    current_foreign_library/2,	% ?LibFile, ?Public
 | |
| 	    reload_foreign_libraries/0,
 | |
| 					% Directives
 | |
| 	    use_foreign_library/1,	% :LibFile
 | |
| 	    use_foreign_library/2	% :LibFile, +InstallFunc
 | |
| 	  ]).
 | |
| :- use_module(library(lists), [reverse/2]).
 | |
| :- set_prolog_flag(generate_debug_info, false).
 | |
| 
 | |
| /** <module> Utility library for loading foreign objects (DLLs, shared objects)
 | |
| @ingroup swi
 | |
| 
 | |
| 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 plld(1)
 | |
| utility can be used to deal with this in a portable manner.  The typical
 | |
| commandline is:
 | |
| 
 | |
| 	==
 | |
| 	plld -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.
 | |
| */
 | |
| 
 | |
| :- meta_predicate
 | |
| 	load_foreign_library(:),
 | |
| 	load_foreign_library(:, +),
 | |
| 	use_foreign_library(:),
 | |
| 	use_foreign_library(:, +).
 | |
| 
 | |
| :- multifile
 | |
| 	foreign_predicate/2,		% Lib, Pred
 | |
| 	current_library/5.
 | |
| 
 | |
| :- dynamic
 | |
| 	loading/1,			% Lib
 | |
| 	error/2,			% File, Error
 | |
| 	foreign_predicate/2,		% Lib, Pred
 | |
| 	current_library/5.		% Lib, Entry, Path, Module, Handle
 | |
| 
 | |
| :- volatile				% Do not store in state
 | |
| 	loading/1,
 | |
| 	error/2,
 | |
| 	foreign_predicate/2,
 | |
| 	current_library/5.
 | |
| 
 | |
| :- (   current_prolog_flag(open_shared_object, true)
 | |
|    ->  true
 | |
|    ;   print_message(warning, shlib(not_supported)) % error?
 | |
|    ).
 | |
| 
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *	     DISPATCHING	*
 | |
| 		 *******************************/
 | |
| 
 | |
| /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 | |
| Windows: If libpl.dll is compiled for debugging, prefer loading <lib>D.dll
 | |
| to allow for debugging.
 | |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 | |
| 
 | |
| find_library(Spec, Lib) :-
 | |
| 	current_prolog_flag(windows, true),
 | |
| 	current_prolog_flag(kernel_compile_mode, debug),
 | |
| 	libd_spec(Spec, SpecD),
 | |
| 	catch(find_library2(SpecD, Lib), _, fail).
 | |
| find_library(Spec, Lib) :-
 | |
| 	find_library2(Spec, Lib).
 | |
| 
 | |
| find_library2(Spec, Lib) :-
 | |
| 	absolute_file_name(Spec,
 | |
| 			   [ file_type(executable),
 | |
| 			     access(read),
 | |
| 			     file_errors(fail)
 | |
| 			   ], Lib), !.
 | |
| find_library2(Spec, Spec) :-
 | |
| 	atom(Spec), !.			% use machines finding schema
 | |
| find_library2(foreign(Spec), Spec) :-
 | |
| 	atom(Spec), !.			% use machines finding schema
 | |
| find_library2(Spec, _) :-
 | |
| 	throw(error(existence_error(source_sink, Spec), _)).
 | |
| 
 | |
| libd_spec(Name, NameD) :-
 | |
| 	atomic(Name),
 | |
| 	file_name_extension(Base, Ext, Name),
 | |
| 	atom_concat(Base, 'D', BaseD),
 | |
| 	file_name_extension(BaseD, Ext, NameD).
 | |
| libd_spec(Spec, SpecD) :-
 | |
| 	compound(Spec),
 | |
| 	Spec =.. [Alias,Name],
 | |
| 	libd_spec(Name, NameD),
 | |
| 	SpecD =.. [Alias,NameD].
 | |
| libd_spec(Spec, Spec).			% delay errors
 | |
| 
 | |
| base(Path, Base) :-
 | |
| 	atomic(Path), !,
 | |
| 	file_base_name(Path, File), 
 | |
| 	file_name_extension(Base, _Ext, File).
 | |
| base(Path, Base) :-
 | |
| 	Path =.. [_,Arg],
 | |
| 	base(Arg, Base).
 | |
| 
 | |
| entry(_, Function, Function) :-
 | |
| 	Function \= default(_), !.
 | |
| entry(Spec, default(FuncBase), Function) :-
 | |
| 	base(Spec, Base),
 | |
| 	atomic_list_concat([FuncBase, Base], '_', Function).
 | |
| entry(_, default(Function), Function).
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *	    (UN)LOADING		*
 | |
| 		 *******************************/
 | |
| 
 | |
| %%	load_foreign_library(:FileSpec) is det.
 | |
| %%	load_foreign_library(:FileSpec, +Entry:atom) is det.
 | |
| %
 | |
| %	Load a _|shared object|_  or  _DLL_.   After  loading  the Entry
 | |
| %	function is called without arguments. The default entry function
 | |
| %	is composed from =install_=,  followed   by  the file base-name.
 | |
| %	E.g.,    the    load-call    below      calls    the    function
 | |
| %	=|install_mylib()|=. If the platform   prefixes extern functions
 | |
| %	with =_=, this prefix is added before calling.
 | |
| %
 | |
| %	  ==
 | |
| %	  	...
 | |
| %	  	load_foreign_library(foreign(mylib)),
 | |
| %	  	...
 | |
| %	  ==
 | |
| %
 | |
| %	@param	FileSpec is a specification for absolute_file_name/3.  If searching
 | |
| %		the file fails, the plain name is passed to the OS to try the default
 | |
| %		method of the OS for locating foreign objects.  The default definition
 | |
| %		of file_search_path/2 searches <prolog home>/lib/<arch> on Unix and
 | |
| %		<prolog home>/bin on Windows.
 | |
| %
 | |
| %	@see	use_foreign_library/1,2 are intended for use in directives.
 | |
| 
 | |
| load_foreign_library(Library) :-
 | |
| 	load_foreign_library(Library, default(install)).
 | |
| 
 | |
| load_foreign_library(Module:LibFile, Entry) :-
 | |
| 	with_mutex('$foreign',
 | |
| 		   load_foreign_library(LibFile, Module, Entry)).
 | |
| 
 | |
| load_foreign_library(LibFile, _Module, _) :-
 | |
| 	current_library(LibFile, _, _, _, _), !.
 | |
| load_foreign_library(LibFile, Module, DefEntry) :-
 | |
| 	retractall(error(_, _)),
 | |
| 	find_library(LibFile, Path),
 | |
| 	asserta(loading(LibFile)),
 | |
| 	catch(Module:open_shared_object(Path, Handle), E, true),
 | |
| 	(   nonvar(E)
 | |
| 	->  assert(error(Path, E)),
 | |
| 	    fail
 | |
| 	;   true
 | |
| 	), !,
 | |
| 	(   (	entry(LibFile, DefEntry, Entry),
 | |
| 		Module:call_shared_object_function(Handle, Entry)
 | |
| 	    ->	true
 | |
| 	    ;	DefEntry == default(install)
 | |
| 	    )
 | |
| 	->  retractall(loading(LibFile)),
 | |
| 	    assert_shlib(LibFile, Entry, Path, Module, Handle)
 | |
| 	;   retractall(loading(LibFile)),
 | |
| 	    close_shared_object(Handle),
 | |
| 	    print_message(error, shlib(LibFile, call_entry(DefEntry))),
 | |
| 	    fail
 | |
| 	).
 | |
| load_foreign_library(LibFile, _, _) :-
 | |
| 	retractall(loading(LibFile)),
 | |
| 	(   error(_Path, E)
 | |
| 	->  retractall(error(_, _)),
 | |
| 	    throw(E)
 | |
| 	;   throw(error(existence_error(foreign_library, LibFile), _))
 | |
| 	).
 | |
| 
 | |
| %%	use_foreign_library(+FileSpec) is det.
 | |
| %%	use_foreign_library(+FileSpec, +Entry:atom) is det.
 | |
| %
 | |
| %	Load and install a foreign   library as load_foreign_library/1,2
 | |
| %	and register the installation using   initialization/2  with the
 | |
| %	option =now=. This is similar to using:
 | |
| %
 | |
| %	  ==
 | |
| %	  :- initialization(load_foreign_library(foreign(mylib))).
 | |
| %	  ==
 | |
| %
 | |
| %	but using the initialization/1 wrapper causes  the library to be
 | |
| %	loaded _after_ loading of  the  file   in  which  it  appears is
 | |
| %	completed,  while  use_foreign_library/1  loads    the   library
 | |
| %	_immediately_. I.e. the  difference  is   only  relevant  if the
 | |
| %	remainder of the file uses functionality of the C-library.
 | |
| 
 | |
| use_foreign_library(FileSpec) :-
 | |
| 	initialization(load_foreign_library(FileSpec), now).
 | |
| 
 | |
| use_foreign_library(FileSpec, Entry) :-
 | |
| 	initialization(load_foreign_library(FileSpec, Entry), now).
 | |
| 
 | |
| %%	unload_foreign_library(+FileSpec) is det.
 | |
| %%	unload_foreign_library(+FileSpec, +Exit:atom) is det.
 | |
| %
 | |
| %	Unload a _|shared object|_ or  _DLL_.   After  calling  the Exit
 | |
| %	function, the shared object is  removed   from  the process. The
 | |
| %	default exit function is composed from =uninstall_=, followed by
 | |
| %	the file base-name.
 | |
| 
 | |
| unload_foreign_library(LibFile) :-
 | |
| 	unload_foreign_library(LibFile, default(uninstall)).
 | |
| 
 | |
| unload_foreign_library(LibFile, DefUninstall) :-
 | |
| 	with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
 | |
| 
 | |
| do_unload(LibFile, DefUninstall) :-
 | |
| 	current_library(LibFile, _, _, Module, Handle),
 | |
| 	retractall(current_library(LibFile, _, _, _, _)),
 | |
| 	(   entry(LibFile, DefUninstall, Uninstall),
 | |
| 	    Module:call_shared_object_function(Handle, Uninstall)
 | |
| 	->  true
 | |
| 	;   true
 | |
| 	),
 | |
| 	abolish_foreign(LibFile),
 | |
| 	close_shared_object(Handle).
 | |
| 
 | |
| abolish_foreign(LibFile) :-
 | |
| 	(   retract(foreign_predicate(LibFile, Module:Head)),
 | |
| 	    functor(Head, Name, Arity),
 | |
| 	    abolish(Module:Name, Arity),
 | |
| 	    fail
 | |
| 	;   true
 | |
| 	).
 | |
| 
 | |
| system:'$foreign_registered'(M, H) :-
 | |
| 	(   loading(Lib)
 | |
| 	->  true
 | |
| 	;   Lib = '<spontaneous>'
 | |
| 	),
 | |
| 	assert(foreign_predicate(Lib, M:H)).
 | |
| 
 | |
| assert_shlib(File, Entry, Path, Module, Handle) :-
 | |
| 	retractall(current_library(File, _, _, _, _)),
 | |
| 	asserta(current_library(File, Entry, Path, Module, Handle)).
 | |
| 
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *	 ADMINISTRATION		*
 | |
| 		 *******************************/
 | |
| 
 | |
| %%	current_foreign_library(?File, ?Public)
 | |
| %
 | |
| %	Query currently loaded shared libraries.
 | |
| 
 | |
| current_foreign_library(File, Public) :-
 | |
| 	current_library(File, _Entry, _Path, _Module, _Handle),
 | |
| 	findall(Pred, foreign_predicate(File, Pred), Public).
 | |
| 
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *	      RELOAD		*
 | |
| 		 *******************************/
 | |
| 
 | |
| %%	reload_foreign_libraries
 | |
| %
 | |
| %	Reload all foreign libraries loaded (after restore of a state
 | |
| %	created using qsave_program/2.
 | |
| 
 | |
| reload_foreign_libraries :-
 | |
| 	findall(lib(File, Entry, Module),
 | |
| 		(   retract(current_library(File, Entry, _, Module, _)),
 | |
| 		    File \== -
 | |
| 		),
 | |
| 		Libs),
 | |
| 	reverse(Libs, Reversed),
 | |
| 	reload_libraries(Reversed).
 | |
| 
 | |
| reload_libraries([]).
 | |
| reload_libraries([lib(File, Entry, Module)|T]) :-
 | |
| 	(   load_foreign_library(File, Module, Entry)
 | |
| 	->  true
 | |
| 	;   print_message(error, shlib(File, load_failed))
 | |
| 	),
 | |
| 	reload_libraries(T).
 | |
| 
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *     CLEANUP (WINDOWS ...)	*
 | |
| 		 *******************************/
 | |
| 
 | |
| /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 | |
| Called from Halt() in pl-os.c (if it  is defined), *after* all at_halt/1
 | |
| hooks have been executed, and after   dieIO(),  closing and flushing all
 | |
| files has been called.
 | |
| 
 | |
| On Unix, this is not very useful, and can only lead to conflicts.
 | |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 | |
| 
 | |
| unload_all_foreign_libraries :-
 | |
| 	current_prolog_flag(unix, true), !.
 | |
| unload_all_foreign_libraries :-
 | |
| 	forall(current_library(File, _, _, _, _),
 | |
| 	       unload_foreign(File)).
 | |
| 
 | |
| %%	unload_foreign(+File)
 | |
| %
 | |
| %	Unload the given foreign file and all `spontaneous' foreign
 | |
| %	predicates created afterwards. Handling these spontaneous
 | |
| %	predicates is a bit hard, as we do not know who created them and
 | |
| %	on which library they depend.
 | |
| 
 | |
| unload_foreign(File) :-
 | |
| 	unload_foreign_library(File),
 | |
| 	(   clause(foreign_predicate(Lib, M:H), true, Ref),
 | |
| 	    (	Lib == '<spontaneous>'
 | |
| 	    ->	functor(H, Name, Arity),
 | |
| 		abolish(M:Name, Arity),
 | |
| 		erase(Ref),
 | |
| 		fail
 | |
| 	    ;	!
 | |
| 	    )
 | |
| 	->  true
 | |
| 	;   true
 | |
| 	).
 | |
| 
 | |
| 		 /*******************************
 | |
| 		 *	      MESSAGES		*
 | |
| 		 *******************************/
 | |
| 
 | |
| :- multifile
 | |
| 	prolog:message/3.
 | |
| 
 | |
| prolog:message(shlib(LibFile, call_entry(DefEntry))) -->
 | |
| 	[ '~w: Failed to call entry-point ~w'-[LibFile, DefEntry] ].
 | |
| prolog:message(shlib(LibFile, load_failed)) -->
 | |
| 	[ '~w: Failed to load file'-[LibFile] ].
 | |
| prolog:message(shlib(not_supported)) -->
 | |
| 	[ 'Emulator does not support foreign libraries' ].
 |