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

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 2006-12-30 03:25:47 +00:00
parent 10a791842b
commit 7d1b20c9cd
9 changed files with 68 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
C/absmi.c
View File

@ -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
View File

@ -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
View File

@ -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 (

2
changes-5.1.html
View File

@ -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

7
pl/boot.yap
View File

@ -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) :-

2
pl/corout.yap
View File

@ -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), _) :- !,

2
pl/debug.yap
View File

@ -390,7 +390,7 @@ debugging :-
(
Det == true
->
'$cut_by'(CP)
'$$cut_by'(CP)
;
true
),

2
pl/signals.yap
View File

@ -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
View File

@ -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)).