call_cleanup/2 and 3
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1750 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
10a791842b
commit
7d1b20c9cd
32
C/absmi.c
32
C/absmi.c
@ -10,8 +10,12 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2006-12-29 01:57:50 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-12-30 03:25:44 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.216 2006/12/29 01:57:50 vsc
|
||||
* allow coroutining plus tabling, this means fixing some trouble with the
|
||||
* gc and a bug in global variable handling.
|
||||
*
|
||||
* Revision 1.215 2006/12/27 01:32:37 vsc
|
||||
* diverse fixes
|
||||
*
|
||||
@ -1914,16 +1918,20 @@ Yap_absmi(int inp)
|
||||
#endif /* LIMIT_TABLING */
|
||||
#ifdef FROZEN_STACKS /* TRAIL */
|
||||
/* avoid frozen segments */
|
||||
if (
|
||||
#ifdef SBA
|
||||
if ((ADDR) pt1 >= HeapTop)
|
||||
(ADDR) pt1 >= HeapTop
|
||||
#else
|
||||
if ((ADDR) pt1 >= Yap_TrailBase)
|
||||
IN_BETWEEN(Yap_TrailBase, pt1, Yap_TrailTop)
|
||||
#endif /* SBA */
|
||||
)
|
||||
{
|
||||
pt0 = (tr_fr_ptr) pt1;
|
||||
goto failloop;
|
||||
}
|
||||
} else
|
||||
#endif /* FROZEN_STACKS */
|
||||
if (IN_BETWEEN(Yap_GlobalBase, pt1, H0))
|
||||
goto failloop;
|
||||
flags = *pt1;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (FlagOn(DBClMask, flags)) {
|
||||
@ -2114,6 +2122,13 @@ Yap_absmi(int inp)
|
||||
/* skip, this is a problem because we lose information,
|
||||
namely active references */
|
||||
pt1 = (tr_fr_ptr)pt;
|
||||
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
|
||||
CELL val = Deref(*pt);
|
||||
if (IsVarTerm(val)) {
|
||||
Bind(pt, MkAtomTerm(AtomCut));
|
||||
Yap_WakeUp(pt);
|
||||
}
|
||||
pt1--;
|
||||
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
|
||||
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
|
||||
int erase;
|
||||
@ -2207,7 +2222,14 @@ Yap_absmi(int inp)
|
||||
}
|
||||
} else if (IsPairTerm(d1)) {
|
||||
CELL *pt = RepPair(d1);
|
||||
if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
|
||||
|
||||
if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
|
||||
CELL val = Deref(*pt);
|
||||
if (IsVarTerm(val)) {
|
||||
Bind(VarOfTerm(val), MkAtomTerm(AtomCut));
|
||||
Yap_WakeUp(pt);
|
||||
}
|
||||
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
|
||||
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
|
||||
int erase;
|
||||
|
||||
|
||||
11
C/exec.c
11
C/exec.c
@ -156,6 +156,16 @@ p_save_env_b(void)
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_trail_suspension_marker(void)
|
||||
{
|
||||
Term t = Deref(ARG1);
|
||||
|
||||
TrailTerm(TR) = AbsPair((CELL*)t);
|
||||
TR++;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
inline static Int
|
||||
do_execute(Term t, Term mod)
|
||||
{
|
||||
@ -1901,6 +1911,7 @@ Yap_InitExecFs(void)
|
||||
CurrentModule = HACKS_MODULE;
|
||||
Yap_InitCPred("current_choice_point", 1, p_save_cp, HiddenPredFlag);
|
||||
Yap_InitCPred("env_choice_point", 1, p_save_env_b, HiddenPredFlag);
|
||||
Yap_InitCPred("trail_suspension_marker", 1, p_trail_suspension_marker, HiddenPredFlag);
|
||||
CurrentModule = cm;
|
||||
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag|HiddenPredFlag);
|
||||
|
||||
11
C/heapgc.c
11
C/heapgc.c
@ -1638,6 +1638,11 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
}
|
||||
} else if (IsPairTerm(trail_cell)) {
|
||||
/* can safely ignore this */
|
||||
CELL *cptr = RepPair(trail_cell);
|
||||
if (cptr > (CELL*)Yap_GlobalBase && cptr < H0) {
|
||||
trail_base++;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
#if MULTI_ASSIGNMENT_VARIABLES
|
||||
else {
|
||||
@ -2304,6 +2309,12 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
CELL flags;
|
||||
|
||||
|
||||
if (pt0 > (CELL*)Yap_GlobalBase && pt0 < H0) {
|
||||
TrailTerm(dest) = trail_cell;
|
||||
dest++;
|
||||
trail_ptr++;
|
||||
continue;
|
||||
}
|
||||
#ifdef FROZEN_STACKS /* TRAIL */
|
||||
/* process all segments */
|
||||
if (
|
||||
|
||||
@ -16,6 +16,8 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> NEW: call_cleanup/2 and call_cleanup/3 at the request of Paulo
|
||||
Moura and Christian1.</li>
|
||||
<li> FIXED: garbage collector would not understand bindings to mavars in
|
||||
tabling version.</li>
|
||||
<li> FIXED: cut might not prune correctly around meta-call (obs by
|
||||
|
||||
@ -77,10 +77,6 @@ true :- true.
|
||||
'$startup_reconsult',
|
||||
'$startup_goals'.
|
||||
|
||||
% encapsulate $cut_by because of co-routining.
|
||||
%
|
||||
'$cut_by'(X) :- '$$cut_by'(X).
|
||||
|
||||
% Start file for yap
|
||||
|
||||
/* I/O predicates */
|
||||
@ -675,6 +671,7 @@ incore(G) :- '$execute'(G).
|
||||
\+(G) :- \+ '$execute'(G).
|
||||
not(G) :- \+ '$execute'(G).
|
||||
|
||||
'$cut_by'(CP) :- '$$cut_by'(CP).
|
||||
|
||||
%
|
||||
% do it in ISO mode.
|
||||
@ -738,7 +735,7 @@ not(G) :- \+ '$execute'(G).
|
||||
'$call'(not(X), _CP, _G0, _M) :- !,
|
||||
\+ '$execute'(M:X).
|
||||
'$call'(!, CP, _,_) :- !,
|
||||
'$cut_by'(CP).
|
||||
'$$cut_by'(CP).
|
||||
'$call'([A|B], _, _, M) :- !,
|
||||
'$csult'([A|B], M).
|
||||
'$call'(G, CP, G0, CurMod) :-
|
||||
|
||||
@ -77,6 +77,8 @@
|
||||
% not act as if a meta-call.
|
||||
%
|
||||
%
|
||||
'$do_continuation'('$cut_by'(X), _) :- !,
|
||||
'$$cut_by'(X).
|
||||
'$do_continuation'('$restore_regs'(X), _) :- !,
|
||||
'$restore_regs'(X).
|
||||
'$do_continuation'('$restore_regs'(X,Y), _) :- !,
|
||||
|
||||
@ -390,7 +390,7 @@ debugging :-
|
||||
(
|
||||
Det == true
|
||||
->
|
||||
'$cut_by'(CP)
|
||||
'$$cut_by'(CP)
|
||||
;
|
||||
true
|
||||
),
|
||||
|
||||
@ -89,7 +89,7 @@
|
||||
'$execute_nonstop'(G,Mod).
|
||||
% notice that the last signal to be processed must always be creep
|
||||
'$start_creep'([_|'$cut_by'(CP)]) :- !,
|
||||
'$cut_by'(CP),
|
||||
'$$cut_by'(CP),
|
||||
'$creep'.
|
||||
'$start_creep'([_|true]) :- !,
|
||||
'$creep'.
|
||||
|
||||
18
pl/utils.yap
18
pl/utils.yap
@ -166,28 +166,32 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !,
|
||||
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :-
|
||||
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
|
||||
|
||||
/*
|
||||
call_cleanup(Goal, Catcher, Cleanup) :-
|
||||
|
||||
call_cleanup(Goal, Cleanup) :-
|
||||
call_cleanup(Goal, Catcher, Cleanup).
|
||||
|
||||
call_cleanup(Goal, Catcher, Cleanup) :-
|
||||
catch('$call_cleanup'(Goal,Catcher,Cleanup),
|
||||
Exception,
|
||||
'$cleanup_exception'(Exception,Catcher,Cleanup)).
|
||||
|
||||
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :-
|
||||
call(cleanup).
|
||||
call(Cleanup).
|
||||
|
||||
'$call_cleanup'(Goal,Catcher,Cleanup) :-
|
||||
'$freeze_goal'(Catcher, once(Cleanup)),
|
||||
yap_hacks:trail_suspension_marker(Catcher),
|
||||
yap_hacks:current_choice_point(CP0),
|
||||
call(Goal),
|
||||
yap_hacks:current_choice_point(CPF),
|
||||
( CP0 =:= CPF ->
|
||||
Catcher = exit,
|
||||
call(Cleanup)
|
||||
Catcher = exit, !
|
||||
;
|
||||
true
|
||||
).
|
||||
'$call_cleanup'(Goal,fail,Cleanup) :-
|
||||
call(Cleanup).
|
||||
*/
|
||||
call(Cleanup), !,
|
||||
fail.
|
||||
|
||||
op(P,T,V) :- var(P), !,
|
||||
'$do_error'(instantiation_error,op(P,T,V)).
|
||||
|
||||
Reference in New Issue
Block a user