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. |