fixes to handle expansion of dyn amic predicates more efficiently.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1568 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
1edb3a8115
commit
8812310636
@ -1559,10 +1559,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
while (trail_base < trail_ptr) {
|
||||
register CELL trail_cell;
|
||||
|
||||
if (trail_base == ((CELL *)0x204bc000)+0x320d) {
|
||||
extern int jmp_deb();
|
||||
jmp_deb(1);
|
||||
}
|
||||
trail_cell = TrailTerm(trail_base);
|
||||
|
||||
if (IsVarTerm(trail_cell)) {
|
||||
|
107
C/index.c
107
C/index.c
@ -11,8 +11,11 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2006-03-20 19:51:43 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-03-21 15:06:35 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.154 2006/03/20 19:51:43 vsc
|
||||
* fix indexing and tabling bugs
|
||||
*
|
||||
* Revision 1.153 2006/02/22 11:55:36 vsc
|
||||
* indexing code would get confused about size of float/1, db_reference1.
|
||||
*
|
||||
@ -4832,6 +4835,67 @@ count_clauses_left(yamop *cl, PredEntry *ap)
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
We have jumped across indexing code. Check if we jumped within the current
|
||||
indexing block, if we moved back to a parent, or if we jumped to a child.
|
||||
*/
|
||||
static ClausePointer
|
||||
index_jmp(ClausePointer cur, yamop *ipc, int is_lu, yamop *e_code)
|
||||
{
|
||||
if (cur.lui == NULL) {
|
||||
cur.lui = NULL;
|
||||
return cur;
|
||||
}
|
||||
if (is_lu) {
|
||||
LogUpdIndex *lcur = cur.lui, *ncur;
|
||||
if (ipc == FAILCODE ||
|
||||
ipc == e_code ||
|
||||
ipc->opc == Yap_opcode(_expand_clauses)
|
||||
)
|
||||
return cur;
|
||||
/* check myself */
|
||||
if (ipc >= lcur->ClCode && ipc <= (yamop *)((CODEADDR)lcur+lcur->ClSize))
|
||||
return cur;
|
||||
/* maybe I jumped to some parent */
|
||||
if (lcur->ParentIndex) {
|
||||
LogUpdIndex *pcur = lcur->ParentIndex;
|
||||
if (ipc >= pcur->ClCode && ipc <= (yamop *)((CODEADDR)pcur+pcur->ClSize)) {
|
||||
cur.lui = pcur;
|
||||
}
|
||||
return cur;
|
||||
}
|
||||
/* maybe I am a new group */
|
||||
ncur = ClauseCodeToLogUpdIndex(ipc);
|
||||
if (ncur->ParentIndex != lcur) {
|
||||
#ifdef DEBUG
|
||||
fprintf(stderr,"OOPS, bad parent in lu index\n");
|
||||
#endif
|
||||
cur.lui = NULL;
|
||||
return cur;
|
||||
}
|
||||
cur.lui = lcur;
|
||||
return cur;
|
||||
} else {
|
||||
StaticIndex *scur = cur.si;
|
||||
/* check myself */
|
||||
if (ipc >= scur->ClCode && ipc <= (yamop *)((CODEADDR)scur+scur->ClSize))
|
||||
return cur;
|
||||
cur.si = NULL;
|
||||
return cur;
|
||||
}
|
||||
}
|
||||
|
||||
static ClausePointer
|
||||
code_to_indexcl(yamop *ipc, int is_lu)
|
||||
{
|
||||
ClausePointer ret;
|
||||
if (is_lu)
|
||||
ret.lui = ClauseCodeToLogUpdIndex(ipc);
|
||||
else
|
||||
ret.si = ClauseCodeToStaticIndex(ipc);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static yamop **
|
||||
expand_index(struct intermediates *cint) {
|
||||
/* first clause */
|
||||
@ -4843,7 +4907,8 @@ expand_index(struct intermediates *cint) {
|
||||
/* last clause to experiment with */
|
||||
yamop *ipc;
|
||||
/* labp should point at the beginning of the sequence */
|
||||
yamop **labp = NULL, **olabp = NULL;
|
||||
yamop **labp = NULL;
|
||||
ClausePointer parentcl;
|
||||
Term t = TermNil, *s_reg = NULL;
|
||||
int is_last_arg = TRUE;
|
||||
int argno = 1;
|
||||
@ -4854,6 +4919,7 @@ expand_index(struct intermediates *cint) {
|
||||
UInt lab, fail_l, clleft, i = 0;
|
||||
int is_lu = ap->PredFlags & LogUpdatePredFlag;
|
||||
yamop *eblk = NULL;
|
||||
yamop *e_code = (yamop *)&(ap->cs.p_code.ExpandCode);
|
||||
|
||||
ipc = ap->cs.p_code.TrueCodeOfPred;
|
||||
first = ap->cs.p_code.FirstClause;
|
||||
@ -4863,6 +4929,7 @@ expand_index(struct intermediates *cint) {
|
||||
stack[0].pos = 0;
|
||||
/* try to refine the interval using the indexing code */
|
||||
|
||||
parentcl = code_to_indexcl(ipc,is_lu);
|
||||
while (ipc != NULL) {
|
||||
op_numbers op;
|
||||
|
||||
@ -4962,8 +5029,8 @@ expand_index(struct intermediates *cint) {
|
||||
break;
|
||||
case _jump:
|
||||
/* just skip for now, but should worry about memory management */
|
||||
olabp = NULL;
|
||||
ipc = ipc->u.l.l;
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
break;
|
||||
case _lock_lu:
|
||||
case _procceed:
|
||||
@ -4974,9 +5041,9 @@ expand_index(struct intermediates *cint) {
|
||||
break;
|
||||
case _jump_if_var:
|
||||
if (IsVarTerm(Deref(ARG1))) {
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.l.l);
|
||||
ipc = ipc->u.l.l;
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
} else {
|
||||
ipc = NEXTOP(ipc,l);
|
||||
}
|
||||
@ -4988,9 +5055,9 @@ expand_index(struct intermediates *cint) {
|
||||
/* expand_index expects to find the new argument */
|
||||
if (!IsVarTerm(t)) {
|
||||
argno--;
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.xll.l1);
|
||||
ipc = ipc->u.xll.l1;
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
} else {
|
||||
ipc = NEXTOP(ipc,xll);
|
||||
}
|
||||
@ -5015,13 +5082,11 @@ expand_index(struct intermediates *cint) {
|
||||
argno = 1;
|
||||
i = 0;
|
||||
if (IsVarTerm(t)) {
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.llll.l4);
|
||||
ipc = ipc->u.llll.l4;
|
||||
} else if (IsPairTerm(t)) {
|
||||
sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
|
||||
s_reg = RepPair(t);
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.llll.l1);
|
||||
ipc = ipc->u.llll.l1;
|
||||
} else if (IsApplTerm(t)) {
|
||||
@ -5031,17 +5096,16 @@ expand_index(struct intermediates *cint) {
|
||||
sp = push_stack(sp, argno, t, TermNil, cint);
|
||||
ipc = ipc->u.llll.l2;
|
||||
}
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
break;
|
||||
case _switch_list_nl:
|
||||
t = Deref(ARG1);
|
||||
argno = 1;
|
||||
i = 0;
|
||||
if (IsVarTerm(t)) {
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.ollll.l4);
|
||||
ipc = ipc->u.ollll.l4;
|
||||
} else if (IsPairTerm(t)) {
|
||||
olabp = NULL;
|
||||
s_reg = RepPair(t);
|
||||
labp = &(ipc->u.ollll.l1);
|
||||
sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
|
||||
@ -5060,18 +5124,17 @@ expand_index(struct intermediates *cint) {
|
||||
sp = push_stack(sp, argno, tn, TermNil, cint);
|
||||
ipc = ipc->u.ollll.l3;
|
||||
}
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
break;
|
||||
case _switch_on_arg_type:
|
||||
argno = arg_from_x(ipc->u.xllll.x);
|
||||
i = 0;
|
||||
t = Deref(XREGS[argno]);
|
||||
if (IsVarTerm(t)) {
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.xllll.l4);
|
||||
ipc = ipc->u.xllll.l4;
|
||||
} else if (IsPairTerm(t)) {
|
||||
s_reg = RepPair(t);
|
||||
olabp = NULL;
|
||||
sp = push_stack(sp, argno, AbsPair(NULL), TermNil, cint);
|
||||
labp = &(ipc->u.xllll.l1);
|
||||
ipc = ipc->u.xllll.l1;
|
||||
@ -5082,6 +5145,7 @@ expand_index(struct intermediates *cint) {
|
||||
sp = push_stack(sp, argno, t, TermNil, cint);
|
||||
ipc = ipc->u.xllll.l2;
|
||||
}
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
break;
|
||||
case _switch_on_sub_arg_type:
|
||||
i = ipc->u.sllll.s;
|
||||
@ -5089,14 +5153,12 @@ expand_index(struct intermediates *cint) {
|
||||
if (i != arity-1) is_last_arg = FALSE;
|
||||
t = Deref(s_reg[i]);
|
||||
if (IsVarTerm(t)) {
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.sllll.l4);
|
||||
ipc = ipc->u.sllll.l4;
|
||||
i++;
|
||||
} else if (IsPairTerm(t)) {
|
||||
s_reg = RepPair(t);
|
||||
sp = push_stack(sp, -i-1, AbsPair(NULL), TermNil, cint);
|
||||
olabp = NULL;
|
||||
labp = &(ipc->u.sllll.l1);
|
||||
ipc = ipc->u.sllll.l1;
|
||||
i = 0;
|
||||
@ -5112,6 +5174,7 @@ expand_index(struct intermediates *cint) {
|
||||
ipc = ipc->u.sllll.l2;
|
||||
i++;
|
||||
}
|
||||
parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
|
||||
break;
|
||||
case _if_not_then:
|
||||
labp = NULL;
|
||||
@ -5135,9 +5198,9 @@ expand_index(struct intermediates *cint) {
|
||||
}
|
||||
newpc = (yamop *)(fe->Label);
|
||||
|
||||
olabp = &(ipc->u.sssl.l);
|
||||
labp = (yamop **)(&(fe->Label));
|
||||
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
||||
parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
|
||||
if (newpc == e_code) {
|
||||
/* we found it */
|
||||
ipc = NULL;
|
||||
} else {
|
||||
@ -5157,9 +5220,9 @@ expand_index(struct intermediates *cint) {
|
||||
ae = lookup_c(t,ipc->u.sssl.l,ipc->u.sssl.s);
|
||||
}
|
||||
|
||||
olabp = &(ipc->u.sssl.l);
|
||||
labp = (yamop **)(&(ae->Label));
|
||||
if (ae->Label == (CELL)&(ap->cs.p_code.ExpandCode)) {
|
||||
parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
|
||||
if (ae->Label == (CELL)e_code) {
|
||||
/* we found it */
|
||||
ipc = NULL;
|
||||
} else {
|
||||
@ -5199,15 +5262,9 @@ expand_index(struct intermediates *cint) {
|
||||
/* if there was an overflow while generating the code, make sure
|
||||
S is still correct */
|
||||
if (is_lu) {
|
||||
if (olabp)
|
||||
cint->current_cl.lui = ClauseCodeToLogUpdIndex(*olabp);
|
||||
else
|
||||
cint->current_cl.lui = NULL;
|
||||
cint->current_cl.lui = parentcl.lui;
|
||||
} else {
|
||||
if (olabp)
|
||||
cint->current_cl.si = ClauseCodeToStaticIndex(*olabp);
|
||||
else
|
||||
cint->current_cl.si = NULL;
|
||||
cint->current_cl.si = parentcl.si;
|
||||
}
|
||||
if (s_reg != NULL)
|
||||
S = s_reg;
|
||||
|
@ -150,6 +150,15 @@ typedef union clause_obj {
|
||||
struct static_index si;
|
||||
} ClauseUnion;
|
||||
|
||||
typedef union clause_ptr {
|
||||
struct logic_upd_clause *luc;
|
||||
struct logic_upd_index *lui;
|
||||
struct dynamic_clause *ic;
|
||||
struct static_clause *sc;
|
||||
struct static_mega_clause *mc;
|
||||
struct static_index *si;
|
||||
} ClausePointer;
|
||||
|
||||
#define ClauseCodeToDynamicClause(p) ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode)))
|
||||
#define ClauseCodeToStaticClause(p) ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode)))
|
||||
#define ClauseCodeToLogUpdClause(p) ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode)))
|
||||
|
Reference in New Issue
Block a user