As of version 3.1.0, SWI-Prolog is capable to handle software interrupts (signals) in Prolog as well as in foreign (C) code (see section 7.6.10).
Signals are used to handle internal errors (execution of a non-existing CPU intruction, arithmetic domain errors, illegal memory access, resource overflow, etc.), as well as for dealing asynchronous inter-process communication.
Signals are defined by the POSIX standard and part of all Unix machines. The MS-Windows Win32 provides a subset of the signal handling routines, lacking the vital funtionality to raise a signal in another thread for achieving asynchronous inter-process (or inter-thread) communication (Unix kill() function).
on_signal(Signal, Current, Current)
.
The action description is an atom denoting the name of the predicate that will be called if Signal arrives. on_signal/3 is a meta predicate, which implies that <Module>:<Name> refers the <Name>/1 in the module <Module>.
Two predicate-names have special meaning. throw
implies
Prolog will map the signal onto a Prolog exception as described in
section 4.9. default
resets
the handler to the settings active before SWI-Prolog manipulated the
handler.
Signals bound to a foreign function through PL_signal()
are reported using the term $foreign_function(Address)
.
After receiving a signal mapped to throw
, the exception
raised has the structure
error(signal(<SigName>, <SigNum>), <Context>)
One possible usage of this is, for example, to limit the time spent on proving a goal. This requires a little C-code for setting the alarm timer (see chapter 7):
#include <SWI-Prolog.h> #include <unistd.h> foreign_t pl_alarm(term_t time) { double t; if ( PL_get_float(time, &t) ) { alarm((long)(t+0.5)); PL_succeed; } PL_fail; } install_t install() { PL_register_foreign("alarm", 1, pl_alarm, 0); } |
Next, we can define the Prolog below. This will run Goal
just as once/1,
throwing the exception error(signal(alrm, _), _)
if a
timeout occurs. (22)
:- load_foreign_library(alarm). :- on_signal(alrm, _, throw). :- module_transparent call_with_time_limit/2. call_with_time_limit(Goal, MaxTime) :- alarm(MaxTime), call_cleanup(Goal, _, alarm(0)), !. |
The signal names are defined by the C-Posix standards as symbols of the form SIG_<SIGNAME>. The Prolog name for a signal is the lowercase version of <SIGNAME>. The predicate current_signal/3 may be used to map between names and signals.
Initially, some signals are mapped to throw
, while all
other signals are default
. The following signals throw an
exception: ill
, fpe
, segv
, pipe
,
alrm
, bus
, xcpu
, xfsz
and
vtalrm
.
Before deciding to deal with signals in your application, please consider the following:
throw
is used in combination with external
foreign code. The system will use the C longjmp() construct to direct
control to the innermost PL_next_solution(),
thus forcing an external procedure to be abandoned at an arbitrary
moment. Most likely not all SWI-Prologs own foreign code is (yet) safe
too. For the multi-threaded versions this is even worse: signals can
easily violate thread synchronisation consistency.
The C-interface described in section
7.6.10 provides the option
PL_SIGSYNC
for registering a signal handler that delays
delivery of signals to a safe point. Unfortunately this may cause
signals to be delayed for a long time if Prolog is executing foreign
code.