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

change throw mechanism to fit better with cleanup mechanism:

Browse Source 
- balls are now stored off line and recovered by Prolog code when everything
is safe.
- if a ball exists, throw uses the *existing* one (be careful not to have one
laying around).
- Jump routine cleans up every cp except ones for setup_call handling, backtracking simply calls setup handlers.
This commit is contained in:
Vítor Manuel de Morais Santos Costa 2009-11-27 11:21:24 +00:00
parent 7f5da32c08
commit 98f79484ae
19 changed files with 142 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/c_interface.c
View File

@ -1940,6 +1940,7 @@ YAP_GoalHasException(Term *t)
X_API void
YAP_ClearExceptions(void)
{
Yap_DeleteGlobal(AtomCatch);
EX = 0L;
UncaughtThrow = FALSE;
}

250
C/exec.c
View File

@ -1428,227 +1428,116 @@ p_cut_up_to_next_disjunction(void) {
return TRUE;
}
static int
suspended_on_current_execution(Term t, Term t0)
static int is_cleanup_cp(choiceptr cp_b)
{
attvar_record *susp = (attvar_record *)VarOfTerm(t);
Term t1 = susp->Atts;
/* should be prolog(_,Something) */
if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorPrologConstraint)
PredEntry *pe;
if (cp_b->cp_ap->opc != ORLAST_OPCODE)
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) || FunctorOfTerm(t1) != FunctorRedoFreeze)
return FALSE;
t1 = ArgOfTerm(3,t1);
/* Suspended = Mod:Cod */
if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorModule)
return FALSE;
t1 = ArgOfTerm(2,t1);
/* Cod = $clean_call(t0,_) */
if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorCleanCall)
return FALSE;
/* we found what was on the cp */
return t0 == ArgOfTerm(1, t1);
}
static Term
build_error(void)
{
Term ti[1], nt[2];
ti[0] = MkAtomTerm(AtomStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
nt[1] = MkAtomTerm(AtomInStackExpansion);
return Yap_MkApplTerm(FunctorError, 2, nt);
}
static Term
get_term(DBTerm *dbt, Term t)
{
if (dbt) {
while (!(t = Yap_PopTermFromDB(dbt))) {
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
t = build_error();
break;
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growstack(dbt->NOfCells*CellSize)) {
t = build_error();
break;
}
}
}
if (t) {
B->cp_h = H;
}
}
return t;
}
static Term
clean_trail(Term t, DBTerm *dbt, Term t0)
{
tr_fr_ptr pt1, pbase;
#ifdef SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
pbase = B->cp_tr;
pt1 = TR - 1;
while (pt1 >= pbase) {
Term d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
#if defined(SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */
if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1));
} else
#endif
/* normal variable */
RESET_VARIABLE(d1);
RESET_VARIABLE(&TrailTerm(pt1));
pt1--;
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
if ((ADDR) pt >= Yap_TrailBase && (ADDR)pt < Yap_TrailTop) {
/* 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)) {
if (suspended_on_current_execution(val, t0)) {
RESET_VARIABLE(&TrailTerm(pt1));
} else {
TR = pt1+1;
t = get_term(dbt, t);
Bind(pt, t);
Yap_WakeUp(pt);
return t;
}
}
}
pt1--;
} else if (IsApplTerm(d1)) {
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailTerm(pt1));
--pt1;
pt[0] = TrailVal(pt1);
RESET_VARIABLE(&TrailTerm(pt1));
--pt1;
#ifdef YAPOR
pe = cp_b->cp_ap->u.Osblp.p;
#else
pt[0] = TrailTerm(pt1-1);
RESET_VARIABLE(&TrailTerm(pt1));
RESET_VARIABLE(&TrailTerm(pt1-1));
RESET_VARIABLE(&TrailTerm(pt1-2));
pt1 -= 3;
#endif /* FROZEN_STACKS */
}
}
TR = pt1+1;
t = get_term(dbt, t);
return t;
pe = cp_b->cp_ap->u.p.p;
#endif /* YAPOR */
return (pe == PredSafeCallCleanup);
}
static Int
JumpToEnv(Term t) {
yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l),
*catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,l);
CELL *env;
choiceptr first_func = NULL, B0 = B;
DBTerm *dbt;
CELL *env, *env1;
choiceptr handler, previous = NULL;
if (!(dbt = Yap_StoreTermInDB(t, -1))) {
if (!(t = Yap_SaveTerm(t)))
return FALSE;
/* throws cannot interrupt throws */
if (EX)
return FALSE;
/* just keep the throwed object away, we don't need to care about it */
if (!(t = Yap_SetGlobalVal(AtomCatch, t))) {
/* fat chance */
siglongjmp(Yap_RestartEnv,1);
}
/* careful, previous step may have caused a stack shift,
so get pointers here */
handler = B;
env1 = ENV;
do {
/* find the first choicepoint that may be a catch */
while (B != NULL && B->cp_ap != pos) {
while (handler != NULL && handler->cp_ap != pos) {
/* we are already doing a catch */
if (B->cp_ap == catchpos) {
if (handler->cp_ap == catchpos) {
P = (yamop *)FAILCODE;
if (first_func != NULL) {
B = first_func;
}
return(FALSE);
return TRUE;
}
if (B->cp_ap == NOCODE) {
/* we have a cleanup handler in the middle */
if (is_cleanup_cp(handler)) {
/* keep it around */
if (previous == NULL)
B = handler;
else
previous->cp_b = handler;
previous = handler;
#ifdef TABLING
} else {
abolish_incomplete_subgoals(handler);
#endif /* TABLING */
}
/* we reached C-Code */
if (handler->cp_ap == NOCODE) {
/* up to the C-code to deal with this! */
UncaughtThrow = TRUE;
B->cp_h = H;
if (previous == NULL)
B = handler;
else
previous->cp_b = handler;
EX = t;
return FALSE;
P = (yamop *)FAILCODE;
HB = B->cp_h;
return TRUE;
}
B = B->cp_b;
handler = handler->cp_b;
}
/* uncaught throw */
if (B == NULL) {
if (handler == NULL) {
UncaughtThrow = TRUE;
B = B0;
#if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs);
#endif
siglongjmp(Yap_RestartEnv,1);
}
/* is it a continuation? */
env = B->cp_env;
while (env > ENV) {
ENV = ENV_Parent(ENV);
env = handler->cp_env;
while (env > env1) {
env1 = ENV_Parent(env1);
}
/* yes, we found it ! */
// while (env < ENV)
// env = ENV_Parent(env);
if (env == ENV) {
if (env == env1) {
break;
}
/* oops, try next */
B = B->cp_b;
handler = handler->cp_b;
} while (TRUE);
/* step one environment above, otherwise we'll redo the original goal */
B->cp_cp = (yamop *)env[E_CP];
B->cp_env = (CELL *)env[E_E];
B->cp_ap = NEXTOP(PredHandleThrow->CodeOfPred,l);
if (previous == NULL) {
B = handler;
} else {
// EX = t;
previous->cp_b = handler;
}
handler->cp_cp = (yamop *)env[E_CP];
handler->cp_env = (CELL *)env[E_E];
handler->cp_ap = NEXTOP(PredHandleThrow->CodeOfPred,l);
/* can recover Heap thanks to copy term :-( */
/* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding
to the emulator */
P = (yamop *)FAILCODE;
HB = B->cp_h;
/* try to recover space */
/* can only do that when we recover space */
/* H = B->cp_h; */
t = clean_trail(t, dbt, B->cp_a1);
B->cp_a3 = t;
B->cp_tr = TR;
if (first_func != NULL) {
B = first_func;
}
#ifdef TABLING
if (B != B0) {
while (B0->cp_b < B) {
B0 = B0->cp_b;
}
abolish_incomplete_subgoals(B0);
}
#endif /* TABLING */
/* first, simulate backtracking */
/* so that I will execute op_fail */
return TRUE;
}
@ -1694,6 +1583,7 @@ Yap_InitYaamRegs(void)
Yap_regp = &Yap_standard_regs;
#endif
#endif /* PUSH_REGS */
Yap_DeleteGlobal (AtomCatch);
Yap_PutValue (AtomBreak, MkIntTerm (0));
TR = (tr_fr_ptr)Yap_TrailBase;
if (Yap_AttsSize > (Yap_LocalBase-Yap_GlobalBase)/8)
@ -1795,6 +1685,13 @@ p_debug_on(void)
return TRUE;
}
static Int
p_reset_exception(void)
{
EX = 0L;
return TRUE;
}
void
Yap_InitExecFs(void)
{
@ -1848,6 +1745,7 @@ Yap_InitExecFs(void)
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, HiddenPredFlag);
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, HiddenPredFlag);
Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, HiddenPredFlag);
Yap_InitCPred("$reset_exception", 0, p_reset_exception, HiddenPredFlag);
}

36
C/globals.c
View File

@ -1300,22 +1300,15 @@ p_nb_getval(void)
return Yap_unify(ARG2, to);
}
static Int
p_nb_delete(void)
static Int
nbdelete(Atom at)
{
Term t = Deref(ARG1);
GlobalEntry *ge, *g;
AtomEntry *ae;
Prop gp, g0;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"nb_delete");
return FALSE;
} else if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"nb_delete");
return FALSE;
}
ge = FindGlobalEntry(AtomOfTerm(t));
ge = FindGlobalEntry(at);
if (!ge)
return FALSE;
WRITE_LOCK(ge->GRWLock);
@ -1344,6 +1337,27 @@ p_nb_delete(void)
return TRUE;
}
Int
Yap_DeleteGlobal(Atom at)
{
return nbdelete(at);
}
static Int
p_nb_delete(void)
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"nb_delete");
return FALSE;
} else if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"nb_delete");
return FALSE;
}
return nbdelete(AtomOfTerm(t));
}
static Int
p_nb_create(void)
{

2
C/tracer.c
View File

@ -269,7 +269,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
printf("\n");
}
#endif
fprintf(Yap_stderr,"%lld ",vsc_count);
fprintf(Yap_stderr,"%lld %p ", vsc_count, TR);
#if defined(THREADS) || defined(YAPOR)
fprintf(Yap_stderr,"(%d)", worker_id);
#endif

1
H/Yapproto.h
View File

@ -192,6 +192,7 @@ Term STD_PROTO(Yap_NewArena,(UInt,CELL *));
void STD_PROTO(Yap_InitGlobals,(void));
Term STD_PROTO(Yap_SaveTerm, (Term));
Term STD_PROTO(Yap_SetGlobalVal, (Atom, Term));
Int STD_PROTO(Yap_DeleteGlobal, (Atom));
void STD_PROTO(Yap_AllocateDefaultArena, (Int, Int));
/* grow.c */

2
H/dhstruct.h
View File

@ -85,6 +85,7 @@
#define FAIL_OPCODE Yap_heap_regs->fail_op
#define INDEX_OPCODE Yap_heap_regs->index_op
#define LOCKPRED_OPCODE Yap_heap_regs->lockpred_op
#define ORLAST_OPCODE Yap_heap_regs->orlast_op
#define UNDEF_OPCODE Yap_heap_regs->undef_op
#define NOfAtoms Yap_heap_regs->n_of_atoms
@ -148,6 +149,7 @@
#define PredThrow Yap_heap_regs->pred_throw
#define PredHandleThrow Yap_heap_regs->pred_handle_throw
#define PredIs Yap_heap_regs->pred_is
#define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
#ifdef YAPOR
#define PredGetwork Yap_heap_regs->pred_getwork
#define PredGetworkSeq Yap_heap_regs->pred_getwork_seq

2
H/hstruct.h
View File

@ -85,6 +85,7 @@
OPCODE fail_op;
OPCODE index_op;
OPCODE lockpred_op;
OPCODE orlast_op;
OPCODE undef_op;
UInt n_of_atoms;
@ -148,6 +149,7 @@
struct pred_entry *pred_throw;
struct pred_entry *pred_handle_throw;
struct pred_entry *pred_is;
struct pred_entry *pred_safe_call_cleanup;
#ifdef YAPOR
struct pred_entry *pred_getwork;
struct pred_entry *pred_getwork_seq;

2
H/iatoms.h
View File

@ -223,6 +223,7 @@
AtomRetryCounter = Yap_LookupAtom("retry_counter");
AtomRTree = Yap_LookupAtom("rtree");
AtomSafe = Yap_FullLookupAtom("$safe");
AtomSafeCallCleanup = Yap_FullLookupAtom("$safe_call_cleanup");
AtomSame = Yap_LookupAtom("==");
AtomSemic = Yap_LookupAtom(";");
AtomShiftCountOverflow = Yap_LookupAtom("shift_count_overflow");
@ -384,6 +385,7 @@
FunctorRestoreRegs = Yap_MkFunctor(AtomRestoreRegs,2);
FunctorRestoreRegs1 = Yap_MkFunctor(AtomRestoreRegs,1);
FunctorSafe = Yap_MkFunctor(AtomSafe,1);
FunctorSafeCallCleanup = Yap_MkFunctor(AtomSafeCallCleanup,4);
FunctorSame = Yap_MkFunctor(AtomSame,2);
FunctorSlash = Yap_MkFunctor(AtomSlash,2);
FunctorStaticClause = Yap_MkFunctor(AtomStaticClause,1);

2
H/ihstruct.h
View File

@ -85,6 +85,7 @@
Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->orlast_op = Yap_opcode(_or_last);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
@ -148,6 +149,7 @@
Yap_heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,PROLOG_MODULE));
Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE));
Yap_heap_regs->pred_is = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
Yap_heap_regs->pred_safe_call_cleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
#ifdef YAPOR
Yap_heap_regs->pred_getwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE));
Yap_heap_regs->pred_getwork_seq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE));

2
H/ratoms.h
View File

@ -225,6 +225,7 @@
AtomRetryCounter = AtomAdjust(AtomRetryCounter);
AtomRTree = AtomAdjust(AtomRTree);
AtomSafe = AtomAdjust(AtomSafe);
AtomSafeCallCleanup = AtomAdjust(AtomSafeCallCleanup);
AtomSame = AtomAdjust(AtomSame);
AtomSemic = AtomAdjust(AtomSemic);
AtomShiftCountOverflow = AtomAdjust(AtomShiftCountOverflow);
@ -386,6 +387,7 @@
FunctorRestoreRegs = FuncAdjust(FunctorRestoreRegs);
FunctorRestoreRegs1 = FuncAdjust(FunctorRestoreRegs1);
FunctorSafe = FuncAdjust(FunctorSafe);
FunctorSafeCallCleanup = FuncAdjust(FunctorSafeCallCleanup);
FunctorSame = FuncAdjust(FunctorSame);
FunctorSlash = FuncAdjust(FunctorSlash);
FunctorStaticClause = FuncAdjust(FunctorStaticClause);

2
H/rhstruct.h
View File

@ -85,6 +85,7 @@
Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->orlast_op = Yap_opcode(_or_last);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
@ -148,6 +149,7 @@
Yap_heap_regs->pred_throw = PtoPredAdjust(Yap_heap_regs->pred_throw);
Yap_heap_regs->pred_handle_throw = PtoPredAdjust(Yap_heap_regs->pred_handle_throw);
Yap_heap_regs->pred_is = PtoPredAdjust(Yap_heap_regs->pred_is);
Yap_heap_regs->pred_safe_call_cleanup = PtoPredAdjust(Yap_heap_regs->pred_safe_call_cleanup);
#ifdef YAPOR
Yap_heap_regs->pred_getwork = PtoPredAdjust(Yap_heap_regs->pred_getwork);
Yap_heap_regs->pred_getwork_seq = PtoPredAdjust(Yap_heap_regs->pred_getwork_seq);

4
H/tatoms.h
View File

@ -452,6 +452,8 @@
#define AtomRTree Yap_heap_regs->AtomRTree_
Atom AtomSafe_;
#define AtomSafe Yap_heap_regs->AtomSafe_
Atom AtomSafeCallCleanup_;
#define AtomSafeCallCleanup Yap_heap_regs->AtomSafeCallCleanup_
Atom AtomSame_;
#define AtomSame Yap_heap_regs->AtomSame_
Atom AtomSemic_;
@ -774,6 +776,8 @@
#define FunctorRestoreRegs1 Yap_heap_regs->FunctorRestoreRegs1_
Functor FunctorSafe_;
#define FunctorSafe Yap_heap_regs->FunctorSafe_
Functor FunctorSafeCallCleanup_;
#define FunctorSafeCallCleanup Yap_heap_regs->FunctorSafeCallCleanup_
Functor FunctorSame_;
#define FunctorSame Yap_heap_regs->FunctorSame_
Functor FunctorSlash_;

2
misc/ATOMS
View File

@ -234,6 +234,7 @@ A RestoreRegs F "$restore_regs"
A RetryCounter N "retry_counter"
A RTree N "rtree"
A Safe F "$safe"
A SafeCallCleanup F "$safe_call_cleanup"
A Same N "=="
A Semic N ";"
A ShiftCountOverflow N "shift_count_overflow"
@ -395,6 +396,7 @@ F ResourceError ResourceError 1
F RestoreRegs RestoreRegs 2
F RestoreRegs1 RestoreRegs 1
F Safe Safe 1
F SafeCallCleanup SafeCallCleanup 4
F Same Same 2
F Slash Slash 2
F StaticClause StaticClause 1

2
misc/HEAPFIELDS
View File

@ -90,6 +90,7 @@ OPCODE expand_op_code EXPAND_OP_CODE MkOp _expand_index
OPCODE fail_op FAIL_OPCODE MkOp _op_fail
OPCODE index_op INDEX_OPCODE MkOp _index_pred
OPCODE lockpred_op LOCKPRED_OPCODE MkOp _lock_pred
OPCODE orlast_op ORLAST_OPCODE MkOp _or_last
OPCODE undef_op UNDEF_OPCODE MkOp _undef_p
/* atom tables */
@ -161,6 +162,7 @@ struct pred_entry *pred_static_clause PredStaticClause MkPred FunctorDoStaticCla
struct pred_entry *pred_throw PredThrow MkPred FunctorThrow PROLOG_MODULE
struct pred_entry *pred_handle_throw PredHandleThrow MkPred FunctorHandleThrow PROLOG_MODULE
struct pred_entry *pred_is PredIs MkPred FunctorIs PROLOG_MODULE
struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup MkPred FunctorSafeCallCleanup PROLOG_MODULE
#ifdef YAPOR
struct pred_entry *pred_getwork PredGetwork MkPred AtomGetwork 0 PROLOG_MODULE
struct pred_entry *pred_getwork_seq PredGetworkSeq MkPred AtomGetworkSeq 0 PROLOG_MODULE

2
packages/chr

@ -1 +1 @@
Subproject commit f6a79007615bf46dc79712c41d61289834f28ba3
Subproject commit c325e4564bb8d4e32c27f2061df85f13d315974e

2
packages/jpl

@ -1 +1 @@
Subproject commit eb6d27251c2548c25e6d37fff2a27a014caaa7aa
Subproject commit a2d2f03107eecd45462cd61a678035132cf06326

3
packages/plunit/examples/simple.pl
View File

@ -1,6 +1,7 @@
:- module(ex_simple, []).
:- use_module(library(plunit)).
:- module(ex_simple, []).
:- begin_tests(lists).
test(true) :-

11
pl/boot.yap
View File

@ -1163,6 +1163,12 @@ catch(G, C, A) :-
%
% throw has to be *exactly* after system catch!
%
throw(_Ball) :-
% use existing ball
nb_getval('$catch',Ball),
nb_delete('$catch'),
!,
'$jump_env_and_store_ball'(Ball).
throw(Ball) :-
% get current jump point
'$jump_env_and_store_ball'(Ball).
@ -1173,7 +1179,10 @@ throw(Ball) :-
'$catch'(_,_,_) :- fail.
'$handle_throw'(_, _, _).
'$handle_throw'(C, A, Ball) :-
'$handle_throw'(C, A, _Ball) :-
nb_getval('$catch',Ball),
nb_delete('$catch'),
'$reset_exception',
% reset info
('catch_ball'(Ball, C) ->
'$execute'(A)

8
pl/control.yap
View File

@ -123,9 +123,13 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, 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) :-
'$clean_call'(_, Cleanup) :-
'$execute'(Cleanup), !.
'$clean_call'(_,_).
'$clean_call'(_, _).
'$cc_check_throw' :-
nb_getval('$catch',Ball),
throw(Ball).
%%% The unknown predicate,
% informs about what the user wants to be done when