try to improve dll search

This commit is contained in:
vscosta 2017-09-02 23:50:09 +01:00
parent 51d9637fc4
commit f255d629e9
2 changed files with 41 additions and 93 deletions

View File

@ -24,8 +24,6 @@
:- use_system_module( '$_modules', ['$do_import'/3]).
:- multifile user:system_foreign/1.
/**
@ -37,6 +35,11 @@
*/
maplist_(_, [], []).
maplist_(Pred, [A1|L1], [A2|L2]) :-
call(Pred, A1, A2),
maplist_(Pred, L1, L2).
/** @pred load_foreign_files( _Files_, _Libs_, _InitRoutine_)
should be used, from inside YAP, to load object files produced by the C
@ -58,96 +61,44 @@ if defined, or in the default library.
YAP supports the SWI-Prolog interface to loading foreign code, the shlib package.
*/
load_foreign_files(Objs,Libs,Entry) :-
source_module(M),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
'$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)),
'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
(
recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
->
%G = load_foreign_files(Objs,Libs,Entry),
'$absfs'( Objs, [file_type(executable),
access(read),
expand(true),
file_errors(fail)], NewObjs),
maplist_( '$load_lib', Libs, NewLibs),
'$load_foreign_files'(NewObjs,NewLibs,Entry),
!,
prolog_load_context(file, F),
ignore( recordzifnot( '$load_foreign_done', [F, M], _) ).
'$load_foreign_files'(NewObjs,NewLibs,Entry),
(
prolog_load_context(file, F)
->
ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
;
true
)
;
true
),
!.
'$absfs'([],_P,[]).
'$absfs'([F|Fs],P,[NF|NFs]) :-
'$name_object'(F, P, NF),
!,
'$absfs'(Fs,P,NFs).
'$absfs'([F|Fs],P,[F|NFs]) :-
'$absfs'(Fs,P,NFs).
/** @pred load_absolute_foreign_files( _Files_, _Libs_, _InitRoutine_)
'$name_object'(I, P, O) :-
atom(I),
!,
absolute_file_name(foreign(I), O, P).
'$name_object'(I, P, O) :-
absolute_file_name(I, O, P).
'$load_lib'(_,L,L).
/** @pred load_absolute_foreign_files( Files, Libs, InitRoutine)
Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_.
*/
load_absolute_foreign_files(Objs,Libs,Entry) :-
source_module(M),
(
recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
->
'$load_foreign_files'(Objs,Libs,Entry),
(
prolog_load_context(file, F)
->
ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
;
true
)
;
true
),
!.
'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_objs_for_load_foreign_files'([],[],_) :- !.
'$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !,
'$check_obj_for_load_foreign_files'(Obj,NObj,G),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,G).
'$check_objs_for_load_foreign_files'(Objs,_,G) :-
'$do_error'(type_error(list,Objs),G).
'$check_obj_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !,
( atom(Obj), Obj1 = foreign(Obj) ; Obj1 = Obj ),
absolute_file_name(foreign(Obj),[file_type(executable),
access(read),
expand(true),
file_errors(fail)
], NewObj).
'$check_obj_for_load_foreign_files'(Obj,_,G) :-
'$do_error'(type_error(atom,Obj),G).
'$check_libs_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_libs_for_load_foreign_files'([],[],_) :- !.
'$check_libs_for_load_foreign_files'([Lib|Libs],[NLib|NLibs],G) :- !,
'$check_lib_for_load_foreign_files'(Lib,NLib,G),
'$check_libs_for_load_foreign_files'(Libs,NLibs,G).
'$check_libs_for_load_foreign_files'(Libs,_,G) :-
'$do_error'(type_error(list,Libs),G).
'$check_lib_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_lib_for_load_foreign_files'(Lib,NLib,_) :- atom(Lib), !,
'$process_obj_suffix'(Lib,NewLib),
'$checklib_prefix'(NewLib,NLib).
'$check_lib_for_load_foreign_files'(Lib,_,G) :-
'$do_error'(type_error(atom,Lib),G).
'$process_obj_suffix'(Obj,Obj) :-
current_prolog_flag(shared_object_extension, ObjSuffix),
sub_atom(Obj, _, _, 0, ObjSuffix), !.
'$process_obj_suffix'(Obj,NewObj) :-
current_prolog_flag(shared_object_extension, ObjSuffix),
atom_concat([Obj,'.',ObjSuffix],NewObj).
load_absolute_foreign_files(_Objs,_Libs,_Entry).
'$checklib_prefix'(F,F) :- is_absolute_file_name(F), !.
'$checklib_prefix'(F, F) :-
sub_atom(F, 0, _, _, lib), !.
@ -163,12 +114,6 @@ load_absolute_foreign_files(Objs,Libs,Entry) :-
fail.
'$import_foreign'(_F, _M0, _M).
'$check_entry_for_load_foreign_files'(V,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_entry_for_load_foreign_files'(Entry,_) :- atom(Entry), !.
'$check_entry_for_load_foreign_files'(Entry,G) :-
'$do_error'(type_error(atom,Entry),G).
/** @pred open_shared_object(+ _File_, - _Handle_)
File is the name of a shared object file (called dynamic load

View File

@ -74,10 +74,13 @@ commons_directory( Path ):-
foreign_directory(Home) :-
current_prolog_flag(prolog_foreign_directory, Home),
Home \= ''.
foreign_directory(C) :-
current_prolog_flag(windows, true),
file_search_path(path, C).
foreign_directory( '.').
foreign_directory(yap('lib/Yap')).
foreign_directory( Path ):-
system_foreign( Path ).
%foreign_directory( Path ):-
% system_foreign( Path ).
/**
@pred prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic
@ -118,7 +121,7 @@ prolog_file_type(qly, qly).
prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
prolog_file_type(pyd, executable).
/**
@pred file_search_path(+Name:atom, -Directory:atom) is nondet