purge_clauses does not need to do anything if there are no clauses

fix gprof bugs.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2045 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-12-18 17:46:58 +00:00
parent 7f925bcd5b
commit 926d21808e
5 changed files with 45 additions and 17 deletions

View File

@ -11,8 +11,11 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2007-11-28 23:52:14 $,$Author: vsc $ * * Last rev: $Date: 2007-12-18 17:46:58 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.214 2007/11/28 23:52:14 vsc
* junction tree algorithm
*
* Revision 1.213 2007/11/26 23:43:07 vsc * Revision 1.213 2007/11/26 23:43:07 vsc
* fixes to support threads and assert correctly, even if inefficiently. * fixes to support threads and assert correctly, even if inefficiently.
* *
@ -486,6 +489,9 @@ PredForChoicePt(yamop *p_code) {
switch(opnum) { switch(opnum) {
case _Nstop: case _Nstop:
return NULL; return NULL;
case _jump:
p_code = p_code->u.l.l;
break;
case _retry_me: case _retry_me:
case _trust_me: case _trust_me:
return p_code->u.ld.p; return p_code->u.ld.p;
@ -2535,10 +2541,12 @@ p_endconsult(void)
static void static void
purge_clauses(PredEntry *pred) purge_clauses(PredEntry *pred)
{ {
if (pred->PredFlags & IndexedPredFlag) if (pred->cs.p_code.NOfClauses) {
RemoveIndexation(pred); if (pred->PredFlags & IndexedPredFlag)
Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue)); RemoveIndexation(pred);
retract_all(pred, static_in_use(pred,TRUE)); Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue));
retract_all(pred, static_in_use(pred,TRUE));
}
pred->src.OwnerFile = AtomNil; pred->src.OwnerFile = AtomNil;
if (pred->PredFlags & MultiFileFlag) if (pred->PredFlags & MultiFileFlag)
pred->PredFlags ^= MultiFileFlag; pred->PredFlags ^= MultiFileFlag;
@ -3715,22 +3723,32 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
case _table_answer_resolution: case _table_answer_resolution:
case _table_completion: case _table_completion:
#endif /* TABLING */ #endif /* TABLING */
pp = pc->u.ld.p;
pc = NEXTOP(pc,ld); pc = NEXTOP(pc,ld);
break; break;
case _try_logical: case _try_logical:
case _retry_logical: case _retry_logical:
case _trust_logical:
case _count_retry_logical: case _count_retry_logical:
case _count_trust_logical:
case _profiled_retry_logical: case _profiled_retry_logical:
case _profiled_trust_logical:
pp = pc->u.lld.d->ClPred;
pc = pc->u.lld.n; pc = pc->u.lld.n;
break; break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
{
LogUpdIndex *cl = pc->u.lld.t.block;
pp = cl->ClPred;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return pp;
}
case _enter_lu_pred: case _enter_lu_pred:
pc = pc->u.Ill.l1; {
break; LogUpdIndex *cl = pc->u.Ill.I;
pp = cl->ClPred;
*startp = (CODEADDR)cl;
*endp = (CODEADDR)cl+cl->ClSize;
return pp;
}
/* instructions type p */ /* instructions type p */
case _count_call: case _count_call:
case _count_retry: case _count_retry:
@ -5570,8 +5588,10 @@ p_predicate_erased_statistics(void)
PredEntry *pe; PredEntry *pe;
LogUpdClause *cl = DBErasedList; LogUpdClause *cl = DBErasedList;
LogUpdIndex *icl = DBErasedIList; LogUpdIndex *icl = DBErasedIList;
Term tpred = ArgOfTerm(1,Deref(ARG1));
Term tmod = ArgOfTerm(2,Deref(ARG1));
if (EndOfPAEntr(pe=get_pred(Deref(ARG1), Deref(ARG2), "predicate_statistics"))) if (EndOfPAEntr(pe=get_pred(tpred, tmod, "predicate_erased_statistics")))
return FALSE; return FALSE;
while (cl) { while (cl) {
if (cl->ClPred == pe) { if (cl->ClPred == pe) {

View File

@ -11,8 +11,11 @@
* File: compiler.c * * File: compiler.c *
* comments: Clause compiler * * comments: Clause compiler *
* * * *
* Last rev: $Date: 2007-11-26 23:43:08 $,$Author: vsc $ * * Last rev: $Date: 2007-12-18 17:46:58 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.86 2007/11/26 23:43:08 vsc
* fixes to support threads and assert correctly, even if inefficiently.
*
* Revision 1.85 2007/11/06 17:02:11 vsc * Revision 1.85 2007/11/06 17:02:11 vsc
* compile ground terms away. * compile ground terms away.
* *
@ -698,8 +701,6 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
if (try_store_as_dbterm(t, argno, arity, level, cglobs)) if (try_store_as_dbterm(t, argno, arity, level, cglobs))
return; return;
} }
if (try_store_as_dbterm(t, argno, arity, level, cglobs))
return;
t = optimize_ce(t, arity, level, cglobs); t = optimize_ce(t, arity, level, cglobs);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
c_var(t, argno, arity, level, cglobs); c_var(t, argno, arity, level, cglobs);

View File

@ -1862,7 +1862,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
} }
if (very_verbose) { if (very_verbose) {
PredEntry *pe = Yap_PredForChoicePt(gc_B); PredEntry *pe = Yap_PredForChoicePt(gc_B);
#if defined(ANALYST) || defined(DEBUG) #if defined(ANALYST) || defined(DEBUG)
if (pe == NULL) { if (pe == NULL) {
fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, Yap_op_names[opnum]); fprintf(Yap_stderr,"%% marked %ld (%s)\n", total_marked, Yap_op_names[opnum]);

View File

@ -17,6 +17,7 @@
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> FIXED: small glitches with profon.</li>
<li> NEW: allow re-exporting other modules.</li> <li> NEW: allow re-exporting other modules.</li>
<li> FIXED: graph add_ and del_ predicates should have the original <li> FIXED: graph add_ and del_ predicates should have the original
graph as the first argument (obs from A N Saravanaraj).</li> graph as the first argument (obs from A N Saravanaraj).</li>

View File

@ -861,3 +861,10 @@ predicate_statistics(P,NCls,Sz,ISz) :-
'$predicate_statistics'(P,M,NCls,Sz,ISz) :- '$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$static_pred_statistics'(P,M,NCls,Sz,ISz). '$static_pred_statistics'(P,M,NCls,Sz,ISz).
predicate_erased_statistics(V,NCls,Sz,ISz) :- var(V), !,
'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !,
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
predicate_erased_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).