1		% (c) 2011-2026 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		% pass -Dno_interrupts=true to sicstus
24
25		:- write('user interrupt handling for CTRL-C disabled'),nl.
26
27		user_interruptable_call_det(Call,Result) :- call(Call), Result=ok.
28		ignore_user_interrupt_det(Call) :- call(Call).
29		protect_from_user_interrupt_det(Call) :- call(Call).
30		get_user_signal_ref(off).
31		init_user_signal(ok).
32
33		:- else.
34		foreign_resource(user_signal, [set_user_signal_mode,get_user_signal_mode,user_signal_init,get_user_sig_reference]).
35		foreign(user_signal_init, user_signal_init).
36		foreign(set_user_signal_mode, set_user_signal_mode(+integer,+integer)).
37		foreign(get_user_signal_mode, get_user_signal_mode([-integer])).
38		foreign(get_user_sig_reference, get_user_sig_reference([-integer])).
39
40		:- dynamic loaded/1.
41
42		:- use_module(probsrc(pathes_lib),[safe_load_foreign_resource/2]).
43
44		init_user_signal(Res) :- catch((loadfr,(loaded(success) -> Res=ok ; Res=fail)), Exc, Res=Exc).
45
46		loadfr :-
47		( loaded(_) -> true
48		; safe_load_foreign_resource(user_signal,user_signal)
49		-> user_signal_init,
50		%write(user_signal_int),nl,
51		assertz(loaded(success))
52		; format(user_output,"You can set the environment variable no_interrupts to true to avoid using the user_interrupt library~n",[]),
53		assertz(loaded(failure))
54		).
55
56
57		% user signal mode can by
58		% status_ignore=0, status_protected=1, status_default=2
59		% mode 2: a received signal will raise a Prolog exception
60
61		:- meta_predicate catch_interrupt_exception(0,-).
62		catch_interrupt_exception(Call,Result) :-
63		catch( call(Call),
64		E,
65		(E==user_interrupt_signal -> Result=interrupted ; throw(E))),
66		(Result == interrupted -> true ; Result=ok).
67
68		%% user_interruptable_call_det(Call,Result) :- !,call(Call), Result=ok. % comment in to turn off CTRL-C
69		user_interruptable_call_det(Call,Result) :-
70		loadfr,
71		get_user_signal_mode(Mode),
72		% the mode is switched inside catch_interrupt_exception, so that an interrupt arriving
73		% just before Call starts or just after it finishes is also caught
74		catch_interrupt_exception(
75		call_cleanup( (set_user_signal_mode(1,2), % 2=status_default -> raise exceptions
76		call(Call),!),
77		set_user_signal_mode(1,Mode)), % look_for_queued=1 -> raise exception if one is queued
78		Result).
79
80		%% protect_from_user_interrupt_det(Call) :- !. % comment in to turn off CTRL-C
81		protect_from_user_interrupt_det(Call) :-
82		loadfr,
83		get_user_signal_mode(Mode),
84		call_cleanup( (set_user_signal_mode(0,1), call(Call), !), % look_for_queued=0, 1=status_protected; CTRL-C queued
85		set_user_signal_mode(1,Mode)). % look_for_queued=1 -> raise exception if one is queued
86
87		ignore_user_interrupt_det(Call) :-
88		loadfr,
89		get_user_signal_mode(Mode),
90		call_cleanup( (set_user_signal_mode(0,0), call(Call), !), % 0=status_ignore; CTRL-C completely ignored
91		set_user_signal_mode(0,Mode)).
92
93		get_user_signal_ref(Ref) :-
94		loadfr,
95		get_user_sig_reference(Ref).
96		:- endif.