slowly restore nth_clause
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@941 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
678ff0df82
commit
fd1bc58cde
88
C/cdmgr.c
88
C/cdmgr.c
|
|
@ -2995,7 +2995,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
|||
LogUpdClause *cl;
|
||||
Term rtn;
|
||||
|
||||
cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
|
||||
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
|
||||
if (cl == NULL) {
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
return FALSE;
|
||||
|
|
@ -3069,6 +3069,16 @@ p_log_update_clause(void)
|
|||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
WRITE_LOCK(pe->PRWLock);
|
||||
if (pe->ModuleOfPred != 2 &&
|
||||
pe->ArityOfPE) {
|
||||
UInt i;
|
||||
CELL *tar = RepAppl(t1);
|
||||
|
||||
/* makes no sense for IDB, as ArityOfPE means nothing */
|
||||
for (i = 1; i <= pe->ArityOfPE; i++) {
|
||||
XREGS[i] = tar[i];
|
||||
}
|
||||
}
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pe);
|
||||
}
|
||||
|
|
@ -3090,7 +3100,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
|
|||
{
|
||||
LogUpdClause *cl;
|
||||
|
||||
cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
|
||||
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
if (cl == NULL) {
|
||||
return FALSE;
|
||||
|
|
@ -3149,6 +3159,16 @@ p_log_update_clause0(void)
|
|||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
WRITE_LOCK(pe->PRWLock);
|
||||
if (pe->ModuleOfPred != 2 &&\
|
||||
pe->ArityOfPE) {
|
||||
UInt i;
|
||||
CELL *tar = RepAppl(t1);
|
||||
|
||||
/* makes no sense for IDB, as ArityOfPE means nothing */
|
||||
for (i = 1; i <= pe->ArityOfPE; i++) {
|
||||
XREGS[i] = tar[i];
|
||||
}
|
||||
}
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pe);
|
||||
}
|
||||
|
|
@ -3171,7 +3191,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
|
|||
StaticClause *cl;
|
||||
Term rtn;
|
||||
|
||||
cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
|
||||
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
if (cl == NULL)
|
||||
return FALSE;
|
||||
|
|
@ -3231,12 +3251,73 @@ p_static_clause(void)
|
|||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
WRITE_LOCK(pe->PRWLock);
|
||||
if (pe->ArityOfPE &&
|
||||
pe->ArityOfPE) {
|
||||
UInt i;
|
||||
CELL *tar = RepAppl(t1);
|
||||
|
||||
for (i = 1; i <= pe->ArityOfPE; i++) {
|
||||
XREGS[i] = tar[i];
|
||||
}
|
||||
}
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pe);
|
||||
}
|
||||
return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
p_nth_clause(void)
|
||||
{
|
||||
PredEntry *pe;
|
||||
Term t1 = Deref(ARG1);
|
||||
Term tn = Deref(ARG3);
|
||||
LogUpdClause *cl;
|
||||
Int ncls;
|
||||
|
||||
if (!IsIntegerTerm(tn))
|
||||
return FALSE;
|
||||
ncls = IntegerOfTerm(tn);
|
||||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
WRITE_LOCK(pe->PRWLock);
|
||||
if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
return FALSE;
|
||||
}
|
||||
/* in case we have to index or to expand code */
|
||||
if (pe->ModuleOfPred != 2) {
|
||||
UInt i;
|
||||
|
||||
for (i = 1; i <= pe->ArityOfPE; i++) {
|
||||
XREGS[i] = MkVarTerm();
|
||||
}
|
||||
} else {
|
||||
XREGS[2] = MkVarTerm();
|
||||
}
|
||||
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||
IPred(pe);
|
||||
}
|
||||
cl = Yap_NthClause(pe, ncls);
|
||||
if (cl == NULL)
|
||||
return FALSE;
|
||||
if (cl->ClFlags & LogUpdatePredFlag) {
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
LOCK(cl->ClLock);
|
||||
TRAIL_CLREF(cl); /* So that fail will erase it */
|
||||
INC_DBREF_COUNT(cl);
|
||||
UNLOCK(cl->ClLock);
|
||||
#else
|
||||
if (!(cl->ClFlags & InUseMask)) {
|
||||
cl->ClFlags |= InUseMask;
|
||||
TRAIL_CLREF(cl); /* So that fail will erase it */
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
p_continue_static_clause(void)
|
||||
{
|
||||
|
|
@ -3461,5 +3542,6 @@ Yap_InitCdMgr(void)
|
|||
Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag);
|
||||
Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
|
||||
Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag);
|
||||
}
|
||||
|
||||
|
|
|
|||
175
C/index.c
175
C/index.c
|
|
@ -6050,11 +6050,18 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc)
|
|||
B->cp_ap = ap_pc;
|
||||
}
|
||||
|
||||
LogUpdClause *
|
||||
Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
|
||||
static LogUpdClause *
|
||||
to_clause(yamop *ipc, PredEntry *ap)
|
||||
{
|
||||
if (ap->PredFlags & LogUpdatePredFlag)
|
||||
return lu_clause(ipc);
|
||||
else
|
||||
return static_clause(ipc);
|
||||
}
|
||||
|
||||
LogUpdClause *
|
||||
Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
|
||||
{
|
||||
CELL *tar = RepAppl(t1);
|
||||
UInt i;
|
||||
CELL *s_reg = NULL;
|
||||
Term t = TermNil;
|
||||
yamop *start_pc = ipc;
|
||||
|
|
@ -6062,12 +6069,6 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
|
|||
yamop **jlbl = NULL;
|
||||
int lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
||||
|
||||
if (ap->ModuleOfPred != 2) {
|
||||
/* makes no sense for IDB, as ArityOfPE means nothing */
|
||||
for (i = 1; i <= ap->ArityOfPE; i++) {
|
||||
XREGS[i] = tar[i];
|
||||
}
|
||||
}
|
||||
/* try to refine the interval using the indexing code */
|
||||
while (ipc != NULL) {
|
||||
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
||||
|
|
@ -6075,7 +6076,10 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
|
|||
switch(op) {
|
||||
case _try_in:
|
||||
update_clause_choice_point(NEXTOP(ipc,l), ap_pc);
|
||||
ipc = ipc->u.l.l;
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
else
|
||||
return static_clause(ipc->u.ld.d);
|
||||
break;
|
||||
case _try_clause:
|
||||
if (b0 == NULL)
|
||||
|
|
@ -6097,10 +6101,12 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
|
|||
update_clause_choice_point(ipc->u.ld.d, ap_pc);
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _retry_profiled:
|
||||
case _count_retry:
|
||||
ipc = NEXTOP(ipc,p);
|
||||
break;
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
|
|
@ -6392,6 +6398,149 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
|
|||
return NULL;
|
||||
}
|
||||
|
||||
LogUpdClause *
|
||||
Yap_NthClause(PredEntry *ap, Int ncls)
|
||||
{
|
||||
yamop
|
||||
*ipc = ap->cs.p_code.TrueCodeOfPred,
|
||||
*alt = NULL;
|
||||
yamop **jlbl = NULL;
|
||||
|
||||
/* search every clause */
|
||||
if (ncls == 1)
|
||||
return to_clause(ap->cs.p_code.FirstClause,ap);
|
||||
else if (ncls == ap->cs.p_code.NOfClauses)
|
||||
return to_clause(ap->cs.p_code.LastClause,ap);
|
||||
else if (ncls > ap->cs.p_code.NOfClauses)
|
||||
return NULL;
|
||||
else if (ncls < 0)
|
||||
return NULL;
|
||||
|
||||
while (TRUE) {
|
||||
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
||||
|
||||
switch(op) {
|
||||
case _try_in:
|
||||
if (ncls == 1)
|
||||
return to_clause(ipc->u.l.l, ap);
|
||||
ncls--;
|
||||
ipc = NEXTOP(ipc,l);
|
||||
break;
|
||||
case _retry_profiled:
|
||||
case _count_retry:
|
||||
ipc = NEXTOP(ipc,p);
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
if (ncls == 1)
|
||||
return to_clause(ipc->u.ld.d, ap);
|
||||
else if (alt == NULL) {
|
||||
ncls -= 2;
|
||||
/* get there in a fell swoop */
|
||||
if (ap->PredFlags & ProfiledPredFlag) {
|
||||
if (ap->PredFlags & CountPredFlag) {
|
||||
ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP(NEXTOP((yamop *)NULL,ld),p),p));
|
||||
} else {
|
||||
ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP((yamop *)NULL,ld),p));
|
||||
}
|
||||
} else if (ap->PredFlags & CountPredFlag) {
|
||||
ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP((yamop *)NULL,ld),p));
|
||||
} else {
|
||||
ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP((yamop *)NULL,ld));
|
||||
}
|
||||
ncls = 1;
|
||||
} else {
|
||||
ncls--;
|
||||
}
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _trust:
|
||||
if (ncls == 1)
|
||||
return to_clause(ipc->u.l.l,ap);
|
||||
ncls--;
|
||||
ipc = alt;
|
||||
break;
|
||||
case _try_me:
|
||||
case _try_me1:
|
||||
case _try_me2:
|
||||
case _try_me3:
|
||||
case _try_me4:
|
||||
case _retry_me:
|
||||
case _retry_me1:
|
||||
case _retry_me2:
|
||||
case _retry_me3:
|
||||
case _retry_me4:
|
||||
alt = ipc->u.ld.d;
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _profiled_trust_me:
|
||||
case _trust_me:
|
||||
case _count_trust_me:
|
||||
case _trust_me1:
|
||||
case _trust_me2:
|
||||
case _trust_me3:
|
||||
case _trust_me4:
|
||||
alt = NULL;
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _trust_logical_pred:
|
||||
ipc = NEXTOP(ipc,l);
|
||||
case _stale_lu_index:
|
||||
ipc = clean_up_index(ipc->u.Ill.I, jlbl, ap);
|
||||
break;
|
||||
case _enter_lu_pred:
|
||||
ipc = ipc->u.Ill.l1;
|
||||
break;
|
||||
case _jump:
|
||||
jlbl = &(ipc->u.l.l);
|
||||
ipc = ipc->u.l.l;
|
||||
break;
|
||||
case _jump_if_var:
|
||||
jlbl = &(ipc->u.l.l);
|
||||
ipc = ipc->u.l.l;
|
||||
break;
|
||||
case _jump_if_nonvar:
|
||||
ipc = NEXTOP(ipc,xl);
|
||||
break;
|
||||
/* instructions type e */
|
||||
case _switch_on_type:
|
||||
jlbl = &(ipc->u.llll.l4);
|
||||
ipc = ipc->u.llll.l4;
|
||||
break;
|
||||
case _switch_list_nl:
|
||||
jlbl = &(ipc->u.ollll.l4);
|
||||
ipc = ipc->u.ollll.l4;
|
||||
break;
|
||||
case _switch_on_arg_type:
|
||||
jlbl = &(ipc->u.xllll.l4);
|
||||
ipc = ipc->u.xllll.l4;
|
||||
break;
|
||||
case _switch_on_sub_arg_type:
|
||||
jlbl = &(ipc->u.sllll.l4);
|
||||
ipc = ipc->u.sllll.l4;
|
||||
break;
|
||||
case _if_not_then:
|
||||
jlbl = &(ipc->u.clll.l3);
|
||||
ipc = ipc->u.clll.l3;
|
||||
break;
|
||||
case _expand_index:
|
||||
ipc = ExpandIndex(ap);
|
||||
break;
|
||||
case _op_fail:
|
||||
ipc = alt;
|
||||
break;
|
||||
case _undef_p:
|
||||
return NULL;
|
||||
case _index_pred:
|
||||
case _spy_pred:
|
||||
Yap_IPred(ap);
|
||||
ipc = ap->cs.p_code.TrueCodeOfPred;
|
||||
break;
|
||||
default:
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static yamop **
|
||||
find_caller(PredEntry *ap, yamop *code) {
|
||||
/* first clause */
|
||||
|
|
|
|||
|
|
@ -188,7 +188,8 @@ yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *));
|
|||
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
|
||||
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
|
||||
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
|
||||
LogUpdClause *STD_PROTO(Yap_follow_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
|
||||
LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
|
||||
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
|
||||
|
||||
#if LOW_PROF
|
||||
/* profiling */
|
||||
|
|
|
|||
|
|
@ -4720,8 +4720,8 @@ available has undefined results.
|
|||
|
||||
@end table
|
||||
|
||||
The following predicate can be used for dynamic predicates and for static
|
||||
predicates, but only if source mode was on when they were compiled:
|
||||
The following predicates can be used for dynamic predicates and for
|
||||
static predicates, if source mode was on when they were compiled:
|
||||
|
||||
@table @code
|
||||
|
||||
|
|
|
|||
|
|
@ -326,7 +326,7 @@ debugging :-
|
|||
'$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
|
||||
throw('$fail_spy'(GoalNumber)).
|
||||
'$loop_spy_event'(abort, _, _, _, _) :- !,
|
||||
'$throw'(abort).
|
||||
throw(abort).
|
||||
'$loop_spy_event'(Event, GoalNumber, G, Module, _) :- !,
|
||||
'$trace'(exception,G,Module,GoalNumber),
|
||||
fail.
|
||||
|
|
|
|||
|
|
@ -355,6 +355,8 @@ clause(V,Q,R) :-
|
|||
|
||||
nth_clause(P,I,R) :- nonvar(R), !,
|
||||
'$nth_instancep'(P,I,R).
|
||||
nth_clause(V,I,R) :- var(V), !,
|
||||
'$do_error'(instantiation_error,M:nth_clause(V,I,R)).
|
||||
nth_clause(M:V,I,R) :- !,
|
||||
'$nth_clause'(V,M,I,R).
|
||||
nth_clause(V,I,R) :-
|
||||
|
|
@ -371,11 +373,14 @@ nth_clause(V,I,R) :-
|
|||
'$nth_clause'(M:P,_,I,R) :- !,
|
||||
'$nth_clause'(P,M,I,R).
|
||||
'$nth_clause'(P,M,I,R) :-
|
||||
'$some_recordedp'(M:P), !,
|
||||
( '$is_log_updatable'(P,M) ; '$is_source'(P,M) ), !,
|
||||
'$p_nth_clause'(P,M,I,R).
|
||||
'$nth_clause'(P,M,I,R) :-
|
||||
'$is_dynamic'(H,M), !,
|
||||
'$nth_instancep'(M:P,I,R).
|
||||
'$nth_clause'(P,M,I,R) :-
|
||||
( '$system_predicate'(P,M) -> true ;
|
||||
'$number_of_nth_clauses'(P,M,N), N > 0 ),
|
||||
'$number_of_clauses'(P,M,N), N > 0 ),
|
||||
functor(P,Name,Arity),
|
||||
'$do_error'(permission_error(access,private_procedure,Name/Arity),
|
||||
nth_clause(M:P,I,R)).
|
||||
|
|
|
|||
Reference in New Issue