1		% (c) 2011-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(user_signal, [ user_interruptable_call_det/2
6		, protect_from_user_interrupt_det/1
7		, ignore_user_interrupt_det/1
8		, get_user_signal_ref/1
9		, init_user_signal/1]).
10
11		:- use_module('../../src/module_information.pl').
12
13		:- module_info(group,infrastructure).
14		:- module_info(description,'This is the interface to C code for interrupting Prolog runs with a UNIX signal.').
15
16		:- meta_predicate user_interruptable_call_det(0,-).
17		:- meta_predicate protect_from_user_interrupt_det(0).
18		:- meta_predicate ignore_user_interrupt_det(0).
19
20		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
21		:- if((environ(no_interrupts,true) ; \+ predicate_property(load_foreign_resource(_), _))).
22		% turn off user interrupt handling: ctrl-c jumps into Prolog debugger
23
24		:- write('user interrupt handling for CTRL-C disabled'),nl.
25
26		user_interruptable_call_det(Call,Result) :- call(Call), Result=ok.
27		ignore_user_interrupt_det(Call) :- call(Call).
28		protect_from_user_interrupt_det(Call) :- call(Call).
29		get_user_signal_ref(off).
30		init_user_signal(ok).
31
32		:- else.
33		foreign_resource(user_signal, [set_user_signal_mode,get_user_signal_mode,user_signal_init,get_user_sig_reference]).
34		foreign(user_signal_init, user_signal_init).
35		foreign(set_user_signal_mode, set_user_signal_mode(+integer,+integer)).
36		foreign(get_user_signal_mode, get_user_signal_mode([-integer])).
37		foreign(get_user_sig_reference, get_user_sig_reference([-integer])).
38
39		:- dynamic loaded/1.
40
41		:- use_module(probsrc(pathes_lib),[safe_load_foreign_resource/2]).
42
43		init_user_signal(Res) :- catch((loadfr,(loaded(success) -> Res=ok ; Res=fail)), Exc, Res=Exc).
44
45		loadfr :-
46		( loaded(_) -> true
47		; safe_load_foreign_resource(user_signal,user_signal)
48		-> user_signal_init,
49		%write(user_signal_int),nl,
50		assertz(loaded(success))
51		; format(user_output,"You can set the environment variable no_interrupts to true to avoid using the user_interrupt library~n",[]),
52		assertz(loaded(failure))
53		).
54
55
56		% user signal mode can by
57		% status_ignore=0, status_protected=1, status_default=2
58		% mode 2: a received signal will raise a Prolog exception
59
60		:- meta_predicate catch_interrupt_exception(0,-).
61		catch_interrupt_exception(Call,Result) :-
62	?	catch( call(Call),
63		E,
64		(E==user_interrupt_signal -> Result=interrupted ; throw(E))),
65		(Result == interrupted -> true ; Result=ok).
66
67		%% user_interruptable_call_det(Call,Result) :- !,call(Call), Result=ok. % comment in to turn off CTRL-C
68		user_interruptable_call_det(Call,Result) :-
69		loadfr,
70		get_user_signal_mode(Mode),
71		call_cleanup( (set_user_signal_mode(1,2), % 2=status_default -> raise exceptions
72		catch_interrupt_exception(Call,Result),!),
73		set_user_signal_mode(1,Mode)). % look_for_queued=1 -> raise exception if one is queued
74
75		%% protect_from_user_interrupt_det(Call) :- !. % comment in to turn off CTRL-C
76		protect_from_user_interrupt_det(Call) :-
77		loadfr,
78		get_user_signal_mode(Mode),
79		call_cleanup( (set_user_signal_mode(0,1), call(Call), !), % look_for_queued=0, 1=status_protected; CTRL-C queued
80		set_user_signal_mode(1,Mode)). % look_for_queued=1 -> raise exception if one is queued
81
82		ignore_user_interrupt_det(Call) :-
83		loadfr,
84		get_user_signal_mode(Mode),
85		call_cleanup( (set_user_signal_mode(0,0), call(Call), !), % 0=status_ignore; CTRL-C completely ignored
86		set_user_signal_mode(0,Mode)).
87
88		get_user_signal_ref(Ref) :-
89		loadfr,
90		get_user_sig_reference(Ref).
91		:- endif.