216 lines
6.0 KiB
Prolog
216 lines
6.0 KiB
Prolog
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: signals.pl *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: signal handling in YAP *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
:- system_module( '$_signals', [alarm/3,
|
|
on_exception/3,
|
|
on_signal/3,
|
|
raise_exception/1,
|
|
read_sig/0], []).
|
|
|
|
:- use_system_module( '$_boot', ['$meta_call'/2]).
|
|
|
|
:- use_system_module( '$_debug', ['$do_spy'/4]).
|
|
|
|
:- use_system_module( '$_threads', ['$thread_gfetch'/1]).
|
|
|
|
:- meta_predicate on_signal(+,?,:), alarm(+,:,-).
|
|
|
|
'$creep'(G) :-
|
|
% get the first signal from the mask
|
|
'$first_signal'(Sig), !,
|
|
% process it
|
|
'$do_signal'(Sig, G).
|
|
'$creep'([M|G]) :-
|
|
% noise, just go on with our life.
|
|
'$execute'(M:G).
|
|
|
|
'$do_signal'(sig_wake_up, G) :-
|
|
'$awoken_goals'(LG),
|
|
% if more signals alive, set creep flag
|
|
'$continue_signals',
|
|
'$wake_up_goal'(G, LG).
|
|
% never creep on entering system mode!!!
|
|
% don't creep on meta-call.
|
|
'$do_signal'(sig_creep, MG) :-
|
|
'$start_creep'(MG, creep).
|
|
'$do_signal'(sig_iti, [M|G]) :-
|
|
'$thread_gfetch'(Goal),
|
|
% if more signals alive, set creep flag
|
|
'$continue_signals',
|
|
'$current_module'(M0),
|
|
'$execute0'(Goal,M0),
|
|
'$execute'(M:G).
|
|
'$do_signal'(sig_trace, [M|G]) :-
|
|
'$continue_signals',
|
|
trace,
|
|
'$execute'(M:G).
|
|
'$do_signal'(sig_debug, [M|G]) :-
|
|
'$continue_signals',
|
|
debug,
|
|
'$execute'(M:G).
|
|
'$do_signal'(sig_break, [M|G]) :-
|
|
'$continue_signals',
|
|
break,
|
|
'$execute0'(G,M).
|
|
'$do_signal'(sig_statistics, [M|G]) :-
|
|
'$continue_signals',
|
|
statistics,
|
|
'$execute0'(G,M).
|
|
% the next one should never be called...
|
|
'$do_signal'(fail, [_|_]) :-
|
|
fail.
|
|
'$do_signal'(sig_stack_dump, [M|G]) :-
|
|
'$continue_signals',
|
|
'$hacks':'$stack_dump',
|
|
'$execute0'(G,M).
|
|
% Unix signals
|
|
'$do_signal'(sig_alarm, G) :-
|
|
'$signal_handler'(sig_alarm, G).
|
|
'$do_signal'(sig_vtalarm, G) :-
|
|
'$signal_handler'(sig_vtalarm, G).
|
|
'$do_signal'(sig_hup, G) :-
|
|
'$signal_handler'(sig_hup, G).
|
|
'$do_signal'(sig_usr1, G) :-
|
|
'$signal_handler'(sig_usr1, G).
|
|
'$do_signal'(sig_usr2, G) :-
|
|
'$signal_handler'(sig_usr2, G).
|
|
'$do_signal'(sig_pipe, G) :-
|
|
'$signal_handler'(sig_pipe, G).
|
|
|
|
'$signal_handler'(Sig, [M|G]) :-
|
|
'$signal_do'(Sig, Goal),
|
|
% if more signals alive, set creep flag
|
|
'$continue_signals',
|
|
'$current_module'(M0),
|
|
'$execute0'((Goal,M:G),M0).
|
|
|
|
% we may be creeping outside and coming back to system mode.
|
|
'$start_creep'([M|G], _) :-
|
|
'$is_no_trace'(G, M), !,
|
|
'$execute0'(G, M).
|
|
'$start_creep'([Mod|G], WhereFrom) :-
|
|
CP is '$last_choice_pt',
|
|
'$do_spy'(G, Mod, CP, WhereFrom).
|
|
|
|
'$execute_goal'(G, Mod) :-
|
|
(
|
|
'$is_metapredicate'(G, Mod)
|
|
->
|
|
'$meta_call'(G,Mod)
|
|
;
|
|
'$execute_nonstop'(G,Mod)
|
|
).
|
|
|
|
|
|
'$signal_do'(Sig, Goal) :-
|
|
recorded('$signal_handler', action(Sig,Goal), _), !.
|
|
'$signal_do'(Sig, Goal) :-
|
|
'$signal_def'(Sig, Goal).
|
|
|
|
% reconsult init files.
|
|
'$signal_def'(sig_hup, (( exists('~/.yaprc') -> [-'~/.yaprc'] ; true ),
|
|
( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ),
|
|
( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))).
|
|
% die on signal default.
|
|
'$signal_def'(sig_usr1, throw(error(signal(usr1,[]),true))).
|
|
'$signal_def'(sig_usr2, throw(error(signal(usr2,[]),true))).
|
|
'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))).
|
|
% ignore sig_alarm by default
|
|
'$signal_def'(sig_alarm, true).
|
|
|
|
|
|
'$signal'(sig_hup).
|
|
'$signal'(sig_usr1).
|
|
'$signal'(sig_usr2).
|
|
'$signal'(sig_pipe).
|
|
'$signal'(sig_alarm).
|
|
'$signal'(sig_vtalarm).
|
|
|
|
on_signal(Signal,OldAction,NewAction) :-
|
|
var(Signal), !,
|
|
(nonvar(OldAction) -> throw(error(instantiation_error,on_signal/3)) ; true),
|
|
'$signal'(Signal),
|
|
on_signal(Signal, OldAction, NewAction).
|
|
on_signal(Signal,OldAction,default) :-
|
|
'$reset_signal'(Signal, OldAction).
|
|
on_signal(Signal,OldAction,Action) :-
|
|
var(Action), !,
|
|
throw(error(system_error,'Somehow the meta_predicate declarations of on_signal are subverted!')).
|
|
on_signal(Signal,OldAction,Action) :-
|
|
Action = (_:Goal),
|
|
var(Goal), !,
|
|
'$check_signal'(Signal, OldAction),
|
|
Goal = OldAction.
|
|
on_signal(Signal,OldAction,Action) :-
|
|
'$reset_signal'(Signal, OldAction),
|
|
% 13211-2 speaks only about callable
|
|
( Action = M:Goal -> true ; throw(error(type_error(callable,Action),on_signal/3)) ),
|
|
% the following disagrees with 13211-2:6.7.1.4 which disagrees with 13211-1:7.12.2a
|
|
% but the following agrees with 13211-1:7.12.2a
|
|
( nonvar(M) -> true ; throw(error(instantiation_error,on_signal/3)) ),
|
|
( atom(M) -> true ; throw(error(type_error(callable,Action),on_signal/3)) ),
|
|
( nonvar(Goal) -> true ; throw(error(instantiation_error,on_signal/3)) ),
|
|
recordz('$signal_handler', action(Signal,Action), _).
|
|
|
|
'$reset_signal'(Signal, OldAction) :-
|
|
recorded('$signal_handler', action(Signal,OldAction), Ref), !,
|
|
erase(Ref).
|
|
'$reset_signal'(_, default).
|
|
|
|
'$check_signal'(Signal, OldAction) :-
|
|
recorded('$signal_handler', action(Signal,OldAction), _), !.
|
|
'$check_signal'(_, default).
|
|
|
|
|
|
alarm(Interval, Goal, Left) :-
|
|
Interval == 0, !,
|
|
'$alarm'(0, 0, Left0, _),
|
|
on_signal(sig_alarm, _, Goal),
|
|
Left = Left0.
|
|
alarm(Interval, Goal, Left) :-
|
|
integer(Interval), !,
|
|
on_signal(sig_alarm, _, Goal),
|
|
'$alarm'(Interval, 0, Left, _).
|
|
alarm(Number, Goal, Left) :-
|
|
float(Number), !,
|
|
Secs is integer(Number),
|
|
USecs is integer((Number-Secs)*1000000) mod 1000000,
|
|
on_signal(sig_alarm, _, Goal),
|
|
'$alarm'(Interval, 0, Left, _).
|
|
alarm(Interval.USecs, Goal, Left.LUSecs) :-
|
|
on_signal(sig_alarm, _, Goal),
|
|
'$alarm'(Interval, USecs, Left, LUSecs).
|
|
|
|
raise_exception(Ball) :- throw(Ball).
|
|
|
|
on_exception(Pat, G, H) :- catch(G, Pat, H).
|
|
|
|
read_sig :-
|
|
recorded('$signal_handler',X,_),
|
|
writeq(X),nl,
|
|
fail.
|
|
read_sig.
|
|
|
|
%
|
|
% make thes predicates non-traceable.
|
|
|
|
:- '$set_no_trace'(true, prolog).
|
|
:- '$set_no_trace'('$call'(_,_,_,_), prolog).
|
|
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog).
|
|
:- '$set_no_trace'('$restore_regs'(_,_), prolog).
|
|
|