1		% (c) 2011-2015 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
10		:- use_module('../../src/module_information.pl').
11
12		:- module_info(group,infrastructure).
13		:- module_info(description,'This is the interface to C code for interrupting Prolog runs with a UNIX signal.').
14
15		:- meta_predicate user_interruptable_call_det(0,-).
16		:- meta_predicate protect_from_user_interrupt_det(0).
17		:- meta_predicate ignore_user_interrupt_det(0).
18
19		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
20		:- if(environ(no_interrupts,true)).
21		% turn off user interrupt handling: ctrl-c jumps into Prolog debugger
22
23		user_interruptable_call_det(Call,Result) :- call(Call), Result=ok.
24		ignore_user_interrupt_det(Call) :- call(Call).
25		protect_from_user_interrupt_det(Call) :- call(Call).
26		get_user_signal_ref(off).
27
28		:- else.
29		foreign_resource(user_signal, [set_user_signal_mode,get_user_signal_mode,user_signal_init,get_user_sig_reference]).
30		foreign(user_signal_init, user_signal_init).
31		foreign(set_user_signal_mode, set_user_signal_mode(+integer,+integer)).
32		foreign(get_user_signal_mode, get_user_signal_mode([-integer])).
33		foreign(get_user_sig_reference, get_user_sig_reference([-integer])).
34
35		:- dynamic loaded/0.
36
37		init_user_signal :- loadfr.
38
39		loadfr :-
40		( loaded -> true
41		; otherwise ->
42		load_foreign_resource(library(user_signal)),
43		user_signal_init,
44		%write(user_signal_int),nl,
45		assert(loaded)).
46
47		:- meta_predicate catch_interrupt_exception(0,-).
48		catch_interrupt_exception(Call,Result) :-
49		catch( call(Call),
50		E,
51		( E==user_interrupt_signal -> Result=interrupted
52		; otherwise -> throw(E))),
53		( Result == interrupted -> true
54		; otherwise -> Result=ok).
55
56		%% user_interruptable_call_det(Call,Result) :- !,call(Call), Result=ok. % comment in to turn off CTRL-C
57		user_interruptable_call_det(Call,Result) :-
58		loadfr,
59		get_user_signal_mode(Mode),
60		call_cleanup( (set_user_signal_mode(1,2),
61		catch_interrupt_exception(Call,Result),!),
62		set_user_signal_mode(1,Mode)).
63
64		%% protect_from_user_interrupt_det(Call) :- !. % comment in to turn off CTRL-C
65		protect_from_user_interrupt_det(Call) :-
66		loadfr,
67		get_user_signal_mode(Mode),
68		call_cleanup( (set_user_signal_mode(0,1), call(Call), !),
69		set_user_signal_mode(1,Mode)).
70
71		ignore_user_interrupt_det(Call) :-
72		loadfr,
73		get_user_signal_mode(Mode),
74		call_cleanup( (set_user_signal_mode(0,0), call(Call), !),
75		set_user_signal_mode(0,Mode)).
76
77		get_user_signal_ref(Ref) :-
78		loadfr,
79		get_user_sig_reference(Ref).
80		:- endif.