37
38:- module(shlib,
39 [ load_foreign_library/1, 40 load_foreign_library/2, 41 unload_foreign_library/1, 42 unload_foreign_library/2, 43 current_foreign_library/2, 44 reload_foreign_libraries/0,
45 46 use_foreign_library/1, 47 use_foreign_library/2 48 ]). 49:- if(current_predicate(win_add_dll_directory/2)). 50:- export(win_add_dll_directory/1). 51:- endif. 52
53:- autoload(library(error),[existence_error/2]). 54:- autoload(library(lists),[member/2,reverse/2]). 55
56:- set_prolog_flag(generate_debug_info, false). 57
112
113:- meta_predicate
114 load_foreign_library(:),
115 load_foreign_library(:, +). 116
117:- dynamic
118 loading/1, 119 error/2, 120 foreign_predicate/2, 121 current_library/5. 122
123:- volatile 124 loading/1,
125 error/2,
126 foreign_predicate/2,
127 current_library/5. 128
129:- '$notransact'((loading/1,
130 error/2,
131 foreign_predicate/2,
132 current_library/5)). 133
134:- ( current_prolog_flag(open_shared_object, true)
135 -> true
136 ; print_message(warning, shlib(not_supported)) 137 ). 138
142
143:- create_prolog_flag(res_keep_foreign, false,
144 [ keep(true) ]). 145
146
168
169
170 173
179
180find_library(Spec, TmpFile, true) :-
181 '$rc_handle'(Zipper),
182 term_to_atom(Spec, Name),
183 setup_call_cleanup(
184 zip_lock(Zipper),
185 setup_call_cleanup(
186 open_foreign_in_resources(Zipper, Name, In),
187 setup_call_cleanup(
188 tmp_file_stream(binary, TmpFile, Out),
189 copy_stream_data(In, Out),
190 close(Out)),
191 close(In)),
192 zip_unlock(Zipper)),
193 !.
194find_library(Spec, Lib, Copy) :-
195 absolute_file_name(Spec, Lib0,
196 [ file_type(executable),
197 access(read),
198 file_errors(fail)
199 ]),
200 !,
201 lib_to_file(Lib0, Lib, Copy).
202find_library(Spec, Spec, false) :-
203 atom(Spec),
204 !. 205find_library(foreign(Spec), Spec, false) :-
206 atom(Spec),
207 !. 208find_library(Spec, _, _) :-
209 throw(error(existence_error(source_sink, Spec), _)).
210
228
229lib_to_file(Res, TmpFile, true) :-
230 sub_atom(Res, 0, _, _, 'res://'),
231 !,
232 setup_call_cleanup(
233 open(Res, read, In, [type(binary)]),
234 setup_call_cleanup(
235 tmp_file_stream(binary, TmpFile, Out),
236 copy_stream_data(In, Out),
237 close(Out)),
238 close(In)).
239lib_to_file(Lib, Lib, false).
240
241
242open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :-
243 term_to_atom(foreign(Name), ForeignSpecAtom),
244 zipper_members_(Zipper, Entries),
245 entries_for_name(Entries, Name, Entries1),
246 compatible_architecture_lib(Entries1, Name, CompatibleLib),
247 zipper_goto(Zipper, file(CompatibleLib)),
248 zipper_open_current(Zipper, Stream,
249 [ type(binary),
250 release(true)
251 ]).
252
260
261zipper_members_(Zipper, Members) :-
262 zipper_goto(Zipper, first),
263 zip_members__(Zipper, Members).
264
265zip_members__(Zipper, [Name|T]) :-
266 zip_file_info_(Zipper, Name, _Attrs),
267 ( zipper_goto(Zipper, next)
268 -> zip_members__(Zipper, T)
269 ; T = []
270 ).
271
272
285
286compatible_architecture_lib([], _, _) :- !, fail.
287compatible_architecture_lib(Entries, Name, CompatibleLib) :-
288 current_prolog_flag(arch, HostArch),
289 ( member(shlib(EntryArch, Name), Entries),
290 qsave_compat_arch1(HostArch, EntryArch)
291 -> term_to_atom(shlib(EntryArch, Name), CompatibleLib)
292 ; existence_error(arch_compatible_with(Name), HostArch)
293 ).
294
295qsave_compat_arch1(Arch1, Arch2) :-
296 qsave:compat_arch(Arch1, Arch2), !.
297qsave_compat_arch1(Arch1, Arch2) :-
298 qsave:compat_arch(Arch2, Arch1), !.
299
307
308:- multifile qsave:compat_arch/2. 309
310qsave:compat_arch(A,A).
311
312entries_for_name([], _, []).
313entries_for_name([H0|T0], Name, [H|T]) :-
314 shlib_atom_to_term(H0, H),
315 match_filespec(Name, H),
316 !,
317 entries_for_name(T0, Name, T).
318entries_for_name([_|T0], Name, T) :-
319 entries_for_name(T0, Name, T).
320
321shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
322 sub_atom(Atom, 0, _, _, 'shlib('),
323 !,
324 term_to_atom(shlib(Arch,Name), Atom).
325shlib_atom_to_term(Atom, Atom).
326
327match_filespec(Name, shlib(_,Name)).
328
329base(Path, Base) :-
330 atomic(Path),
331 !,
332 file_base_name(Path, File),
333 file_name_extension(Base, _Ext, File).
334base(_/Path, Base) :-
335 !,
336 base(Path, Base).
337base(Path, Base) :-
338 Path =.. [_,Arg],
339 base(Arg, Base).
340
341entry(_, Function, Function) :-
342 Function \= default(_),
343 !.
344entry(Spec, default(FuncBase), Function) :-
345 base(Spec, Base),
346 atomic_list_concat([FuncBase, Base], '_', Function).
347entry(_, default(Function), Function).
348
349 352
381
382load_foreign_library(Library) :-
383 load_foreign_library(Library, []).
384
385load_foreign_library(Module:LibFile, InstallOrOptions) :-
386 ( is_list(InstallOrOptions)
387 -> Options = InstallOrOptions
388 ; Options = [install(InstallOrOptions)]
389 ),
390 with_mutex('$foreign',
391 load_foreign_library(LibFile, Module, Options)).
392
393load_foreign_library(LibFile, _Module, _) :-
394 current_library(LibFile, _, _, _, _),
395 !.
396load_foreign_library(LibFile, Module, Options) :-
397 retractall(error(_, _)),
398 find_library(LibFile, Path, Delete),
399 asserta(loading(LibFile)),
400 retractall(foreign_predicate(LibFile, _)),
401 catch(Module:open_shared_object(Path, Handle, Options), E, true),
402 ( nonvar(E)
403 -> delete_foreign_lib(Delete, Path),
404 assert(error(Path, E)),
405 fail
406 ; delete_foreign_lib(Delete, Path)
407 ),
408 !,
409 '$option'(install(DefEntry), Options, default(install)),
410 ( entry(LibFile, DefEntry, Entry),
411 Module:call_shared_object_function(Handle, Entry)
412 -> retractall(loading(LibFile)),
413 assert_shlib(LibFile, Entry, Path, Module, Handle)
414 ; foreign_predicate(LibFile, _)
415 -> retractall(loading(LibFile)), 416 assert_shlib(LibFile, 'C++', Path, Module, Handle)
417 ; retractall(loading(LibFile)),
418 retractall(foreign_predicate(LibFile, _)),
419 close_shared_object(Handle),
420 findall(Entry, entry(LibFile, DefEntry, Entry), Entries),
421 throw(error(existence_error(foreign_install_function,
422 install(Path, Entries)),
423 _))
424 ).
425load_foreign_library(LibFile, _, _) :-
426 retractall(loading(LibFile)),
427 ( error(_Path, E)
428 -> retractall(error(_, _)),
429 throw(E)
430 ; throw(error(existence_error(foreign_library, LibFile), _))
431 ).
432
433delete_foreign_lib(true, Path) :-
434 \+ current_prolog_flag(res_keep_foreign, true),
435 !,
436 catch(delete_file(Path), _, true).
437delete_foreign_lib(_, _).
438
439
447
448unload_foreign_library(LibFile) :-
449 unload_foreign_library(LibFile, default(uninstall)).
450
451unload_foreign_library(LibFile, DefUninstall) :-
452 with_mutex('$foreign', do_unload(LibFile, DefUninstall)).
453
454do_unload(LibFile, DefUninstall) :-
455 current_library(LibFile, _, _, Module, Handle),
456 retractall(current_library(LibFile, _, _, _, _)),
457 ( entry(LibFile, DefUninstall, Uninstall),
458 Module:call_shared_object_function(Handle, Uninstall)
459 -> true
460 ; true
461 ),
462 abolish_foreign(LibFile),
463 close_shared_object(Handle).
464
465abolish_foreign(LibFile) :-
466 ( retract(foreign_predicate(LibFile, Module:Head)),
467 functor(Head, Name, Arity),
468 abolish(Module:Name, Arity),
469 fail
470 ; true
471 ).
472
473system:'$foreign_registered'(M, H) :-
474 ( loading(Lib)
475 -> true
476 ; Lib = '<spontaneous>'
477 ),
478 assert(foreign_predicate(Lib, M:H)).
479
480assert_shlib(File, Entry, Path, Module, Handle) :-
481 retractall(current_library(File, _, _, _, _)),
482 asserta(current_library(File, Entry, Path, Module, Handle)).
483
484
485 488
492
493current_foreign_library(File, Public) :-
494 current_library(File, _Entry, _Path, _Module, _Handle),
495 findall(Pred, foreign_predicate(File, Pred), Public).
496
497
498 501
506
507reload_foreign_libraries :-
508 findall(lib(File, Entry, Module),
509 ( retract(current_library(File, Entry, _, Module, _)),
510 File \== -
511 ),
512 Libs),
513 reverse(Libs, Reversed),
514 reload_libraries(Reversed).
515
516reload_libraries([]).
517reload_libraries([lib(File, Entry, Module)|T]) :-
518 ( load_foreign_library(File, Module, Entry)
519 -> true
520 ; print_message(error, shlib(File, load_failed))
521 ),
522 reload_libraries(T).
523
524
525 528
536
537unload_all_foreign_libraries :-
538 current_prolog_flag(unload_foreign_libraries, true),
539 !,
540 forall(current_library(File, _, _, _, _),
541 unload_foreign(File)).
542unload_all_foreign_libraries.
543
550
551unload_foreign(File) :-
552 unload_foreign_library(File),
553 ( clause(foreign_predicate(Lib, M:H), true, Ref),
554 ( Lib == '<spontaneous>'
555 -> functor(H, Name, Arity),
556 abolish(M:Name, Arity),
557 erase(Ref),
558 fail
559 ; !
560 )
561 -> true
562 ; true
563 ).
564
565
566:- if(current_predicate(win_add_dll_directory/2)). 567
578
579win_add_dll_directory(Dir) :-
580 win_add_dll_directory(Dir, _),
581 !.
582win_add_dll_directory(Dir) :-
583 prolog_to_os_filename(Dir, OSDir),
584 getenv('PATH', Path0),
585 atomic_list_concat([Path0, OSDir], ';', Path),
586 setenv('PATH', Path).
587
591
592add_dll_directories :-
593 current_prolog_flag(msys2, true),
594 !,
595 env_add_dll_dir('MINGW_PREFIX', '/bin').
596add_dll_directories :-
597 current_prolog_flag(conda, true),
598 !,
599 env_add_dll_dir('CONDA_PREFIX', '/Library/bin'),
600 ignore(env_add_dll_dir('PREFIX', '/Library/bin')).
601add_dll_directories.
602
603env_add_dll_dir(Var, Postfix) :-
604 getenv(Var, Prefix),
605 atom_concat(Prefix, Postfix, Dir),
606 win_add_dll_directory(Dir).
607
608:- initialization
609 add_dll_directories. 610
611:- endif. 612
613 616
617:- dynamic
618 user:file_search_path/2. 619:- multifile
620 user:file_search_path/2. 621
622:- if((current_prolog_flag(apple, true),
623 current_prolog_flag(bundle, true))). 624user:file_search_path(foreign, swi('../../PlugIns/swipl')).
625:- elif(current_prolog_flag(apple_universal_binary, true)). 626user:file_search_path(foreign, swi('lib/fat-darwin'))
627:- elif((current_prolog_flag(windows, true),
628 current_prolog_flag(bundle, true))).
629user:file_search_path(foreign, swi(bin)).
630:- else. 631user:file_search_path(foreign, swi(ArchLib)) :-
632 current_prolog_flag(arch, Arch),
633 atom_concat('lib/', Arch, ArchLib).
634:- endif. 635
636 639
640:- multifile
641 prolog:message//1,
642 prolog:error_message//1. 643
644prolog:message(shlib(LibFile, load_failed)) -->
645 [ '~w: Failed to load file'-[LibFile] ].
646prolog:message(shlib(not_supported)) -->
647 [ 'Emulator does not support foreign libraries' ].
648
649prolog:error_message(existence_error(foreign_install_function,
650 install(Lib, List))) -->
651 [ 'No install function in ~q'-[Lib], nl,
652 '\tTried: ~q'-[List]
653 ]