diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

first try of setup_call_cleanup/3 and setup_call_catcher_cleanup/4

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-05-19 23:53:14 -07:00
parent 13b9098200
commit c7066b43ec
6 changed files with 144 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/stdpreds.c
View File

@ -473,7 +473,8 @@ inline static void
do_signal(yap_signals sig)
{
LOCK(SignalLock);
CreepFlag = Unsigned(LCL0);
if (Yap_InterruptsEnabled)
CreepFlag = Unsigned(LCL0);
ActiveSignals |= sig;
UNLOCK(SignalLock);
}

39
C/sysbits.c
View File

@ -1107,6 +1107,7 @@ HandleMatherr(int sig, siginfo_t *sip, ucontext_t *uap)
}
#if HAVE_SIGSEGV && !defined(THREADS)
static void
my_signal_info(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
{
@ -1118,6 +1119,7 @@ my_signal_info(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
sigaction(sig,&sigact,NULL);
}
#endif
static void
my_signal(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
@ -1221,6 +1223,7 @@ SearchForTrailFault(siginfo_t *siginfo)
}
}
#if HAVE_SIGSEGV && !defined(THREADS)
static RETSIGTYPE
HandleSIGSEGV(int sig, siginfo_t *siginfo, void *context)
{
@ -1229,6 +1232,7 @@ HandleSIGSEGV(int sig, siginfo_t *siginfo, void *context)
}
SearchForTrailFault(siginfo);
}
#endif
static void
my_signal_info(int sig, void (*handler)(int,siginfo_t *,void *))
@ -1509,13 +1513,20 @@ HandleSIGINT (int sig, siginfo_t *x, ucontext_t *y)
HandleSIGINT (int sig)
#endif
{
LOCK(SignalLock);
my_signal(SIGINT, HandleSIGINT);
/* do this before we act */
#if HAVE_ISATTY
if (!isatty(0) && !Yap_sockets_io) {
UNLOCK(SignalLock);
Yap_Error(INTERRUPT_ERROR,MkIntTerm(SIGINT),NULL);
return;
}
#endif
if (!Yap_InterruptsEnabled) {
UNLOCK(SignalLock);
return;
}
if (Yap_PrologMode & (CritMode|ConsoleGetcMode)) {
Yap_PrologMode |= InterruptMode;
#if HAVE_LIBREADLINE
@ -1527,6 +1538,7 @@ HandleSIGINT (int sig)
#endif
}
#endif
UNLOCK(SignalLock);
return;
}
#ifdef HAVE_SETBUF
@ -1535,9 +1547,11 @@ HandleSIGINT (int sig)
#endif
if (snoozing) {
snoozing = FALSE;
UNLOCK(SignalLock);
return;
}
ProcessSIGINT();
UNLOCK(SignalLock);
}
#if !defined(_WIN32)
@ -1619,6 +1633,8 @@ ReceiveSignal (int s)
#if (_MSC_VER || defined(__MINGW32__))
static BOOL WINAPI
MSCHandleSignal(DWORD dwCtrlType) {
if (!Yap_InterruptsEnabled) {
return FALSE;
switch(dwCtrlType) {
case CTRL_C_EVENT:
case CTRL_BREAK_EVENT:
@ -2824,6 +2840,27 @@ p_win32(void)
#endif
}
static Int
p_enable_interrupts(void)
{
LOCK(SignalLock);
Yap_InterruptsEnabled = TRUE;
UNLOCK(SignalLock);
return TRUE;
}
static Int
p_disable_interrupts(void)
{
LOCK(SignalLock);
if (ActiveSignals)
CreepFlag = Unsigned(LCL0);
Yap_InterruptsEnabled = FALSE;
UNLOCK(SignalLock);
return TRUE;
}
static Int
p_ld_path(void)
{
@ -3047,6 +3084,8 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
Yap_InitCPred ("$enable_interrupts", 0, p_enable_interrupts, SafePredFlag);
Yap_InitCPred ("$disable_interrupts", 0, p_disable_interrupts, SafePredFlag);
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);

2
H/Heap.h
View File

@ -123,6 +123,7 @@ typedef struct worker_local_struct {
union CONSULT_OBJ *consultlow;
struct pred_entry *last_asserted_pred;
int debug_on;
int interrupts_enabled;
UInt consultcapacity;
UInt active_signals;
UInt i_pred_arity;
@ -687,6 +688,7 @@ extern struct various_codes *Yap_heap_regs;
#define XDiff RINFO.x_diff
#define DelayDiff RINFO.delay_diff
#define BaseDiff RINFO.base_diff
#define Yap_InterruptsEnabled Yap_heap_regs->WL.interrupts_enabled
/* current consult stack */
#define ConsultSp Yap_heap_regs->WL.consultsp
/* top of consult stack */

71
docs/yap.tex
View File

@ -11078,7 +11078,7 @@ it will be called through call_cleanup/1.
:- fragile foo/1,bar:baz/2.
@end example
@item call_cleanup(+@var{Goal})
@item call_cleanup(:@var{Goal})
@findex call_cleanup/1
@syindex call_cleanup/1
@cnindex call_cleanup/1
@ -11087,13 +11087,80 @@ might register cleanup Goals which are called right after the end of
the call to @var{Goal}. Cuts and exceptions inside Goal do not prevent the
execution of the cleanup calls. @t{call_cleanup} might be nested.
@item call_cleanup(+@var{Goal}, +@var{CleanUpGoal})
@item call_cleanup(:@var{Goal}, :@var{CleanUpGoal})
@findex call_cleanup/2
@syindex call_cleanup/2
@cnindex call_cleanup/2
This is similar to @t{call_cleanup/1} with an additional
@var{CleanUpGoal} which gets called after @var{Goal} is finished.
@item setup_call_cleanup(:@var{Setup},:@var{Goal}, :@var{CleanUpGoal})
@findex setup_call_cleanup/3
@snindex setup_call_cleanup/3
@cnindex setup_call_cleanup/3
Calls @code{(Setup, Goal)}. For each sucessful execution of @var{Setup}, calling @var{Goal}, the
cleanup handler @var{Cleanup} is guaranteed to be called exactly once.
This will happen after @var{Goal} completes, either through failure,
deterministic success, commit, or an exception. @var{Setup} will
contain the goals that need to be protected from asynchronous interrupts
such as the ones received from @code{call_with_time_limit/2} or @code{thread_signal/2}. In
most uses, @var{Setup} will perform temporary side-effects required by
@var{Goal} that are finally undone by \arg{Cleanup}.
Success or failure of @var{Cleanup} is ignored and choice-points it
created are destroyed (as @code{once/1}). If @var{Cleanup} throws an exception,
this is executed as normal.
Typically, this predicate is used to cleanup permanent data storage
required to execute @var{Goal}, close file-descriptors, etc. The example
below provides a non-deterministic search for a term in a file, closing
the stream as needed.
@example
term_in_file(Term, File) :-
setup_call_cleanup(open(File, read, In),
term_in_stream(Term, In),
close(In) ).
term_in_stream(Term, In) :-
repeat,
read(In, T),
( T == end_of_file
-> !, fail
; T = Term
).
@end example
Note that it is impossible to implement this predicate in Prolog other than
by reading all terms into a list, close the file and call @code{member/2}.
Without @code{setup_call_cleanup/3} there is no way to gain control if the
choice-point left by code{repeat} is removed by a cut or an exception.
@code{setup_call_cleanup/2} can also be used to test determinism of a goal:
@example
?- setup_call_cleanup(true,(X=1;X=2), Det=yes).
X = 1 ;
X = 2,
Det = yes ;
@end example
This predicate is under consideration for inclusion into the ISO standard.
For compatibility with other Prolog implementations see @code{call_cleanup/2}.
@item setup_call_cleanup(:@var{Setup},:@var{Goal}, +@var{Catcher},:@var{CleanUpGoal})
@findex setup_call_cleanup/3
@snindex setup_call_cleanup/3
@cnindex setup_call_cleanup/3
Similar to @code{setup_call_cleanup}{@var{Setup},@var{ Goal}, @var{Cleanup}} with
additional information on the reason of calling @var{Cleanup}. Prior
to calling @var{Cleanup}, @var{Catcher} unifies with the termination
code. If this unification fails, @var{Cleanup} is
@strong{not} called.
@item on_cleanup(+@var{CleanUpGoal})
@findex on_cleanup/1
@syindex on_cleanup/1

2
pl/modules.yap
View File

@ -511,6 +511,8 @@ source_module(Mod) :-
format(+,+,:),
call_cleanup(:,:),
call_cleanup(:,?,:),
setup_call_cleanup(:,:,:),
setup_call_catcher_cleanup(:,:,?,:),
call_residue(:,?),
call_residue_vars(:,?),
catch(:,+,:),

34
pl/utils.yap
View File

@ -56,13 +56,37 @@ call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A
call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11).
call_cleanup(Goal, Cleanup) :-
call_cleanup(Goal, _Catcher, Cleanup).
setup_call_cleanup(true, Goal, _Catcher, Cleanup).
call_cleanup(Goal, Catcher, Cleanup) :-
catch('$call_cleanup'(Goal,Cleanup,Catcher),
setup_call_cleanup(Setup, Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup).
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$disable_interrupts',
'$do_setup'(Setup),
catch('$safe_call_cleanup'(Goal,Cleanup,Catcher),
Exception,
'$cleanup_exception'(Exception,Catcher,Cleanup)).
% this is simple, do nothing
'$do_setup'(A:true) :- atom(A), !.
% this is tricky: please don't forget that interrupts are disabled at this point
% and that they will only be enabled after setting up Cleanup
'$do_setup'(Setup) :-
(
yap_hacks:current_choice_point(CP0),
'$execute'(Setup),
yap_hacks:current_choice_point(CP1),
% are we looking at a deterministic goal?
% we don't need to care about enabling interrupts
(CP1 == CP0 -> ! ; true)
;
% reenable interrupts if Setup failed
'$enable_interrupts',
fail
).
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :- !,
% whatever happens, let exception go through
catch('$clean_call'(Cleanup),_,true),
@ -70,11 +94,13 @@ call_cleanup(Goal, Catcher, Cleanup) :-
'$cleanup_exception'(Exception, _, _) :-
throw(Exception).
'$call_cleanup'(Goal, Cleanup, Catcher) :-
'$safe_call_cleanup'(Goal, Cleanup, Catcher) :-
yap_hacks:current_choice_point(MyCP1),
'$freeze_goal'(Catcher, '$clean_call'(Cleanup)),
yap_hacks:trail_suspension_marker(Catcher),
(
yap_hacks:current_choice_point(CP0),
'$enable_interrupts',
'$execute'(Goal),
yap_hacks:current_choice_point(CPF),
(