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

handle correctly throws within the scope of a call_cleanup. This is implemented

Browse Source 
by using an extra argument to verify if the catcher is the current call_cleanup.
If it is, we allow the exception to go forth.
This commit is contained in:
Costa Vitor 2009-06-02 19:46:41 -05:00
parent 2daccab1cb
commit b72345cc97
2 changed files with 55 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
C/exec.c
View File

@ -20,6 +20,7 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "absmi.h"
#include "yapio.h"
#include "attvar.h"
#ifdef CUT_C
#include "cut_c.h"
#endif
@ -1432,8 +1433,38 @@ p_cut_up_to_next_disjunction(void) {
return TRUE;
}
static int
suspended_on_current_execution(Term t, Term t0)
{
attvar_record *susp = (attvar_record *)VarOfTerm(t);
Term t1 = susp->Atts;
/* should be prolog(_,Something) */
if(IsVarTerm(t1) || !IsApplTerm(t1))
return FALSE;
t1 = ArgOfTerm(2, t1);
/* Something = [Goal] */
if (IsVarTerm(t1) || !IsPairTerm(t1))
return FALSE;
if (TailOfTerm(t1) != TermNil)
return FALSE;
t1 = HeadOfTerm(t1);
/* Goal = $redo_freeze(_,_,Suspended) */
if(IsVarTerm(t1) || !IsApplTerm(t1))
return FALSE;
t1 = ArgOfTerm(3,t1);
/* Suspended = Mod:Cod */
if(IsVarTerm(t1) || !IsApplTerm(t1))
return FALSE;
t1 = ArgOfTerm(2,t1);
/* Cod = $clean_call(t0,_) */
if(IsVarTerm(t1) || !IsApplTerm(t1))
return FALSE;
/* we found what was on the cp */
return t0 == ArgOfTerm(1, t1);
}
static void
clean_trail(Term t)
clean_trail(Term t, Term t0)
{
tr_fr_ptr pt1, pbase;
@ -1461,8 +1492,12 @@ clean_trail(Term t)
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, t);
Yap_WakeUp(pt);
if (suspended_on_current_execution(val, t0)) {
RESET_VARIABLE(&TrailTerm(pt1));
} else {
Bind(pt, t);
Yap_WakeUp(pt);
}
}
return;
}
@ -1546,7 +1581,7 @@ JumpToEnv(Term t) {
to the emulator */
B->cp_a3 = t;
P = (yamop *)FAILCODE;
clean_trail(t);
clean_trail(t, B->cp_a1);
if (first_func != NULL) {
B = first_func;
}

28
pl/utils.yap
View File

@ -67,7 +67,7 @@ setup_call_cleanup(Setup, Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
yap_hacks:disable_interrupts,
'$do_setup'(Setup),
catch('$safe_call_cleanup'(Goal,Cleanup,Catcher),
catch('$safe_call_cleanup'(Goal,Cleanup,Catcher,Exception),
Exception,
'$cleanup_exception'(Exception,Catcher,Cleanup)).
@ -92,14 +92,14 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :- !,
% whatever happens, let exception go through
catch('$clean_call'(Cleanup),_,true),
catch('$clean_call'(_,Cleanup),_,true),
throw(Exception).
'$cleanup_exception'(Exception, _, _) :-
throw(Exception).
'$safe_call_cleanup'(Goal, Cleanup, Catcher) :-
'$safe_call_cleanup'(Goal, Cleanup, Catcher, Exception) :-
yap_hacks:current_choice_point(MyCP1),
'$freeze_goal'(Catcher, '$clean_call'(Cleanup)),
'$freeze_goal'(Catcher, '$clean_call'(Exception, Cleanup)),
yap_hacks:trail_suspension_marker(Catcher),
(
yap_hacks:enable_interrupts,
@ -109,22 +109,26 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$true',
yap_hacks:current_choice_point(CPF),
(
CP0 =:= CPF ->
Catcher = exit,
!
CP0 =:= CPF
->
Catcher = exit,
!
;
true
true
)
;
Catcher = fail,
fail
Catcher = fail,
fail
).
'$holds_true'.
'$clean_call'(Cleanup) :-
% The first argument is used by JumpEnv to verify if a throw
% is going to be handled by the cleanup catcher. If it is so,
% clean_call will not be called from JumpToEnv.
'$clean_call'(_,Cleanup) :-
'$execute'(Cleanup), !.
'$clean_call'(_).
'$clean_call'(_,_).
op(P,T,V) :-
'$check_op'(P,T,V,op(P,T,V)),