Adding tabling support for mixed strategy evaluation (batched and local scheduling)
UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure. NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default). NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local). git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1268 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc
parent
b089ae2575
commit
de17f5cca4
195
C/absmi.c
195
C/absmi.c
@ -10,8 +10,13 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2005-03-13 06:26:09 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-04-07 17:48:53 $,$Author: ricroc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.161 2005/03/13 06:26:09 vsc
|
||||
* fix excessive pruning in meta-calls
|
||||
* fix Term->int breakage in compiler
|
||||
* improve JPL (at least it does something now for amd64).
|
||||
*
|
||||
* Revision 1.160 2005/03/07 17:49:14 vsc
|
||||
* small fixes
|
||||
*
|
||||
@ -1698,13 +1703,15 @@ Yap_absmi(int inp)
|
||||
/* trust_fail */
|
||||
BOp(trust_fail, e);
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
{
|
||||
choiceptr cut_pt;
|
||||
cut_pt = B->cp_b;
|
||||
CUT_prune_to(cut_pt);
|
||||
B = cut_pt;
|
||||
}
|
||||
#else
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto fail;
|
||||
ENDBOp();
|
||||
|
||||
@ -1763,7 +1770,7 @@ Yap_absmi(int inp)
|
||||
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
|
||||
low_level_trace(retry_table_producer, NULL, NULL);
|
||||
} else {
|
||||
low_level_trace(retry_table_producer, pe, (CELL *)(((gen_cp_ptr)B)+1));
|
||||
low_level_trace(retry_table_producer, pe, (CELL *)(GEN_CP(B)+1));
|
||||
}
|
||||
}
|
||||
break;
|
||||
@ -1781,7 +1788,7 @@ Yap_absmi(int inp)
|
||||
break;
|
||||
case _table_retry_me:
|
||||
case _table_trust_me:
|
||||
low_level_trace(retry_pred, ipc->u.lds.p, (CELL *)(((gen_cp_ptr)B)+1));
|
||||
low_level_trace(retry_pred, ipc->u.lds.p, (CELL *)(GEN_CP(B)+ 1));
|
||||
break;
|
||||
#endif /* TABLING */
|
||||
case _or_else:
|
||||
@ -1987,10 +1994,11 @@ Yap_absmi(int inp)
|
||||
/* so the next cell is the old value */
|
||||
#if FROZEN_STACKS
|
||||
pt[0] = TrailVal(pt0-1);
|
||||
pt0 -= 1;
|
||||
#else
|
||||
pt[0] = TrailTerm(pt0-1);
|
||||
#endif /* FROZEN_STACKS */
|
||||
pt0 -= 2;
|
||||
#endif /* FROZEN_STACKS */
|
||||
goto failloop;
|
||||
}
|
||||
#endif
|
||||
@ -2011,17 +2019,80 @@ Yap_absmi(int inp)
|
||||
BEGD(d0);
|
||||
/* assume cut is always in stack */
|
||||
d0 = YREG[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) {
|
||||
/* cut ! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#else
|
||||
while (B->cp_b < (choiceptr)d0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
trim_trail:
|
||||
HBREG = PROTECT_FROZEN_H(B->cp_b);
|
||||
#if 1
|
||||
#if TABLING
|
||||
{
|
||||
tr_fr_ptr pt0, pt1, pbase;
|
||||
pbase = B->cp_tr;
|
||||
pt0 = pt1 = TR - 1;
|
||||
while (pt1 >= pbase) {
|
||||
BEGD(d1);
|
||||
d1 = TrailTerm(pt1);
|
||||
if (IsVarTerm(d1)) {
|
||||
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
|
||||
TrailTerm(pt0) = d1;
|
||||
TrailVal(pt0) = TrailVal(pt1);
|
||||
pt0--;
|
||||
}
|
||||
pt1--;
|
||||
} else if (IsApplTerm(d1)) {
|
||||
TrailTerm(pt0) = TrailTerm(pt0-2) = d1;
|
||||
TrailTerm(pt0-1) = TrailTerm(pt1-1);
|
||||
pt0 -= 3;
|
||||
pt1 -= 3;
|
||||
} else if (IsPairTerm(d1)) {
|
||||
CELL *pt = RepPair(d1);
|
||||
if ((ADDR) pt >= Yap_TrailBase) {
|
||||
pt1 = (tr_fr_ptr)pt;
|
||||
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
|
||||
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
|
||||
int erase;
|
||||
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
cl->ClFlags &= ~InUseMask;
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
/* at this point, we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
saveregs();
|
||||
Yap_ErLogUpdIndex(cl, NULL);
|
||||
setregs();
|
||||
}
|
||||
} else {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0--;
|
||||
}
|
||||
pt1--;
|
||||
} else {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0--;
|
||||
pt1--;
|
||||
}
|
||||
ENDD(d1);
|
||||
}
|
||||
if (pt0 != pt1) {
|
||||
int size;
|
||||
pt0++;
|
||||
size = TR - pt0;
|
||||
memcpy(pbase, pt0, size * sizeof(struct trail_frame));
|
||||
TR = pbase + size;
|
||||
}
|
||||
}
|
||||
#else
|
||||
{
|
||||
tr_fr_ptr pt1, pt0;
|
||||
pt1 = pt0 = B->cp_tr;
|
||||
@ -2032,7 +2103,7 @@ Yap_absmi(int inp)
|
||||
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0++;
|
||||
}
|
||||
}
|
||||
pt1++;
|
||||
} else if (IsApplTerm(d1)) {
|
||||
TrailTerm(pt0+1) = TrailTerm(pt1+1);
|
||||
@ -2051,8 +2122,7 @@ Yap_absmi(int inp)
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
/* at this point,
|
||||
we are the only ones accessing the clause,
|
||||
/* at this point, we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
saveregs();
|
||||
Yap_ErLogUpdIndex(cl, NULL);
|
||||
@ -2072,12 +2142,8 @@ Yap_absmi(int inp)
|
||||
}
|
||||
TR = pt0;
|
||||
}
|
||||
#endif /* X */
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
B = B->cp_b;
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
}
|
||||
ENDD(d0);
|
||||
@ -2091,16 +2157,17 @@ Yap_absmi(int inp)
|
||||
BEGD(d0);
|
||||
/* assume cut is always in stack */
|
||||
d0 = YREG[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) {
|
||||
/* cut ! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#else
|
||||
while (B->cp_b < (choiceptr)d0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
#ifdef FROZEN_STACKS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B->cp_b);
|
||||
@ -2118,8 +2185,8 @@ Yap_absmi(int inp)
|
||||
else {
|
||||
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
|
||||
}
|
||||
YREG[E_CB] = d0;
|
||||
#endif /* FROZEN_STACKS */
|
||||
YREG[E_CB] = d0;
|
||||
goto trim_trail;
|
||||
}
|
||||
ENDD(d0);
|
||||
@ -2132,15 +2199,17 @@ Yap_absmi(int inp)
|
||||
BEGD(d0);
|
||||
/* we assume dealloc leaves in S the previous env */
|
||||
d0 = SREG[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,(choiceptr)d0)) {
|
||||
/* cut ! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr) d0);
|
||||
#else
|
||||
while (B->cp_b < (choiceptr)d0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto trim_trail;
|
||||
}
|
||||
ENDD(d0);
|
||||
@ -2191,14 +2260,16 @@ Yap_absmi(int inp)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
while (B->cp_b < pt0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto trim_trail;
|
||||
}
|
||||
}
|
||||
@ -2224,14 +2295,16 @@ Yap_absmi(int inp)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
while (B->cp_b < pt0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto trim_trail;
|
||||
}
|
||||
}
|
||||
@ -8524,16 +8597,18 @@ Yap_absmi(int inp)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
while (B->cp_b < pt0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto trim_trail;
|
||||
}
|
||||
PREG = NEXTOP(PREG, xF);
|
||||
@ -8570,15 +8645,17 @@ Yap_absmi(int inp)
|
||||
#else
|
||||
pt1 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt1);
|
||||
#endif /* YAPOR */
|
||||
if (SHOULD_CUT_UP_TO(B,pt1)) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt1);
|
||||
#else
|
||||
while (B->cp_b < pt1) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
goto trim_trail;
|
||||
}
|
||||
PREG = NEXTOP(PREG, yF);
|
||||
@ -12509,18 +12586,19 @@ Yap_absmi(int inp)
|
||||
arity = 0;
|
||||
if (at == AtomCut) {
|
||||
choiceptr cut_pt = (choiceptr)pt0[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(cut_pt);
|
||||
#endif /* YAPOR */
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
|
||||
#ifdef YAPOR
|
||||
/* Wow, we're gonna cut!!! */
|
||||
CUT_prune_to(cut_pt);
|
||||
#else
|
||||
/* Wow, we're gonna cut!!! */
|
||||
B = cut_pt;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
while (B->cp_b < cut_pt) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
B = cut_pt;
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
}
|
||||
@ -12599,18 +12677,19 @@ Yap_absmi(int inp)
|
||||
CACHE_A1();
|
||||
} else if ((Atom)(pen->FunctorOfPred) == AtomCut) {
|
||||
choiceptr cut_pt = (choiceptr)pt0[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(cut_pt);
|
||||
#endif /* YAPOR */
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
|
||||
#ifdef YAPOR
|
||||
/* Wow, we're gonna cut!!! */
|
||||
CUT_prune_to(cut_pt);
|
||||
#else
|
||||
/* Wow, we're gonna cut!!! */
|
||||
B = cut_pt;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
while (B->cp_b < cut_pt) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
B = cut_pt;
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
}
|
||||
|
||||
34
C/exec.c
34
C/exec.c
@ -1167,18 +1167,23 @@ Yap_execute_goal(Term t, int nargs, Term mod)
|
||||
}
|
||||
|
||||
if (out == 1) {
|
||||
choiceptr old_B;
|
||||
choiceptr cut_B, old_B;
|
||||
/* we succeeded, let's prune */
|
||||
/* restore the old environment */
|
||||
/* get to previous environment */
|
||||
cut_B = (choiceptr)ENV[E_CB];
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to((choiceptr)(ENV[E_CB]));
|
||||
#else
|
||||
B = (choiceptr)(ENV[E_CB]);
|
||||
CUT_prune_to(cut_B);
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
if (B != cut_B) {
|
||||
while (B->cp_b < cut_B) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B);
|
||||
}
|
||||
#endif /* TABLING */
|
||||
B = cut_B;
|
||||
/* find out where we have the old arguments */
|
||||
old_B = ((choiceptr)(ENV-(EnvSizeInCells+nargs+1)))-1;
|
||||
CP = saved_cp;
|
||||
@ -1355,17 +1360,19 @@ p_restore_regs2(void)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
/* find where to cut to */
|
||||
if (pt0 > B) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
B = pt0;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
while (B->cp_b < pt0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
B = pt0;
|
||||
HB = B->cp_h;
|
||||
/* trim_trail();*/
|
||||
}
|
||||
@ -1448,7 +1455,12 @@ JumpToEnv(Term t) {
|
||||
B = first_func;
|
||||
}
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
if (B != B0) {
|
||||
while (B0->cp_b < B) {
|
||||
B0 = B0->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B0);
|
||||
}
|
||||
#endif /* TABLING */
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
55
C/heapgc.c
55
C/heapgc.c
@ -1656,16 +1656,16 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
*/
|
||||
|
||||
#ifdef TABLING
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
#define init_substitution_pointer(GCB, SUBS_PTR, DEP_FR) \
|
||||
SUBS_PTR = (CELL *) (CONS_CP(GCB) + 1)
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
#define init_substitution_pointer(GCB, SUBS_PTR, DEP_FR) \
|
||||
SUBS_PTR = (CELL *) (CONS_CP(GCB) + 1); \
|
||||
if (DepFr_leader_cp(DEP_FR) == GCB) \
|
||||
SUBS_PTR += SgFr_arity(GEN_CP_SG_FR(GCB))
|
||||
#endif /* TABLING_SCHEDULING */
|
||||
#endif
|
||||
if (DepFr_leader_cp(DEP_FR) == GCB) { \
|
||||
/* GCB is a generator-consumer node */ \
|
||||
/* never here if batched scheduling */ \
|
||||
SUBS_PTR = (CELL *) (GEN_CP(GCB) + 1); \
|
||||
SUBS_PTR += SgFr_arity(GEN_CP(GCB)->cp_sg_fr); \
|
||||
} else { \
|
||||
SUBS_PTR = (CELL *) (CONS_CP(GCB) + 1); \
|
||||
}
|
||||
#endif /* TABLING */
|
||||
|
||||
|
||||
static void
|
||||
@ -1829,7 +1829,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
CELL vars;
|
||||
|
||||
/* fetch the solution */
|
||||
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->ccp_dep_fr);
|
||||
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->cp_dep_fr);
|
||||
vars = *answ_fr++;
|
||||
while (vars--) {
|
||||
mark_external_reference(answ_fr);
|
||||
@ -1840,15 +1840,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
break;
|
||||
case _table_completion:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
int nargs;
|
||||
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
nargs = gcp->gcp_sg_fr->subgoal_arity;
|
||||
#else
|
||||
nargs = gcp->gcp_dep_fr->subgoal_frame->subgoal_arity;
|
||||
#endif
|
||||
saved_reg = (CELL *)(gcp+1)+nargs;
|
||||
int nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
|
||||
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
|
||||
nargs = *saved_reg++;
|
||||
while (nargs--) {
|
||||
mark_external_reference(saved_reg);
|
||||
@ -1862,13 +1855,12 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
case _table_retry:
|
||||
case _table_trust:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
int nargs = rtp->u.ld.s;
|
||||
/* for each saved register */
|
||||
for (saved_reg = (CELL *)(gcp+1);
|
||||
for (saved_reg = (CELL *)(GEN_CP(gc_B) + 1);
|
||||
/* assumes we can count registers in CP this
|
||||
way */
|
||||
saved_reg < (CELL *)(gcp+1) + nargs;
|
||||
saved_reg < (CELL *)(GEN_CP(gc_B) + 1) + nargs;
|
||||
saved_reg++) {
|
||||
mark_external_reference(saved_reg);
|
||||
}
|
||||
@ -2552,7 +2544,7 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
|
||||
|
||||
/* fetch the solution */
|
||||
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->ccp_dep_fr);
|
||||
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->cp_dep_fr);
|
||||
vars = *answ_fr++;
|
||||
while (vars--) {
|
||||
CELL cp_cell = *answ_fr;
|
||||
@ -2568,16 +2560,10 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
break;
|
||||
case _table_completion:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
int nargs = gcp->gcp_sg_fr->subgoal_arity;
|
||||
#else
|
||||
int nargs = gcp->gcp_dep_fr->subgoal_frame->subgoal_arity;
|
||||
#endif
|
||||
int nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
|
||||
CELL *saved_reg;
|
||||
|
||||
saved_reg = (CELL *)(gcp+1)+nargs;
|
||||
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
|
||||
nargs = *saved_reg++;
|
||||
while (nargs--) {
|
||||
CELL cp_cell = *saved_reg;
|
||||
@ -2596,7 +2582,6 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
case _table_retry:
|
||||
case _table_trust:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
int nargs;
|
||||
CELL *saved_reg;
|
||||
|
||||
@ -2606,10 +2591,10 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
|
||||
nargs = rtp->u.ld.s;
|
||||
/* for each saved register */
|
||||
for (saved_reg = (CELL *)(gcp+1);
|
||||
for (saved_reg = (CELL *)(GEN_CP(gc_B) + 1);
|
||||
/* assumes we can count registers in CP this
|
||||
way */
|
||||
saved_reg < (CELL *)(gcp+1) + nargs;
|
||||
saved_reg < (CELL *)(GEN_CP(gc_B) + 1) + nargs;
|
||||
saved_reg++) {
|
||||
CELL cp_cell = *saved_reg;
|
||||
if (MARKED_PTR(saved_reg)) {
|
||||
@ -2619,7 +2604,7 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
}
|
||||
}
|
||||
}
|
||||
saved_reg = (CELL *)(gcp+1) + nargs;
|
||||
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
|
||||
nargs = *saved_reg++;
|
||||
while (nargs--) {
|
||||
CELL cp_cell = *saved_reg;
|
||||
|
||||
95
C/index.c
95
C/index.c
@ -11,8 +11,12 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2005-03-15 18:29:23 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-04-07 17:48:54 $,$Author: ricroc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.120 2005/03/15 18:29:23 vsc
|
||||
* fix GPL
|
||||
* fix idb: stuff in coroutines.
|
||||
*
|
||||
* Revision 1.119 2005/03/04 20:30:12 ricroc
|
||||
* bug fixes for YapTab support
|
||||
*
|
||||
@ -647,7 +651,7 @@ has_cut(yamop *pc)
|
||||
case _getwork:
|
||||
case _getwork_seq:
|
||||
case _sync:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
case _table_try_me_single:
|
||||
case _table_try_me:
|
||||
@ -655,7 +659,7 @@ has_cut(yamop *pc)
|
||||
case _table_trust_me:
|
||||
case _table_answer_resolution:
|
||||
case _table_completion:
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
pc = NEXTOP(pc,ld);
|
||||
break;
|
||||
/* instructions type Ill */
|
||||
@ -702,7 +706,7 @@ has_cut(yamop *pc)
|
||||
case _write_l_list:
|
||||
#if !defined(YAPOR)
|
||||
case _or_last:
|
||||
#endif
|
||||
#endif /* !YAPOR */
|
||||
case _pop:
|
||||
case _index_pred:
|
||||
#if THREADS
|
||||
@ -722,7 +726,7 @@ has_cut(yamop *pc)
|
||||
case _index_blob:
|
||||
#ifdef YAPOR
|
||||
case _getwork_first_time:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
case _trie_do_var:
|
||||
case _trie_trust_var:
|
||||
@ -744,7 +748,7 @@ has_cut(yamop *pc)
|
||||
case _trie_trust_struct:
|
||||
case _trie_try_struct:
|
||||
case _trie_retry_struct:
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
pc = NEXTOP(pc,e);
|
||||
break;
|
||||
case _expand_clauses:
|
||||
@ -800,7 +804,7 @@ has_cut(yamop *pc)
|
||||
case _call:
|
||||
#ifdef YAPOR
|
||||
case _or_last:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
pc = NEXTOP(pc,sla);
|
||||
break;
|
||||
/* instructions type sla, but for disjunctions */
|
||||
@ -963,7 +967,7 @@ has_cut(yamop *pc)
|
||||
case _pop_n:
|
||||
#ifdef TABLING
|
||||
case _table_new_answer:
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
pc = NEXTOP(pc,s);
|
||||
break;
|
||||
/* instructions type ps */
|
||||
@ -1347,7 +1351,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _call:
|
||||
#ifdef YAPOR
|
||||
case _or_last:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
case _either:
|
||||
case _or_else:
|
||||
case _call_cpred:
|
||||
@ -1960,7 +1964,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _getwork:
|
||||
case _getwork_seq:
|
||||
case _sync:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
case _table_try_single:
|
||||
case _table_try_me:
|
||||
@ -1971,7 +1975,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _table_trust:
|
||||
case _table_answer_resolution:
|
||||
case _table_completion:
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
case _enter_profiling:
|
||||
case _count_call:
|
||||
case _retry_profiled:
|
||||
@ -2003,7 +2007,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _procceed:
|
||||
#if !defined(YAPOR)
|
||||
case _or_last:
|
||||
#endif
|
||||
#endif /* !YAPOR */
|
||||
case _pop:
|
||||
case _index_pred:
|
||||
#if THREADS
|
||||
@ -2022,7 +2026,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _index_blob:
|
||||
#ifdef YAPOR
|
||||
case _getwork_first_time:
|
||||
#endif
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
case _table_new_answer:
|
||||
case _trie_do_var:
|
||||
@ -2045,7 +2049,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
case _trie_trust_struct:
|
||||
case _trie_try_struct:
|
||||
case _trie_retry_struct:
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
clause->Tag = (CELL)NULL;
|
||||
return;
|
||||
}
|
||||
@ -2957,7 +2961,7 @@ emit_optry(int var_group, int first, int clauses, int clleft, PredEntry *ap)
|
||||
/* we never actually get to remove the last choice-point in this case */
|
||||
return retry_op;
|
||||
} else
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
{
|
||||
/* last group */
|
||||
return try_op;
|
||||
@ -3286,7 +3290,7 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
|
||||
return lbl;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
return (UInt)(min->CurrentCode);
|
||||
}
|
||||
|
||||
@ -3566,7 +3570,7 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, struct intermedi
|
||||
but should work.
|
||||
*/
|
||||
Yap_emit(retryme_op, (CELL)TRUSTFAILCODE, 0, cint);
|
||||
#endif
|
||||
#endif /* TABLING */
|
||||
} else {
|
||||
Yap_emit(trustme_op, 0, 0, cint);
|
||||
}
|
||||
@ -4571,12 +4575,19 @@ expand_index(struct intermediates *cint) {
|
||||
case _retry_me2:
|
||||
case _retry_me3:
|
||||
case _retry_me4:
|
||||
#ifdef TABLING
|
||||
case _table_retry_me:
|
||||
#endif /* TABLING */
|
||||
isfirstcl = FALSE;
|
||||
case _try_me:
|
||||
case _try_me1:
|
||||
case _try_me2:
|
||||
case _try_me3:
|
||||
case _try_me4:
|
||||
#ifdef TABLING
|
||||
case _table_try_single:
|
||||
case _table_try_me:
|
||||
#endif /* TABLING */
|
||||
/* ok, we found the start for an indexing block,
|
||||
but we don't if we are going to operate here or not */
|
||||
/* if we are to commit here, alt will tell us where */
|
||||
@ -4593,6 +4604,9 @@ expand_index(struct intermediates *cint) {
|
||||
case _trust_me2:
|
||||
case _trust_me3:
|
||||
case _trust_me4:
|
||||
#ifdef TABLING
|
||||
case _table_trust_me:
|
||||
#endif /* TABLING */
|
||||
/* we will commit to this group for sure */
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
alt = NULL;
|
||||
@ -4880,8 +4894,11 @@ expand_index(struct intermediates *cint) {
|
||||
}
|
||||
} else {
|
||||
op_numbers op = Yap_op_from_opcode(alt->opc);
|
||||
if (op == _retry ||
|
||||
op == _trust) {
|
||||
if (op == _retry || op == _trust
|
||||
#ifdef TABLING
|
||||
|| op == _table_retry || op == _table_trust
|
||||
#endif /* TABLING */
|
||||
) {
|
||||
last = alt->u.ld.d;
|
||||
} else if (op >= _retry2 && op <= _retry4) {
|
||||
last = alt->u.l.l;
|
||||
@ -7608,13 +7625,15 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
||||
break;
|
||||
case _trust:
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(B->cp_b);
|
||||
{
|
||||
choiceptr cut_pt;
|
||||
cut_pt = B->cp_b;
|
||||
CUT_prune_to(cut_pt);
|
||||
B = cut_pt;
|
||||
}
|
||||
#else
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
b0 = B;
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
@ -7628,13 +7647,15 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
||||
case _trust_me3:
|
||||
case _trust_me4:
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(B->cp_b);
|
||||
{
|
||||
choiceptr cut_pt;
|
||||
cut_pt = B->cp_b;
|
||||
CUT_prune_to(cut_pt);
|
||||
B = cut_pt;
|
||||
}
|
||||
#else
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _trust_logical_pred:
|
||||
@ -7942,13 +7963,15 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
||||
default:
|
||||
if (b0) {
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(B->cp_b);
|
||||
{
|
||||
choiceptr cut_pt;
|
||||
cut_pt = B->cp_b;
|
||||
CUT_prune_to(cut_pt);
|
||||
B = cut_pt;
|
||||
}
|
||||
#else
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* I did a trust */
|
||||
}
|
||||
if (lu_pred)
|
||||
@ -7960,13 +7983,15 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
|
||||
if (b0) {
|
||||
/* I did a trust */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(B->cp_b);
|
||||
{
|
||||
choiceptr cut_pt;
|
||||
cut_pt = B->cp_b;
|
||||
CUT_prune_to(cut_pt);
|
||||
B = cut_pt;
|
||||
}
|
||||
#else
|
||||
B = B->cp_b;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
13
C/init.c
13
C/init.c
@ -746,6 +746,11 @@ InitFlags(void)
|
||||
#endif
|
||||
/* current default */
|
||||
yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
|
||||
#ifdef TABLING
|
||||
yap_flags[TABLING_MODE_FLAG] = TABLING_MODE_DEFAULT;
|
||||
#else
|
||||
yap_flags[TABLING_MODE_FLAG] = TABLING_MODE_OFF;
|
||||
#endif /* TABLING */
|
||||
}
|
||||
|
||||
static void
|
||||
@ -1155,14 +1160,6 @@ Yap_InitWorkspace(int Heap,
|
||||
/* also init memory page size, required by later functions */
|
||||
Yap_InitSysbits ();
|
||||
|
||||
#ifdef TABLING
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
INFORMATION_MESSAGE("YapTab: batched scheduling");
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
INFORMATION_MESSAGE("YapTab: local scheduling");
|
||||
#endif /* BATCHED - LOCAL */
|
||||
#endif /* TABLING */
|
||||
|
||||
#ifdef YAPOR
|
||||
worker_id = 0;
|
||||
if (aux_number_workers > MAX_WORKERS)
|
||||
|
||||
12
C/inlines.c
12
C/inlines.c
@ -751,17 +751,19 @@ p_cut_by( void)
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
#endif
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
/* find where to cut to */
|
||||
if (pt0 > B) {
|
||||
/* Wow, we're gonna cut!!! */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
B = pt0;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
while (B->cp_b < pt0) {
|
||||
B = B->cp_b;
|
||||
}
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
B = pt0;
|
||||
HB = B->cp_h;
|
||||
/* trim_trail();*/
|
||||
}
|
||||
|
||||
16
C/stdpreds.c
16
C/stdpreds.c
@ -11,8 +11,13 @@
|
||||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2005-03-13 06:26:11 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-04-07 17:48:55 $,$Author: ricroc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.86 2005/03/13 06:26:11 vsc
|
||||
* fix excessive pruning in meta-calls
|
||||
* fix Term->int breakage in compiler
|
||||
* improve JPL (at least it does something now for amd64).
|
||||
*
|
||||
* Revision 1.85 2005/03/02 19:48:02 vsc
|
||||
* Fix some possible errors in name/2 and friends, and cleanup code a bit
|
||||
* YAP_Error changed.
|
||||
@ -2852,6 +2857,15 @@ p_set_yap_flags(void)
|
||||
return(FALSE);
|
||||
yap_flags[INDEXING_MODE_FLAG] = value;
|
||||
break;
|
||||
case TABLING_MODE_FLAG:
|
||||
#ifdef TABLING
|
||||
if (value != TABLING_MODE_DEFAULT && value != TABLING_MODE_BATCHED && value != TABLING_MODE_LOCAL)
|
||||
return(FALSE);
|
||||
yap_flags[TABLING_MODE_FLAG] = value;
|
||||
#else
|
||||
return(FALSE);
|
||||
#endif /* TABLING */
|
||||
break;
|
||||
default:
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
@ -390,10 +390,11 @@ reset_trail(tr_fr_ptr TR0) {
|
||||
/* so the next cell is the old value */
|
||||
#if FROZEN_STACKS
|
||||
pt[0] = TrailVal(TR-1);
|
||||
TR -= 1;
|
||||
#else
|
||||
pt[0] = TrailTerm(TR-1);
|
||||
#endif /* FROZEN_STACKS */
|
||||
TR -= 2;
|
||||
#endif /* FROZEN_STACKS */
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
@ -40,9 +40,7 @@ INFODIR=$(SHAREDIR)/info
|
||||
# -DENV_COPY: or-parallelism with environment copying, in Muse style.
|
||||
# -DSBA: or-parallelism with sparse binding arrays.
|
||||
# -DACOW: or-parallelism with copy-on-write.
|
||||
# -DTABLING_BATCHED_SCHEDULING: support for tabulation with
|
||||
# batched scheduling
|
||||
# -DTABLING_LOCAL_SCHEDULING: support for tabulation with local scheduling
|
||||
# -DTABLING: support for tabling
|
||||
#
|
||||
#
|
||||
# check also optimisation options in INSTALL file.
|
||||
|
||||
@ -37,9 +37,9 @@ struct worker WORKER;
|
||||
void abort_yaptab(const char *msg, ...) {
|
||||
va_list args;
|
||||
va_start(args, msg);
|
||||
fprintf(stderr, "[ Fatal YapTab Error: ");
|
||||
fprintf(stderr, "%% YAPTAB FATAL ERROR: ");
|
||||
vfprintf(stderr, msg, args);
|
||||
fprintf(stderr, " ]\n");
|
||||
fprintf(stderr, "\n");
|
||||
exit (1);
|
||||
}
|
||||
#endif /* TABLING */
|
||||
@ -49,9 +49,9 @@ void abort_yaptab(const char *msg, ...) {
|
||||
void abort_yapor(const char *msg, ...) {
|
||||
va_list args;
|
||||
va_start(args, msg);
|
||||
fprintf(stderr, "[ Fatal YapOr Error: ");
|
||||
fprintf(stderr, "%% YAPOR FATAL ERROR: ");
|
||||
vfprintf(stderr, msg, args);
|
||||
fprintf(stderr, " (worker %d exiting...) ]\n", worker_id);
|
||||
fprintf(stderr, " (worker %d exiting...)\n", worker_id);
|
||||
unmap_memory();
|
||||
exit (1);
|
||||
}
|
||||
|
||||
@ -8,13 +8,13 @@
|
||||
#include "Yatom.h"
|
||||
#include "Heap.h"
|
||||
#include "yapio.h"
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#ifdef YAPOR
|
||||
#if HAVE_SYS_TIME_H
|
||||
#include <sys/time.h>
|
||||
#endif
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#include "or.macros.h"
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
@ -37,8 +37,8 @@ static qg_ans_fr_ptr actual_answer;
|
||||
|
||||
#ifdef YAPOR
|
||||
static realtime current_time(void);
|
||||
static int yapor_on(void);
|
||||
static int start_yapor(void);
|
||||
static int p_yapor_on(void);
|
||||
static int p_start_yapor(void);
|
||||
static int p_sequential(void);
|
||||
static int p_default_sequential(void);
|
||||
static int p_execution_mode(void);
|
||||
@ -50,10 +50,11 @@ static void show_answers(void);
|
||||
static void answer_to_stdout(char *answer);
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
static int p_table(void);
|
||||
static int p_abolish_trie(void);
|
||||
static int p_show_trie(void);
|
||||
static int p_show_trie_stats(void);
|
||||
static int p_do_table(void);
|
||||
static int p_do_tabling_mode(void);
|
||||
static int p_do_abolish_trie(void);
|
||||
static int p_do_show_trie(void);
|
||||
static int p_do_show_trie_stats(void);
|
||||
#endif /* TABLING */
|
||||
#ifdef STATISTICS
|
||||
static int p_show_frames_stats(void);
|
||||
@ -70,8 +71,8 @@ static int p_debug_prolog(void);
|
||||
|
||||
void Yap_init_optyap_preds(void) {
|
||||
#ifdef YAPOR
|
||||
Yap_InitCPred("$yapor_on", 0, yapor_on, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$start_yapor", 0, start_yapor, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$yapor_on", 0, p_yapor_on, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$start_yapor", 0, p_start_yapor, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$sequential", 1, p_sequential, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("execution_mode", 1, p_execution_mode, SafePredFlag|SyncPredFlag);
|
||||
@ -80,10 +81,11 @@ void Yap_init_optyap_preds(void) {
|
||||
Yap_InitCPred("$parallel_yes_answer", 0, p_parallel_yes_answer, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
Yap_InitCPred("$do_table", 2, p_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie", 2, p_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie_stats", 2, p_show_trie_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_table", 2, p_do_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_tabling_mode", 3, p_do_tabling_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_abolish_trie", 2, p_do_abolish_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie", 2, p_do_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$do_show_trie_stats", 2, p_do_show_trie_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
#endif /* TABLING */
|
||||
#ifdef STATISTICS
|
||||
Yap_InitCPred("show_frames_stats", 0, p_show_frames_stats, SafePredFlag|SyncPredFlag);
|
||||
@ -124,13 +126,13 @@ realtime current_time(void) {
|
||||
|
||||
|
||||
static
|
||||
int yapor_on(void) {
|
||||
int p_yapor_on(void) {
|
||||
return (PARALLEL_EXECUTION_MODE);
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
int start_yapor(void) {
|
||||
int p_start_yapor(void) {
|
||||
#ifdef TIMESTAMP_CHECK
|
||||
GLOBAL_timestamp = 0;
|
||||
#endif /* TIMESTAMP_CHECK */
|
||||
@ -443,7 +445,7 @@ void answer_to_stdout(char *answer) {
|
||||
|
||||
#ifdef TABLING
|
||||
static
|
||||
int p_table(void) {
|
||||
int p_do_table(void) {
|
||||
Term t, mod;
|
||||
PredEntry *pe;
|
||||
tab_ent_ptr te;
|
||||
@ -463,6 +465,9 @@ int p_table(void) {
|
||||
} else {
|
||||
return (FALSE);
|
||||
}
|
||||
if (pe->PredFlags & TabledPredFlag) {
|
||||
return (TRUE);
|
||||
}
|
||||
pe->PredFlags |= TabledPredFlag;
|
||||
new_subgoal_trie_node(sg_node, 0, NULL, NULL, NULL);
|
||||
new_table_entry(te, sg_node);
|
||||
@ -472,7 +477,53 @@ int p_table(void) {
|
||||
|
||||
|
||||
static
|
||||
int p_abolish_trie(void) {
|
||||
int p_do_tabling_mode(void) {
|
||||
Term t, mod, s;
|
||||
PredEntry *pe;
|
||||
|
||||
mod = Deref(ARG2);
|
||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||
return (FALSE);
|
||||
}
|
||||
t = Deref(ARG1);
|
||||
if (IsAtomTerm(t)) {
|
||||
Atom at = AtomOfTerm(t);
|
||||
pe = RepPredProp(PredPropByAtom(at, mod));
|
||||
} else if (IsApplTerm(t)) {
|
||||
Functor func = FunctorOfTerm(t);
|
||||
pe = RepPredProp(PredPropByFunc(func, mod));
|
||||
} else {
|
||||
return (FALSE);
|
||||
}
|
||||
s = Deref(ARG3);
|
||||
if (IsVarTerm(s)) {
|
||||
Term sa;
|
||||
if (pe->PredFlags & LocalSchedPredFlag) {
|
||||
sa = MkAtomTerm(Yap_LookupAtom("local"));
|
||||
} else {
|
||||
sa = MkAtomTerm(Yap_LookupAtom("batched"));
|
||||
}
|
||||
Bind((CELL *)s, sa);
|
||||
return(TRUE);
|
||||
}
|
||||
if (IsAtomTerm(s)) {
|
||||
char *sa;
|
||||
sa = RepAtom(AtomOfTerm(s))->StrOfAE;
|
||||
if (strcmp(sa, "local") == 0) {
|
||||
pe->PredFlags |= LocalSchedPredFlag;
|
||||
return(TRUE);
|
||||
}
|
||||
if (strcmp(sa,"batched") == 0) {
|
||||
pe->PredFlags &= ~LocalSchedPredFlag;
|
||||
return(TRUE);
|
||||
}
|
||||
}
|
||||
return (FALSE);
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
int p_do_abolish_trie(void) {
|
||||
Term t, mod;
|
||||
tab_ent_ptr tab_ent;
|
||||
sg_hash_ptr hash;
|
||||
@ -508,7 +559,7 @@ int p_abolish_trie(void) {
|
||||
|
||||
|
||||
static
|
||||
int p_show_trie(void) {
|
||||
int p_do_show_trie(void) {
|
||||
Term t1, mod;
|
||||
PredEntry *pe;
|
||||
Atom at;
|
||||
@ -537,7 +588,7 @@ int p_show_trie(void) {
|
||||
|
||||
|
||||
static
|
||||
int p_show_trie_stats(void) {
|
||||
int p_do_show_trie_stats(void) {
|
||||
Term t, mod;
|
||||
PredEntry *pe;
|
||||
Atom at;
|
||||
|
||||
@ -68,12 +68,12 @@ void finish_yapor(void);
|
||||
|
||||
#ifdef TABLING
|
||||
#include <stdio.h>
|
||||
sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr);
|
||||
sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr);
|
||||
ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr);
|
||||
void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr);
|
||||
void private_completion(sg_fr_ptr sg_fr);
|
||||
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes);
|
||||
void free_answer_trie(sg_fr_ptr sg_fr);
|
||||
void free_answer_trie_branch(ans_node_ptr node);
|
||||
void update_answer_trie(sg_fr_ptr sg_fr);
|
||||
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show);
|
||||
#endif /* TABLING */
|
||||
|
||||
@ -657,7 +657,7 @@ void share_private_nodes(int worker_q) {
|
||||
/* update subgoal frames in the recently shared branches */
|
||||
while (sg_frame && YOUNGER_CP(SgFr_gen_cp(sg_frame), LOCAL_top_cp_on_stack)) {
|
||||
SgFr_gen_worker(sg_frame) = MAX_WORKERS;
|
||||
SgFr_gen_top_or_fr(sg_frame) = GEN_CP(SgFr_gen_cp(sg_frame))->gcp_or_fr;
|
||||
SgFr_gen_top_or_fr(sg_frame) = SgFr_gen_cp(sg_frame)->cp_or_fr;
|
||||
sg_frame = SgFr_next(sg_frame);
|
||||
}
|
||||
|
||||
@ -676,7 +676,7 @@ void share_private_nodes(int worker_q) {
|
||||
REMOTE_top_dep_fr(worker_q) = dep_frame;
|
||||
/* update dependency frames in the recently shared branches */
|
||||
while (YOUNGER_CP(DepFr_cons_cp(dep_frame), LOCAL_top_cp_on_stack)) {
|
||||
DepFr_top_or_fr(dep_frame) = CONS_CP(DepFr_cons_cp(dep_frame))->ccp_or_fr;
|
||||
DepFr_top_or_fr(dep_frame) = DepFr_cons_cp(dep_frame)->cp_or_fr;
|
||||
dep_frame = DepFr_next(dep_frame);
|
||||
}
|
||||
#endif /* TABLING */
|
||||
|
||||
@ -38,18 +38,31 @@
|
||||
/* the frozen branch depends on the current top node **
|
||||
** this means that the current top node is a generator node */
|
||||
LOCK_OR_FRAME(LOCAL_top_or_fr);
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
if (OrFr_alternative(LOCAL_top_or_fr) != GEN_CP_NULL_ALT) {
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
if (OrFr_alternative(LOCAL_top_or_fr) != GEN_CP_NULL_ALT || B_FZ == LOCAL_top_cp) {
|
||||
#endif /* TABLING_SCHEDULING */
|
||||
/* the current top node has unexploited alternatives ---> we should **
|
||||
** exploit all the available alternatives before execute completion */
|
||||
if (OrFr_alternative(LOCAL_top_or_fr) == NULL ||
|
||||
(OrFr_alternative(LOCAL_top_or_fr) == ANSWER_RESOLUTION && B_FZ != LOCAL_top_cp)) {
|
||||
/* there are no unexploited alternatives **
|
||||
** (NULL if batched scheduling OR ANSWER_RESOLUTION if local scheduling) */
|
||||
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
|
||||
goto completion;
|
||||
} else {
|
||||
/* there are unexploited alternatives **
|
||||
** we should exploit all the available alternatives before execute completion */
|
||||
PREG = OrFr_alternative(LOCAL_top_or_fr);
|
||||
PREFETCH_OP(PREG);
|
||||
GONext();
|
||||
}
|
||||
/* ricroc - obsolete
|
||||
#ifdef batched scheduling
|
||||
if (OrFr_alternative(LOCAL_top_or_fr) != NULL) {
|
||||
#else local scheduling
|
||||
if (OrFr_alternative(LOCAL_top_or_fr) != ANSWER_RESOLUTION || B_FZ == LOCAL_top_cp) {
|
||||
#endif
|
||||
PREG = OrFr_alternative(LOCAL_top_or_fr);
|
||||
PREFETCH_OP(PREG);
|
||||
GONext();
|
||||
}
|
||||
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
|
||||
*/
|
||||
}
|
||||
goto completion;
|
||||
}
|
||||
|
||||
@ -20,7 +20,6 @@ STD_PROTO(static inline void SCH_refuse_share_request_if_any, (void));
|
||||
STD_PROTO(static inline void SCH_set_load, (choiceptr));
|
||||
STD_PROTO(static inline void SCH_new_alternative, (yamop *,yamop *));
|
||||
|
||||
STD_PROTO(static inline void CUT_prune_to, (choiceptr));
|
||||
STD_PROTO(static inline void CUT_send_prune_request, (int, choiceptr));
|
||||
STD_PROTO(static inline void CUT_reset_prune_request, (void));
|
||||
|
||||
@ -152,6 +151,13 @@ STD_PROTO(static inline qg_sol_fr_ptr CUT_prune_solution_frames, (qg_sol_fr_ptr,
|
||||
** Cut Macros **
|
||||
** -------------------- */
|
||||
|
||||
#define CUT_prune_to(PRUNE_CP) \
|
||||
if (YOUNGER_CP(LOCAL_top_cp, PRUNE_CP)) { \
|
||||
if (! LOCAL_prune_request) \
|
||||
prune_shared_branch(PRUNE_CP); \
|
||||
PRUNE_CP = LOCAL_top_cp; \
|
||||
}
|
||||
|
||||
#define CUT_wait_leftmost() \
|
||||
if (PARALLEL_EXECUTION_MODE) { \
|
||||
/* parallel execution mode --> wait until leftmost */ \
|
||||
@ -318,19 +324,6 @@ void SCH_new_alternative(yamop *curpc, yamop *new) {
|
||||
** Cut Stuff: Pruning **
|
||||
** ---------------------------- */
|
||||
|
||||
static inline
|
||||
void CUT_prune_to(choiceptr prune_cp) {
|
||||
if (EQUAL_OR_YOUNGER_CP(prune_cp, LOCAL_top_cp)) {
|
||||
B = prune_cp;
|
||||
} else {
|
||||
if (! LOCAL_prune_request)
|
||||
prune_shared_branch(prune_cp);
|
||||
B = LOCAL_top_cp;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static inline
|
||||
void CUT_send_prune_request(int worker, choiceptr prune_cp) {
|
||||
LOCK_WORKER(worker);
|
||||
|
||||
@ -117,7 +117,7 @@ void move_up_to_prune_request(void) {
|
||||
CUT_reset_prune_request();
|
||||
#ifdef TABLING
|
||||
LOCAL_top_cp_on_stack = LOCAL_top_cp;
|
||||
abolish_incomplete_subgoals(LOCAL_top_cp);
|
||||
abolish_incomplete_subgoals(LOCAL_top_cp - 1); /* do not include LOCAL_top_cp */
|
||||
#endif /* TABLIG */
|
||||
|
||||
return;
|
||||
@ -277,13 +277,18 @@ int move_up_one_node(or_fr_ptr nearest_livenode) {
|
||||
if (OrFr_pend_prune_cp(LOCAL_top_or_fr)
|
||||
&& ! LOCAL_prune_request
|
||||
&& CUT_last_worker_left_pending_prune(LOCAL_top_or_fr)) {
|
||||
#ifdef TABLING
|
||||
choiceptr aux_cp = LOCAL_top_cp;
|
||||
#endif /* TABLIG */
|
||||
choiceptr prune_cp = OrFr_pend_prune_cp(LOCAL_top_or_fr);
|
||||
OrFr_pend_prune_cp(LOCAL_top_or_fr) = NULL;
|
||||
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = OrFr_pend_prune_ltt(LOCAL_top_or_fr);
|
||||
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
|
||||
prune_shared_branch(prune_cp);
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(LOCAL_top_cp);
|
||||
while (YOUNGER_CP(aux_cp->cp_b, LOCAL_top_cp))
|
||||
aux_cp = aux_cp->cp_b;
|
||||
abolish_incomplete_subgoals(aux_cp);
|
||||
#endif /* TABLIG */
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,8 +1,8 @@
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "opt.mavar.h"
|
||||
|
||||
|
||||
|
||||
/* -------------------- **
|
||||
** Prototypes **
|
||||
** -------------------- */
|
||||
@ -63,9 +63,11 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
|
||||
#endif /* TAGS_FAST_OPS */
|
||||
|
||||
|
||||
#define NORM_CP(CP) ((choiceptr)(CP))
|
||||
#define GEN_CP(CP) ((gen_cp_ptr)(CP))
|
||||
#define CONS_CP(CP) ((cons_cp_ptr)(CP))
|
||||
#define NORM_CP(CP) ((choiceptr)(CP))
|
||||
#define CONS_CP(CP) ((struct consumer_choicept *)(CP))
|
||||
#define GEN_CP(CP) ((struct generator_choicept *)(CP))
|
||||
#define IS_BATCHED_GEN_CP(CP) (GEN_CP(CP)->cp_dep_fr == NULL)
|
||||
|
||||
|
||||
#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned int)TrNode_parent(NODE) | 0x1)
|
||||
#define UNTAG_ANSWER_LEAF_NODE(NODE) ((ans_node_ptr)((unsigned int)NODE & 0xfffffffe))
|
||||
@ -159,15 +161,6 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
|
||||
#endif /* YAPOR */
|
||||
|
||||
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
#define GEN_CP_NULL_ALT NULL
|
||||
#define GEN_CP_SG_FR(GCP) GEN_CP(GCP)->gcp_sg_fr
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
#define GEN_CP_NULL_ALT ANSWER_RESOLUTION
|
||||
#define GEN_CP_SG_FR(GCP) DepFr_sg_fr(GEN_CP(GCP)->gcp_dep_fr)
|
||||
#endif /* TABLING_SCHEDULING */
|
||||
|
||||
|
||||
#ifdef YAPOR
|
||||
#ifdef TIMESTAMP
|
||||
#define DepFr_init_timestamp_field(DEP_FR) DepFr_timestamp(DEP_FR) = 0
|
||||
@ -237,32 +230,39 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
|
||||
memcpy(SuspFr_trail_start(SUSP_FR), SuspFr_trail_reg(SUSP_FR), TR_SIZE)
|
||||
|
||||
|
||||
#define new_subgoal_frame(SG_FR, BOTTOM_SG_NODE, ARITY, NEXT) \
|
||||
#define new_subgoal_frame(SG_FR, ARITY) \
|
||||
{ register ans_node_ptr ans_node; \
|
||||
ALLOC_SUBGOAL_FRAME(SG_FR); \
|
||||
INIT_LOCK(SgFr_lock(SG_FR)); \
|
||||
SgFr_init_yapor_fields(SG_FR); \
|
||||
SgFr_subgoal_trie(SG_FR) = BOTTOM_SG_NODE; \
|
||||
new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \
|
||||
SgFr_answer_trie(SG_FR) = ans_node; \
|
||||
SgFr_first_answer(SG_FR) = NULL; \
|
||||
SgFr_last_answer(SG_FR) = NULL; \
|
||||
SgFr_hash_chain(SG_FR) = NULL; \
|
||||
SgFr_state(SG_FR) = resolving; \
|
||||
SgFr_state(SG_FR) = ready; \
|
||||
SgFr_abolished(SG_FR) = 0; \
|
||||
SgFr_arity(SG_FR) = ARITY; \
|
||||
SgFr_next(SG_FR) = NEXT; \
|
||||
}
|
||||
|
||||
|
||||
#define new_dependency_frame(DEP_FR, DEP_ON_STACK, TOP_OR_FR, LEADER_CP, CONS_CP, SG_FR, NEXT) \
|
||||
ALLOC_DEPENDENCY_FRAME(DEP_FR); \
|
||||
INIT_LOCK(DepFr_lock(DEP_FR)); \
|
||||
DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR); \
|
||||
DepFr_backchain_cp(DEP_FR) = NULL; \
|
||||
DepFr_leader_cp(DEP_FR) = NORM_CP(LEADER_CP); \
|
||||
DepFr_cons_cp(DEP_FR) = NORM_CP(CONS_CP); \
|
||||
DepFr_sg_fr(DEP_FR) = SG_FR; \
|
||||
DepFr_last_ans(DEP_FR) = NULL; \
|
||||
#define init_subgoal_frame(SG_FR) \
|
||||
{ SgFr_init_yapor_fields(SG_FR); \
|
||||
SgFr_first_answer(SG_FR) = NULL; \
|
||||
SgFr_last_answer(SG_FR) = NULL; \
|
||||
SgFr_hash_chain(SG_FR) = NULL; \
|
||||
SgFr_state(SG_FR) = evaluating; \
|
||||
SgFr_next(SG_FR) = LOCAL_top_sg_fr; \
|
||||
LOCAL_top_sg_fr = sg_fr; \
|
||||
}
|
||||
|
||||
|
||||
#define new_dependency_frame(DEP_FR, DEP_ON_STACK, TOP_OR_FR, LEADER_CP, CONS_CP, SG_FR, NEXT) \
|
||||
ALLOC_DEPENDENCY_FRAME(DEP_FR); \
|
||||
INIT_LOCK(DepFr_lock(DEP_FR)); \
|
||||
DepFr_init_yapor_fields(DEP_FR, DEP_ON_STACK, TOP_OR_FR); \
|
||||
DepFr_backchain_cp(DEP_FR) = NULL; \
|
||||
DepFr_leader_cp(DEP_FR) = NORM_CP(LEADER_CP); \
|
||||
DepFr_cons_cp(DEP_FR) = NORM_CP(CONS_CP); \
|
||||
/* start with TrNode_child(DepFr_last_answer(DEP_FR)) pointing to SgFr_first_answer(SG_FR) */ \
|
||||
DepFr_last_answer(DEP_FR) = (ans_node_ptr)((int)(SG_FR) + \
|
||||
(int)(&SgFr_first_answer((sg_fr_ptr)DEP_FR)) - (int)(&TrNode_child((ans_node_ptr)DEP_FR))); \
|
||||
DepFr_next(DEP_FR) = NEXT
|
||||
|
||||
|
||||
@ -501,11 +501,11 @@ void pruning_over_tabling_data_structures(void) {
|
||||
static inline
|
||||
void abolish_incomplete_subgoals(choiceptr prune_cp) {
|
||||
#ifdef YAPOR
|
||||
if (YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), prune_cp))
|
||||
if (EQUAL_OR_YOUNGER_CP(OrFr_node(LOCAL_top_susp_or_fr), prune_cp))
|
||||
pruning_over_tabling_data_structures();
|
||||
#endif /* YAPOR */
|
||||
|
||||
if (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp)) {
|
||||
if (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp)) {
|
||||
#ifdef YAPOR
|
||||
if (PARALLEL_EXECUTION_MODE)
|
||||
pruning_over_tabling_data_structures();
|
||||
@ -514,22 +514,31 @@ void abolish_incomplete_subgoals(choiceptr prune_cp) {
|
||||
dep_fr_ptr dep_fr = LOCAL_top_dep_fr;
|
||||
LOCAL_top_dep_fr = DepFr_next(dep_fr);
|
||||
FREE_DEPENDENCY_FRAME(dep_fr);
|
||||
} while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp));
|
||||
} while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), prune_cp));
|
||||
adjust_freeze_registers();
|
||||
}
|
||||
|
||||
while (LOCAL_top_sg_fr && YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), prune_cp)) {
|
||||
while (LOCAL_top_sg_fr && EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(LOCAL_top_sg_fr), prune_cp)) {
|
||||
sg_fr_ptr sg_fr;
|
||||
ans_hash_ptr hash;
|
||||
ans_node_ptr node;
|
||||
#ifdef YAPOR
|
||||
if (PARALLEL_EXECUTION_MODE)
|
||||
pruning_over_tabling_data_structures();
|
||||
#endif /* YAPOR */
|
||||
sg_fr = LOCAL_top_sg_fr;
|
||||
LOCAL_top_sg_fr = SgFr_next(sg_fr);
|
||||
TrNode_sg_fr(SgFr_subgoal_trie(sg_fr)) = NULL;
|
||||
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
|
||||
free_answer_trie(sg_fr);
|
||||
FREE_SUBGOAL_FRAME(sg_fr);
|
||||
LOCK(SgFr_lock(sg_fr));
|
||||
hash = SgFr_hash_chain(sg_fr);
|
||||
node = TrNode_child(SgFr_answer_trie(sg_fr));
|
||||
TrNode_child(SgFr_answer_trie(sg_fr)) = NULL;
|
||||
TrNode_parent(SgFr_answer_trie(sg_fr)) = NULL;
|
||||
SgFr_state(sg_fr) = ready;
|
||||
SgFr_abolished(sg_fr)++;
|
||||
UNLOCK(SgFr_lock(sg_fr));
|
||||
free_answer_hash_chain(hash);
|
||||
if (node)
|
||||
free_answer_trie_branch(node);
|
||||
}
|
||||
|
||||
return;
|
||||
@ -634,7 +643,10 @@ susp_fr_ptr suspension_frame_to_resume(or_fr_ptr susp_or_fr) {
|
||||
while (susp_fr) {
|
||||
dep_fr = SuspFr_top_dep_fr(susp_fr);
|
||||
do {
|
||||
if (DepFr_last_ans(dep_fr) != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
|
||||
if (TrNode_child(DepFr_last_answer(dep_fr))) {
|
||||
/* ricroc - obsolete
|
||||
if (DepFr_last_answer(dep_fr) != SgFr_last_answer(DepFr_sg_fr(dep_fr))) {
|
||||
*/
|
||||
/* unconsumed answers in susp_fr */
|
||||
*susp_ptr = SuspFr_next(susp_fr);
|
||||
return susp_fr;
|
||||
@ -775,7 +787,7 @@ void CUT_validate_tg_answers(tg_sol_fr_ptr valid_solutions) {
|
||||
|
||||
while (valid_solutions) {
|
||||
first_answer = last_answer = NULL;
|
||||
sg_fr = GEN_CP_SG_FR(TgSolFr_gen_cp(valid_solutions));
|
||||
sg_fr = GEN_CP(TgSolFr_gen_cp(valid_solutions))->cp_sg_fr;
|
||||
ltt_valid_solutions = valid_solutions;
|
||||
valid_solutions = TgSolFr_next(valid_solutions);
|
||||
do {
|
||||
|
||||
@ -27,8 +27,8 @@ typedef struct subgoal_trie_node {
|
||||
#ifdef TABLE_LOCK_AT_NODE_LEVEL
|
||||
lockvar lock;
|
||||
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
|
||||
struct subgoal_trie_node *child;
|
||||
struct subgoal_trie_node *parent;
|
||||
struct subgoal_trie_node *child;
|
||||
struct subgoal_trie_node *next;
|
||||
} *sg_node_ptr;
|
||||
|
||||
@ -41,8 +41,8 @@ typedef struct answer_trie_node {
|
||||
#ifdef TABLE_LOCK_AT_NODE_LEVEL
|
||||
lockvar lock;
|
||||
#endif /* TABLE_LOCK_AT_NODE_LEVEL */
|
||||
struct answer_trie_node *child;
|
||||
struct answer_trie_node *parent;
|
||||
struct answer_trie_node *child;
|
||||
struct answer_trie_node *next;
|
||||
} *ans_node_ptr;
|
||||
|
||||
@ -50,9 +50,9 @@ typedef struct answer_trie_node {
|
||||
#define TrNode_or_arg(X) ((X)->or_arg)
|
||||
#define TrNode_entry(X) ((X)->entry)
|
||||
#define TrNode_lock(X) ((X)->lock)
|
||||
#define TrNode_sg_fr(X) ((X)->child)
|
||||
#define TrNode_child(X) ((X)->child)
|
||||
#define TrNode_parent(X) ((X)->parent)
|
||||
#define TrNode_child(X) ((X)->child)
|
||||
#define TrNode_sg_fr(X) ((X)->child)
|
||||
#define TrNode_next(X) ((X)->next)
|
||||
|
||||
|
||||
@ -102,16 +102,17 @@ typedef struct subgoal_frame {
|
||||
struct or_frame *top_or_frame_on_generator_branch;
|
||||
#endif /* YAPOR */
|
||||
choiceptr generator_choice_point;
|
||||
struct subgoal_trie_node *subgoal_trie;
|
||||
struct answer_trie_node *answer_trie;
|
||||
struct answer_trie_node *first_answer;
|
||||
struct answer_trie_node *last_answer;
|
||||
struct answer_hash *hash_chain;
|
||||
enum {
|
||||
resolving = 0,
|
||||
complete = 1,
|
||||
executable = 2
|
||||
ready = 0,
|
||||
evaluating = 1,
|
||||
complete = 2,
|
||||
executable = 3
|
||||
} state_flag;
|
||||
int abolished_operations;
|
||||
int subgoal_arity;
|
||||
struct subgoal_frame *next;
|
||||
} *sg_fr_ptr;
|
||||
@ -120,12 +121,12 @@ typedef struct subgoal_frame {
|
||||
#define SgFr_gen_worker(X) ((X)->generator_worker)
|
||||
#define SgFr_gen_top_or_fr(X) ((X)->top_or_frame_on_generator_branch)
|
||||
#define SgFr_gen_cp(X) ((X)->generator_choice_point)
|
||||
#define SgFr_subgoal_trie(X) ((X)->subgoal_trie)
|
||||
#define SgFr_answer_trie(X) ((X)->answer_trie)
|
||||
#define SgFr_first_answer(X) ((X)->first_answer)
|
||||
#define SgFr_last_answer(X) ((X)->last_answer)
|
||||
#define SgFr_hash_chain(X) ((X)->hash_chain)
|
||||
#define SgFr_state(X) ((X)->state_flag)
|
||||
#define SgFr_abolished(X) ((X)->abolished_operations)
|
||||
#define SgFr_arity(X) ((X)->subgoal_arity)
|
||||
#define SgFr_next(X) ((X)->next)
|
||||
|
||||
@ -137,14 +138,14 @@ typedef struct subgoal_frame {
|
||||
to its or-frame. It is used to find the direct dependency node for
|
||||
consumer nodes in other workers branches.
|
||||
SgFr_gen_cp: a pointer to the correspondent generator choice point.
|
||||
SgFr_subgoal_trie: a pointer to the bottom subgoal trie node.
|
||||
It is used to abolish incomplete subgoals.
|
||||
SgFr_answer_trie: a pointer to the top answer trie node.
|
||||
It is used to check for/insert new answers.
|
||||
SgFr_first_answer: a pointer to the bottom answer trie node of the first available answer.
|
||||
SgFr_last_answer: a pointer to the bottom answer trie node of the last available answer.
|
||||
SgFr_hash_chain: a pointer to the first answer_hash struct for the subgoal in hand.
|
||||
SgFr_state: a flag that indicates the subgoal state
|
||||
SgFr_state: a flag that indicates the subgoal state.
|
||||
SgFr_abolished the number of times the subgoal was abolished.
|
||||
SgFr_arity the arity of the subgoal.
|
||||
SgFr_next: a pointer to chain between subgoal frames.
|
||||
** ------------------------------------------------------------------------------------------- */
|
||||
|
||||
@ -166,7 +167,6 @@ typedef struct dependency_frame {
|
||||
choiceptr backchain_choice_point;
|
||||
choiceptr leader_choice_point;
|
||||
choiceptr consumer_choice_point;
|
||||
struct subgoal_frame *subgoal_frame;
|
||||
struct answer_trie_node *last_consumed_answer;
|
||||
struct dependency_frame *next;
|
||||
} *dep_fr_ptr;
|
||||
@ -178,8 +178,7 @@ typedef struct dependency_frame {
|
||||
#define DepFr_backchain_cp(X) ((X)->backchain_choice_point)
|
||||
#define DepFr_leader_cp(X) ((X)->leader_choice_point)
|
||||
#define DepFr_cons_cp(X) ((X)->consumer_choice_point)
|
||||
#define DepFr_sg_fr(X) ((X)->subgoal_frame)
|
||||
#define DepFr_last_ans(X) ((X)->last_consumed_answer)
|
||||
#define DepFr_last_answer(X) ((X)->last_consumed_answer)
|
||||
#define DepFr_next(X) ((X)->next)
|
||||
|
||||
/* ---------------------------------------------------------------------------------------------------- **
|
||||
@ -197,8 +196,7 @@ typedef struct dependency_frame {
|
||||
we perform the last backtracking through answers operation.
|
||||
DepFr_leader_cp: a pointer to the leader choice point.
|
||||
DepFr_cons_cp: a pointer to the correspondent consumer choice point.
|
||||
DepFr_sg_fr: a pointer to the correspondent subgoal frame.
|
||||
DepFr_last_ans: a pointer to the last consumed answer.
|
||||
DepFr_last_answer: a pointer to the last consumed answer.
|
||||
DepFr_next: a pointer to chain between dependency frames.
|
||||
** ---------------------------------------------------------------------------------------------------- */
|
||||
|
||||
@ -238,54 +236,17 @@ typedef struct suspension_frame {
|
||||
|
||||
|
||||
|
||||
/* ----------------------------- **
|
||||
** Struct generator_cp **
|
||||
** ----------------------------- */
|
||||
/* ---------------------------------------------------------- **
|
||||
** Structs generator_choicept and consumer_choicept **
|
||||
** ---------------------------------------------------------- */
|
||||
|
||||
typedef struct generator_choice_point {
|
||||
/* common choicepoints fields */
|
||||
tr_fr_ptr gcp_tr;
|
||||
CELL *gcp_h;
|
||||
struct choicept *gcp_b;
|
||||
#ifdef DEPTH_LIMIT
|
||||
CELL gcp_depth;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
yamop *gcp_cp;
|
||||
#ifdef YAPOR
|
||||
struct or_frame *gcp_or_fr;
|
||||
#endif /* YAPOR */
|
||||
yamop *gcp_ap;
|
||||
CELL *gcp_env;
|
||||
struct generator_choicept {
|
||||
struct choicept cp;
|
||||
struct dependency_frame *cp_dep_fr; /* NULL if batched scheduling */
|
||||
struct subgoal_frame *cp_sg_fr;
|
||||
};
|
||||
|
||||
/* specific generator choicepoint fields */
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
struct subgoal_frame *gcp_sg_fr;
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
struct dependency_frame *gcp_dep_fr;
|
||||
#endif /* TABLING_SCHEDULING */
|
||||
} *gen_cp_ptr;
|
||||
|
||||
|
||||
|
||||
/* ---------------------------- **
|
||||
** Struct consumer_cp **
|
||||
** ---------------------------- */
|
||||
|
||||
typedef struct consumer_choice_point {
|
||||
/* common choicepoints fields */
|
||||
tr_fr_ptr ccp_tr;
|
||||
CELL *ccp_h;
|
||||
struct choicept *ccp_b;
|
||||
#ifdef DEPTH_LIMIT
|
||||
CELL ccp_depth;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
yamop *ccp_cp;
|
||||
#ifdef YAPOR
|
||||
struct or_frame *ccp_or_fr;
|
||||
#endif /* YAPOR */
|
||||
yamop *ccp_ap;
|
||||
CELL *ccp_env;
|
||||
|
||||
/* specific consumer choicepoint fields */
|
||||
struct dependency_frame *ccp_dep_fr;
|
||||
} *cons_cp_ptr;
|
||||
struct consumer_choicept {
|
||||
struct choicept cp;
|
||||
struct dependency_frame *cp_dep_fr;
|
||||
};
|
||||
|
||||
@ -35,7 +35,7 @@ void public_completion(void) {
|
||||
sg_fr_ptr top_sg_fr;
|
||||
|
||||
/* complete subgoals */
|
||||
top_sg_fr = SgFr_next(GEN_CP_SG_FR(LOCAL_top_cp));
|
||||
top_sg_fr = SgFr_next(GEN_CP(LOCAL_top_cp)->cp_sg_fr);
|
||||
do {
|
||||
mark_as_completed(LOCAL_top_sg_fr);
|
||||
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
|
||||
@ -293,9 +293,9 @@ void resume_suspension_frame(susp_fr_ptr resume_fr, or_fr_ptr top_or_fr) {
|
||||
SuspFr_trail_size(resume_fr));
|
||||
|
||||
#ifdef OPTYAP_ERRORS
|
||||
if (CONS_CP(DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)))->ccp_h != SuspFr_global_reg(resume_fr) + SuspFr_global_size(resume_fr))
|
||||
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_h != SuspFr_global_reg(resume_fr) + SuspFr_global_size(resume_fr))
|
||||
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_h != SuspFr_global_reg + SuspFr_global_size (resume_suspension_frame)");
|
||||
if (CONS_CP(DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)))->ccp_tr != SuspFr_trail_reg(resume_fr) + SuspFr_trail_size(resume_fr))
|
||||
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr))->cp_tr != SuspFr_trail_reg(resume_fr) + SuspFr_trail_size(resume_fr))
|
||||
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr)->cp_tr != SuspFr_trail_reg + SuspFr_trail_size (resume_suspension_frame)");
|
||||
if (DepFr_cons_cp(SuspFr_top_dep_fr(resume_fr)) != SuspFr_local_reg(resume_fr))
|
||||
OPTYAP_ERROR_MESSAGE("DepFr_cons_cp(SuspFr_top_dep_fr) != SuspFr_local_reg (resume_suspension_frame)");
|
||||
@ -358,14 +358,14 @@ void complete_suspension_branch(susp_fr_ptr susp_fr, choiceptr top_cp, or_fr_ptr
|
||||
aux_sg_fr = SuspFr_top_sg_fr(susp_fr);
|
||||
if (DepFr_leader_dep_is_on_stack(aux_dep_fr)) {
|
||||
while (aux_sg_fr &&
|
||||
! SgFr_state(aux_sg_fr) &&
|
||||
SgFr_state(aux_sg_fr) == evaluating &&
|
||||
EQUAL_OR_YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) {
|
||||
mark_as_completed(aux_sg_fr);
|
||||
aux_sg_fr = SgFr_next(aux_sg_fr);
|
||||
}
|
||||
} else {
|
||||
while (aux_sg_fr &&
|
||||
! SgFr_state(aux_sg_fr) &&
|
||||
SgFr_state(aux_sg_fr) == evaluating &&
|
||||
YOUNGER_CP(SgFr_gen_cp(aux_sg_fr), top_cp)) {
|
||||
mark_as_completed(aux_sg_fr);
|
||||
aux_sg_fr = SgFr_next(aux_sg_fr);
|
||||
|
||||
@ -20,7 +20,6 @@
|
||||
|
||||
static int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth);
|
||||
static int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth);
|
||||
static void free_answer_trie_branch(ans_node_ptr node);
|
||||
#ifdef YAPOR
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr node);
|
||||
@ -652,10 +651,11 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
** Global functions **
|
||||
** -------------------------- */
|
||||
|
||||
sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
|
||||
sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
|
||||
int i, j, count_vars;
|
||||
CELL *stack_vars, *stack_terms_top, *stack_terms_base, *stack_terms;
|
||||
sg_node_ptr current_sg_node;
|
||||
sg_fr_ptr sg_fr;
|
||||
|
||||
count_vars = 0;
|
||||
stack_vars = *Yaddr;
|
||||
@ -717,7 +717,25 @@ sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
|
||||
RESET_VARIABLE(t);
|
||||
}
|
||||
|
||||
return current_sg_node;
|
||||
#if defined(TABLE_LOCK_AT_NODE_LEVEL)
|
||||
LOCK(TrNode_lock(current_sg_node));
|
||||
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
|
||||
LOCK_TABLE(current_sg_node);
|
||||
#endif /* TABLE_LOCK_LEVEL */
|
||||
if (TrNode_sg_fr(current_sg_node) == NULL) {
|
||||
/* new tabled subgoal */
|
||||
new_subgoal_frame(sg_fr, arity);
|
||||
TrNode_sg_fr(current_sg_node) = (sg_node_ptr) sg_fr;
|
||||
} else {
|
||||
sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_sg_node);
|
||||
}
|
||||
#if defined(TABLE_LOCK_AT_NODE_LEVEL)
|
||||
UNLOCK(TrNode_lock(current_sg_node));
|
||||
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
|
||||
UNLOCK_TABLE(current_sg_node);
|
||||
#endif /* TABLE_LOCK_LEVEL */
|
||||
|
||||
return sg_fr;
|
||||
}
|
||||
|
||||
|
||||
@ -936,11 +954,7 @@ void private_completion(sg_fr_ptr sg_fr) {
|
||||
LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr);
|
||||
|
||||
/* release dependency frames */
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) {
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) {
|
||||
#endif /* TABLING_SCHEDULING */
|
||||
while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { /* never equal if batched scheduling */
|
||||
dep_fr_ptr dep_fr = DepFr_next(LOCAL_top_dep_fr);
|
||||
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
|
||||
LOCAL_top_dep_fr = dep_fr;
|
||||
@ -981,12 +995,14 @@ void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) {
|
||||
free_subgoal_trie_branch(TrNode_child(node), missing_nodes);
|
||||
} else {
|
||||
sg_fr_ptr sg_fr;
|
||||
ans_node_ptr ans_node;
|
||||
sg_fr = (sg_fr_ptr) TrNode_sg_fr(node);
|
||||
if (sg_fr) {
|
||||
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
|
||||
free_answer_trie(sg_fr);
|
||||
FREE_SUBGOAL_FRAME(sg_fr);
|
||||
}
|
||||
free_answer_hash_chain(SgFr_hash_chain(sg_fr));
|
||||
ans_node = SgFr_answer_trie(sg_fr);
|
||||
if (TrNode_child(ans_node))
|
||||
free_answer_trie_branch(TrNode_child(ans_node));
|
||||
FREE_ANSWER_TRIE_NODE(ans_node);
|
||||
FREE_SUBGOAL_FRAME(sg_fr);
|
||||
}
|
||||
|
||||
FREE_SUBGOAL_TRIE_NODE(node);
|
||||
@ -994,11 +1010,15 @@ void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) {
|
||||
}
|
||||
|
||||
|
||||
void free_answer_trie(sg_fr_ptr sg_fr) {
|
||||
ans_node_ptr node;
|
||||
node = SgFr_answer_trie(sg_fr);
|
||||
if (TrNode_child(node))
|
||||
void free_answer_trie_branch(ans_node_ptr node) {
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
if (TrNode_child(node) && ! IS_ANSWER_LEAF_NODE(node))
|
||||
#else
|
||||
if (! IS_ANSWER_LEAF_NODE(node))
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
free_answer_trie_branch(TrNode_child(node));
|
||||
if (TrNode_next(node))
|
||||
free_answer_trie_branch(TrNode_next(node));
|
||||
FREE_ANSWER_TRIE_NODE(node);
|
||||
return;
|
||||
}
|
||||
@ -1123,12 +1143,12 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
|
||||
} else if (depth > TrStat_sg_max_depth) {
|
||||
TrStat_sg_max_depth = depth;
|
||||
}
|
||||
if (sg_node == NULL) {
|
||||
if (SgFr_state((sg_fr_ptr)sg_node) == ready) {
|
||||
TrStat_subgoals_abolished++;
|
||||
SHOW_TRIE("%s.\n ABOLISHED\n", str);
|
||||
return TRUE;
|
||||
}
|
||||
if (! SgFr_state((sg_fr_ptr)sg_node)) {
|
||||
if (SgFr_state((sg_fr_ptr)sg_node) == evaluating) {
|
||||
SHOW_INFO("%s. --> TRIE ERROR: subgoal not completed !!!\n", str);
|
||||
return FALSE;
|
||||
}
|
||||
@ -1438,21 +1458,6 @@ int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
void free_answer_trie_branch(ans_node_ptr node) {
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
if (TrNode_child(node) && ! IS_ANSWER_LEAF_NODE(node))
|
||||
#else
|
||||
if (! IS_ANSWER_LEAF_NODE(node))
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
free_answer_trie_branch(TrNode_child(node));
|
||||
if (TrNode_next(node))
|
||||
free_answer_trie_branch(TrNode_next(node));
|
||||
FREE_ANSWER_TRIE_NODE(node);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
#ifdef YAPOR
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
static
|
||||
@ -1512,7 +1517,7 @@ int update_answer_trie_branch(ans_node_ptr node) {
|
||||
ltt = 1;
|
||||
}
|
||||
TrNode_or_arg(node) = ltt;
|
||||
TrNode_instr(node) = Yap__opcode(TrNode_instr(node));
|
||||
TrNode_instr(node) = Yap_opcode(TrNode_instr(node));
|
||||
return ltt;
|
||||
}
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
|
||||
@ -65,6 +65,7 @@
|
||||
YENV = (CELL *) (NORM_CP(YENV) - 1); \
|
||||
cp = NORM_CP(YENV); \
|
||||
HBREG = H; \
|
||||
store_yaam_reg_cpdepth(cp); \
|
||||
cp->cp_tr = TR; \
|
||||
cp->cp_h = H; \
|
||||
cp->cp_b = B; \
|
||||
@ -79,6 +80,7 @@
|
||||
|
||||
#define restore_trie_choice_point(AP) \
|
||||
H = HBREG = PROTECT_FROZEN_H(B); \
|
||||
restore_yaam_reg_cpdepth(B); \
|
||||
CPREG = B->cp_cp; \
|
||||
ENV = B->cp_env; \
|
||||
YAPOR_update_alternative(PREG, (yamop *) AP) \
|
||||
@ -90,6 +92,7 @@
|
||||
#define pop_trie_choice_point() \
|
||||
YENV = (CELL *) PROTECT_FROZEN_B((B+1)); \
|
||||
H = PROTECT_FROZEN_H(B); \
|
||||
pop_yaam_reg_cpdepth(B); \
|
||||
CPREG = B->cp_cp; \
|
||||
TABLING_close_alt(B); \
|
||||
ENV = B->cp_env; \
|
||||
|
||||
3
README
3
README
@ -155,8 +155,7 @@ useful for normal users.
|
||||
o --enable-parallelism={env-copy,sba,a-cow} allows or-parallelism
|
||||
supported by one of these three forms. This is still highly experimental.
|
||||
|
||||
o --enable-tabling={local,batched} allows one of the two forms of
|
||||
tabling. This is still experimental.
|
||||
o --enable-tabling=yes allows tabling support. This is still experimental.
|
||||
|
||||
2.3 Porting Yap
|
||||
|
||||
|
||||
14
configure
vendored
14
configure
vendored
@ -850,7 +850,7 @@ Optional Features:
|
||||
--enable-depth-limit support depth-bound computation
|
||||
--enable-or-parallelism support or-parallelism as: env-copy,sba,a-cow
|
||||
--enable-low-level-tracer support support for procedure-call tracing
|
||||
--enable-tabling support tabling as: batched,local
|
||||
--enable-tabling support tabling
|
||||
--enable-threads support system threads
|
||||
--pthread-locking use pthread locking primitives for internal locking (requires threads)
|
||||
--enable-max-performance try using the best flags for specific architecture
|
||||
@ -5890,14 +5890,10 @@ case "$orparallelism" in
|
||||
;;
|
||||
esac
|
||||
|
||||
case "$tabling" in
|
||||
local)
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING_LOCAL_SCHEDULING=1"
|
||||
;;
|
||||
yes|batched)
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING_BATCHED_SCHEDULING=1"
|
||||
;;
|
||||
esac
|
||||
if test "$tabling" = "yes"
|
||||
then
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING=1"
|
||||
fi
|
||||
|
||||
echo "$as_me:$LINENO: checking for ANSI C header files" >&5
|
||||
echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
|
||||
|
||||
14
configure.in
14
configure.in
@ -34,7 +34,7 @@ AC_ARG_ENABLE(low-level-tracer,
|
||||
[ --enable-low-level-tracer support support for procedure-call tracing ],
|
||||
lowleveltracer="$enableval", lowleveltracer=no)
|
||||
AC_ARG_ENABLE(tabling,
|
||||
[ --enable-tabling support tabling as: batched,local ],
|
||||
[ --enable-tabling support tabling ],
|
||||
tabling="$enableval", tabling=no)
|
||||
AC_ARG_ENABLE(threads,
|
||||
[ --enable-threads support system threads ],
|
||||
@ -721,14 +721,10 @@ case "$orparallelism" in
|
||||
;;
|
||||
esac
|
||||
|
||||
case "$tabling" in
|
||||
local)
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING_LOCAL_SCHEDULING=1"
|
||||
;;
|
||||
yes|batched)
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING_BATCHED_SCHEDULING=1"
|
||||
;;
|
||||
esac
|
||||
if test "$tabling" = "yes"
|
||||
then
|
||||
YAP_EXTRAS="$YAP_EXTRAS -DTABLING=1"
|
||||
fi
|
||||
|
||||
dnl Checks for header files.
|
||||
AC_HEADER_STDC
|
||||
|
||||
@ -565,8 +565,8 @@ useful for normal users.
|
||||
support High Throughput Computing (HTC) on large collections of
|
||||
distributively owned computing resources.
|
||||
|
||||
@item @code{--enable-tabling=@{local,batched@}} allows one of the two
|
||||
forms of tabling. This option is still experimental.
|
||||
@item @code{--enable-tabling=yes} allows tabling support. This option
|
||||
is still experimental.
|
||||
|
||||
@item @code{--enable-parallelism=@{env-copy,sba,a-cow@}} allows
|
||||
or-parallelism supported by one of these three forms. This option is
|
||||
|
||||
26
m4/Yap.h.m4
26
m4/Yap.h.m4
@ -10,7 +10,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h.m4,v 1.81 2005-03-14 17:02:40 vsc Exp $ *
|
||||
* version: $Id: Yap.h.m4,v 1.82 2005-04-07 17:56:00 ricroc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -29,18 +29,6 @@
|
||||
|
||||
#define MULTI_ASSIGNMENT_VARIABLES 1
|
||||
|
||||
#if defined(TABLING)
|
||||
#error Do not explicitly define TABLING
|
||||
#endif /* TABLING */
|
||||
|
||||
#if defined(TABLING_BATCHED_SCHEDULING) && defined(TABLING_LOCAL_SCHEDULING)
|
||||
#error Do not define multiple tabling scheduling strategies
|
||||
#endif /* TABLING_BATCHED_SCHEDULING || TABLING_LOCAL_SCHEDULING */
|
||||
|
||||
#if defined(TABLING_BATCHED_SCHEDULING) || defined(TABLING_LOCAL_SCHEDULING)
|
||||
#define TABLING 1
|
||||
#endif /* TABLING_BATCHED_SCHEDULING || TABLING_LOCAL_SCHEDULING */
|
||||
|
||||
#if defined(YAPOR)
|
||||
#error Do not explicitly define YAPOR
|
||||
#endif /* YAPOR */
|
||||
@ -533,7 +521,8 @@ typedef enum {
|
||||
HALT_AFTER_CONSULT_FLAG = 15,
|
||||
FAST_BOOT_FLAG = 16,
|
||||
STACK_DUMP_ON_ERROR_FLAG = 17,
|
||||
INDEXING_MODE_FLAG = 18
|
||||
INDEXING_MODE_FLAG = 18,
|
||||
TABLING_MODE_FLAG = 19
|
||||
} yap_flags;
|
||||
|
||||
#define STRING_AS_CHARS 0
|
||||
@ -554,6 +543,13 @@ typedef enum {
|
||||
INDEX_MODE_MAX = 4
|
||||
} index_mode_options;
|
||||
|
||||
typedef enum {
|
||||
TABLING_MODE_OFF = 0,
|
||||
TABLING_MODE_BATCHED = 1,
|
||||
TABLING_MODE_LOCAL = 2,
|
||||
TABLING_MODE_DEFAULT = 3
|
||||
} tabling_mode_options;
|
||||
|
||||
typedef enum {
|
||||
YAP_CREEP_SIGNAL = 0x1, /* received a creep */
|
||||
YAP_WAKEUP_SIGNAL = 0x2, /* goals to wake up */
|
||||
@ -574,7 +570,7 @@ typedef enum {
|
||||
YAP_DELAY_CREEP_SIGNAL= 0x10000 /* received a creep but should not do it */
|
||||
} yap_signals;
|
||||
|
||||
#define NUMBER_OF_YAP_FLAGS INDEXING_MODE_FLAG+1
|
||||
#define NUMBER_OF_YAP_FLAGS TABLING_MODE_FLAG + 1
|
||||
|
||||
/************************ prototypes **********************************/
|
||||
|
||||
|
||||
@ -162,34 +162,35 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
|
||||
CodeOfPred holds the address of the correspondent C-function.
|
||||
*/
|
||||
typedef enum {
|
||||
MegaClausePredFlag=0x80000000L, /* predicate is implemented as a mega-clause */
|
||||
ThreadLocalPredFlag=0x40000000L, /* local to a thread */
|
||||
MultiFileFlag = 0x20000000L, /* is multi-file */
|
||||
UserCPredFlag = 0x10000000L, /* CPred defined by the user */
|
||||
LogUpdatePredFlag= 0x08000000L, /* dynamic predicate with log. upd. sem.*/
|
||||
InUsePredFlag = 0x04000000L, /* count calls to pred */
|
||||
CountPredFlag = 0x02000000L, /* count calls to pred */
|
||||
HiddenPredFlag = 0x01000000L, /* invisible predicate */
|
||||
CArgsPredFlag = 0x00800000L, /* SWI-like C-interface pred. */
|
||||
SourcePredFlag = 0x00400000L, /* static predicate with source declaration */
|
||||
MetaPredFlag = 0x00200000L, /* predicate subject to a meta declaration */
|
||||
SyncPredFlag = 0x00100000L, /* has to synch before it can execute*/
|
||||
NumberDBPredFlag = 0x00080000L, /* entry for a number key */
|
||||
AtomDBPredFlag = 0x00040000L, /* entry for an atom key */
|
||||
GoalExPredFlag = 0x00020000L, /* predicate that is called by goal_expand */
|
||||
TestPredFlag = 0x00010000L, /* is a test (optim. comit) */
|
||||
AsmPredFlag = 0x00008000L, /* inline */
|
||||
StandardPredFlag= 0x00004000L, /* system predicate */
|
||||
DynamicPredFlag= 0x00002000L, /* dynamic predicate */
|
||||
CPredFlag = 0x00001000L, /* written in C */
|
||||
SafePredFlag = 0x00000800L, /* does not alter arguments */
|
||||
CompiledPredFlag= 0x00000400L, /* is static */
|
||||
IndexedPredFlag= 0x00000200L, /* has indexing code */
|
||||
SpiedPredFlag = 0x00000100L, /* is a spy point */
|
||||
BinaryTestPredFlag=0x00000080L, /* test predicate. */
|
||||
TabledPredFlag = 0x00000040L, /* is tabled */
|
||||
SequentialPredFlag=0x00000020L, /* may not create par. choice points!*/
|
||||
ProfiledPredFlag = 0x00000010L /* pred is being profiled */
|
||||
MegaClausePredFlag = 0x80000000L, /* predicate is implemented as a mega-clause */
|
||||
ThreadLocalPredFlag = 0x40000000L, /* local to a thread */
|
||||
MultiFileFlag = 0x20000000L, /* is multi-file */
|
||||
UserCPredFlag = 0x10000000L, /* CPred defined by the user */
|
||||
LogUpdatePredFlag= 0x08000000L, /* dynamic predicate with log. upd. sem. */
|
||||
InUsePredFlag = 0x04000000L, /* count calls to pred */
|
||||
CountPredFlag = 0x02000000L, /* count calls to pred */
|
||||
HiddenPredFlag = 0x01000000L, /* invisible predicate */
|
||||
CArgsPredFlag = 0x00800000L, /* SWI-like C-interface pred. */
|
||||
SourcePredFlag = 0x00400000L, /* static predicate with source declaration */
|
||||
MetaPredFlag = 0x00200000L, /* predicate subject to a meta declaration */
|
||||
SyncPredFlag = 0x00100000L, /* has to synch before it can execute*/
|
||||
NumberDBPredFlag = 0x00080000L, /* entry for a number key */
|
||||
AtomDBPredFlag = 0x00040000L, /* entry for an atom key */
|
||||
GoalExPredFlag = 0x00020000L, /* predicate that is called by goal_expand */
|
||||
TestPredFlag = 0x00010000L, /* is a test (optim. comit) */
|
||||
AsmPredFlag = 0x00008000L, /* inline */
|
||||
StandardPredFlag = 0x00004000L, /* system predicate */
|
||||
DynamicPredFlag = 0x00002000L, /* dynamic predicate */
|
||||
CPredFlag = 0x00001000L, /* written in C */
|
||||
SafePredFlag = 0x00000800L, /* does not alter arguments */
|
||||
CompiledPredFlag = 0x00000400L, /* is static */
|
||||
IndexedPredFlag = 0x00000200L, /* has indexing code */
|
||||
SpiedPredFlag = 0x00000100L, /* is a spy point */
|
||||
BinaryTestPredFlag = 0x00000080L, /* test predicate */
|
||||
TabledPredFlag = 0x00000040L, /* is tabled */
|
||||
SequentialPredFlag = 0x00000020L, /* may not create parallel choice points! */
|
||||
ProfiledPredFlag = 0x00000010L, /* pred is being profiled */
|
||||
LocalSchedPredFlag = 0x00000008L /* use local scheduling as default for tabling */
|
||||
} pred_flag;
|
||||
|
||||
/* profile data */
|
||||
|
||||
@ -228,6 +228,25 @@ yap_flag(home,X) :-
|
||||
'$transl_to_index_mode'(3, on). % default is multi argument indexing
|
||||
'$transl_to_index_mode'(4, max).
|
||||
|
||||
% tabling schedulinhg mode
|
||||
yap_flag(tabling_mode,X) :- var(X),
|
||||
'$access_yap_flags'(19, X1),
|
||||
'$transl_to_tabling_mode'(X1,X), !.
|
||||
yap_flag(tabling_mode,X) :-
|
||||
'$access_yap_flags'(19, X1),
|
||||
'$transl_to_tabling_mode'(X1,off), !,
|
||||
'$do_error'(permission_error(modify,flag,tabling_mode),yap_flag(tabling_mode,X)).
|
||||
yap_flag(tabling_mode,X) :- X \= off,
|
||||
'$transl_to_tabling_mode'(X1,X), !,
|
||||
'$set_yap_flags'(19,X1).
|
||||
yap_flag(tabling_mode,X) :-
|
||||
'$do_error'(domain_error(flag_value,tabling_mode+X),yap_flag(tabling_mode,X)).
|
||||
|
||||
% should match definitions in Yap.h.m4
|
||||
'$transl_to_tabling_mode'(0,off).
|
||||
'$transl_to_tabling_mode'(1,batched).
|
||||
'$transl_to_tabling_mode'(2,local).
|
||||
'$transl_to_tabling_mode'(3,default).
|
||||
|
||||
yap_flag(informational_messages,X) :- var(X), !,
|
||||
get_value('$verbose',X).
|
||||
@ -591,6 +610,7 @@ yap_flag(host_type,X) :-
|
||||
V = home ;
|
||||
V = host_type ;
|
||||
V = index ;
|
||||
V = tabling ;
|
||||
V = informational_messages ;
|
||||
V = integer_rounding_function ;
|
||||
V = language ;
|
||||
|
||||
@ -11,8 +11,12 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2005-02-21 16:50:21 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-04-07 17:55:05 $,$Author: ricroc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.61 2005/02/21 16:50:21 vsc
|
||||
* amd64 fixes
|
||||
* library fixes
|
||||
*
|
||||
* Revision 1.60 2005/01/28 23:14:41 vsc
|
||||
* move to Yap-4.5.7
|
||||
* Fix clause size
|
||||
@ -481,6 +485,9 @@ print_message(Level, Mss) :-
|
||||
'$output_error_message'(domain_error(write_option,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(table,P), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: non-tabled procedure ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(existence_error(array,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
|
||||
[W,F]).
|
||||
@ -592,6 +599,9 @@ print_message(Level, Mss) :-
|
||||
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,table,P), _) :-
|
||||
format(user_error,'% PERMISSION ERROR- cannot table procedure ~w~n',
|
||||
[P]).
|
||||
'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
|
||||
format(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
|
||||
[Who,Mod]).
|
||||
|
||||
115
pl/tabling.yap
115
pl/tabling.yap
@ -17,69 +17,82 @@
|
||||
|
||||
:- meta_predicate table(:), abolish_trie(:), show_trie(:), show_trie_stats(:).
|
||||
|
||||
table(M:P) :- !, '$table'(P,M).
|
||||
table(P) :- '$current_module'(M), '$table'(P,M).
|
||||
|
||||
'$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table).
|
||||
|
||||
table(P) :- '$current_module'(M), '$table'(P,M).
|
||||
|
||||
'$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table(M:P)).
|
||||
'$table'(M:P,_) :- !, '$table'(P,M).
|
||||
'$table'([],_) :- !.
|
||||
'$table'([H|T],M) :- !, '$table'(H,M), '$table'(T,M).
|
||||
'$table'((P1,P2),M) :- !, '$table'(P1,M), '$table'(P2,M).
|
||||
'$table'(P/N,M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$declare_tabled'(T,M).
|
||||
'$table'(P,M) :- '$do_error'(type_error(callable,P),table).
|
||||
'$table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$declare_tabled'(T,M).
|
||||
'$table'(P,M) :- '$do_error'(type_error(callable,P),table(M:P)).
|
||||
|
||||
'$declare_tabled'(T,M) :- '$undefined'(T,M), !, '$do_table'(T,M).
|
||||
'$declare_tabled'(T,M) :- '$flags'(T,M,F,F),
|
||||
X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T,M).
|
||||
'$declare_tabled'(T,M) :- functor(T,A,N),
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(M:A/N)).
|
||||
'$declare_tabled'(T,M) :- '$flags'(T,M,F,F), F /\ 0x1991F880 =:= 0, !, '$do_table'(T,M).
|
||||
'$declare_tabled'(T,M) :- functor(T,A,N), '$do_error'(permission_error(modify,table,M:A/N),table(M:A/N)).
|
||||
|
||||
|
||||
|
||||
tabling_mode(P,S) :- '$current_module'(M), '$tabling_mode'(P,M,S).
|
||||
|
||||
'$tabling_mode'(P,M,S) :- var(P), !, '$do_error'(instantiation_error,tabling_mode(M:P,S)).
|
||||
'$tabling_mode'(M:P,_,S) :- !, '$tabling_mode'(P,M,S).
|
||||
'$tabling_mode'([],_,_) :- !.
|
||||
'$tabling_mode'([H|T],M,S) :- !, '$tabling_mode'(H,M,S), '$tabling_mode'(T,M,S).
|
||||
'$tabling_mode'((P1,P2),M,S) :- !, '$tabling_mode'(P1,M,S), '$tabling_mode'(P2,M,S).
|
||||
'$tabling_mode'(A/N,M,S) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(F /\ 0x000040 =\= 0, !, '$set_tabling_mode'(T,M,S)
|
||||
;
|
||||
'$do_error'(domain_error(table,M:A/N),tabling_mode(M:A/N,S))).
|
||||
'$tabling_mode'(P,M,S) :- '$do_error'(type_error(callable,P),tabling_mode(M:P,S)).
|
||||
|
||||
'$set_tabling_mode'(T,M,S) :- var(S), !, '$do_tabling_mode'(T,M,S).
|
||||
'$set_tabling_mode'(T,M,S) :- (S = local ; S = batched), !, '$do_tabling_mode'(T,M,S).
|
||||
'$set_tabling_mode'(T,M,S) :- functor(T,A,N), '$do_error'(domain_error(flag_value,tabling_mode+S),tabling_mode(M:A/N,S)).
|
||||
|
||||
|
||||
|
||||
abolish_trie(M:P) :- !, '$abolish_trie'(P,M).
|
||||
abolish_trie(P) :- '$current_module'(M), '$abolish_trie'(P,M).
|
||||
|
||||
'$abolish_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_trie).
|
||||
'$abolish_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_trie(M:P)).
|
||||
'$abolish_trie'(M:P,_) :- !, '$abolish_trie'(P,M).
|
||||
'$abolish_trie'([],_) :- !.
|
||||
'$abolish_trie'([H|T],M) :- !, '$abolish_trie'(H,M), '$abolish_trie'(T,M).
|
||||
'$abolish_trie'((P1,P2),M) :- !, '$abolish_trie'(P1,M), '$abolish_trie'(P2,M).
|
||||
'$abolish_trie'(P/N,M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_abolish_trie'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$abolish_trie'(P,_) :- '$do_error'(type_error(callable,P),abolish_trie).
|
||||
'$abolish_trie'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(F /\ 0x000040 =\= 0, !, '$do_abolish_trie'(T,M)
|
||||
;
|
||||
'$do_error'(domain_error(table,M:A/N),abolish_trie(M:A/N))).
|
||||
'$abolish_trie'(P,M) :- '$do_error'(type_error(callable,P),abolish_trie(M:P)).
|
||||
|
||||
|
||||
|
||||
show_trie(M:P) :- !, '$show_trie'(P,M).
|
||||
show_trie(P) :- '$current_module'(M), '$show_trie'(P,M).
|
||||
|
||||
'$show_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie).
|
||||
'$show_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie(M:P)).
|
||||
'$show_trie'(M:P,_) :- !, '$show_trie'(P,M).
|
||||
'$show_trie'([],_) :- !.
|
||||
'$show_trie'([H|T],M) :- !, '$show_trie'(H,M), '$show_trie'(T,M).
|
||||
'$show_trie'((P1,P2),M) :- !, '$show_trie'(P1,M), '$show_trie'(P2,M).
|
||||
'$show_trie'(P/N, M) :- integer(N), atom(P), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_show_trie'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$show_trie'(P,_) :- '$do_error'(type_error(callable,P),show_trie).
|
||||
'$show_trie'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(F /\ 0x000040 =\= 0, !, '$do_show_trie'(T,M)
|
||||
;
|
||||
'$do_error'(domain_error(table,M:A/N),show_trie(M:A/N))).
|
||||
'$show_trie'(P,M) :- '$do_error'(type_error(callable,P),show_trie(M:P)).
|
||||
|
||||
show_trie_stats(M:P) :- !,'$show_trie_stats'(P,M).
|
||||
show_trie_stats(P) :- '$current_module'(M), '$show_trie_stats'(P,M).
|
||||
|
||||
'$show_trie_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie_stats).
|
||||
|
||||
show_trie_stats(P) :- '$current_module'(M), '$show_trie_stats'(P,M).
|
||||
|
||||
'$show_trie_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie_stats(M:P)).
|
||||
'$show_trie_stats'(M:P,_) :- !, '$show_trie_stats'(P,M).
|
||||
'$show_trie_stats'([],_) :- !.
|
||||
'$show_trie_stats'([H|T],M) :- !, '$show_trie_stats'(H,M), '$show_trie_stats'(T,M).
|
||||
'$show_trie_stats'((P1,P2),M) :- !, '$show_trie_stats'(P1,M), '$show_trie_stats'(P2,M).
|
||||
'$show_trie_stats'(P/N,M) :- atom(P), integer(N), !,
|
||||
functor(T,P,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 0x000040, X =\= 0, !, '$do_show_trie_stats'(T,M)
|
||||
;
|
||||
write(user_error, '[ PERMISSION ERROR- '),
|
||||
write(user_error, M:P/N),
|
||||
write(user_error, ' is not tabled ]'),
|
||||
nl(user_error), fail
|
||||
).
|
||||
'$show_trie_stats'(P,_) :- '$do_error'(type_error(callable,P),show_trie_stats).
|
||||
|
||||
'$show_trie_stats'(A/N,M) :- atom(A), integer(N), !, functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(F /\ 0x000040 =\= 0, !, '$do_show_trie_stats'(T,M)
|
||||
;
|
||||
'$do_error'(domain_error(table,M:A/N),show_trie_stats(M:A/N))).
|
||||
'$show_trie_stats'(P,M) :- '$do_error'(type_error(callable,P),show_trie_stats(M:P)).
|
||||
|
||||
Reference in New Issue
Block a user