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

first cut at call counter.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@580 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-09-03 14:28:09 +00:00
parent 89a188d5d7
commit 94e9529128
20 changed files with 459 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
C/absmi.c
View File

@ -459,7 +459,7 @@ absmi(int inp)
GONext(); GONext();
ENDOp(); ENDOp();
/* profiled_enter_me Label,NArgs */ /* profiled_retry Label,NArgs */
Op(retry_profiled, l); Op(retry_profiled, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++; ((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++;
@ -523,6 +523,111 @@ absmi(int inp)
GONext(); GONext();
ENDOp(); ENDOp();
/*****************************************************************
* Call count instructions *
*****************************************************************/
/* count_enter_me Label,NArgs */
Op(count_call, l);
ReductionsCounter--;
if (ReductionsCounter == 0 && ReductionsCounterOn) {
Error(CALL_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PREG = NEXTOP(PREG, l);
GONext();
ENDOp();
/* count_retry Label,NArgs */
Op(count_retry, l);
RetriesCounter--;
if (RetriesCounter == 0 && RetriesCounterOn) {
Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PREG = NEXTOP(PREG, l);
GONext();
ENDOp();
/* count_retry_me Label,NArgs */
Op(count_retry_me, ld);
CACHE_Y(B);
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
RetriesCounter--;
if (RetriesCounter == 0 && RetriesCounterOn) {
Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
restore_yaam_regs(PREG->u.ld.d);
restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS
S_Y = (CELL *)PROTECT_FROZEN_B(B_Y);
set_cut(S_Y, B->cp_b);
#else
set_cut(S_Y, B_Y->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_Y);
ENDCACHE_Y();
PREG = NEXTOP(PREG, ld);
GONext();
ENDOp();
/* count_trust_me UnusedLabel,NArgs */
Op(count_trust_me, ld);
CACHE_Y(B);
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_Y);
restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS
B_Y = PROTECT_FROZEN_B(B_Y);
#endif /* FROZEN_STACKS */
set_cut(S_Y, B->cp_b);
}
else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(PREG->u.ld.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_Y = (CELL *)PROTECT_FROZEN_B(B_Y);
#endif /* FROZEN_STACKS */
set_cut(S_Y, B);
}
SET_BB(B_Y);
ENDCACHE_Y();
RetriesCounter--;
if (RetriesCounter == 0) {
Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0) {
Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PREG = NEXTOP(PREG, ld);
GONext();
ENDOp();
/***************************************************************** /*****************************************************************
* Specialised try - retry - trust instructions * * Specialised try - retry - trust instructions *
*****************************************************************/ *****************************************************************/
@ -1071,6 +1176,21 @@ absmi(int inp)
ENDBOp(); ENDBOp();
BOp(count_retry_and_mark, ld);
RetriesCounter--;
if (RetriesCounter == 0) {
Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0) {
Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
}
goto actual_retry_and_mark;
/* enter a retry dynamic */
ENDBOp();
BOp(profiled_retry_and_mark, ld); BOp(profiled_retry_and_mark, ld);
LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock); LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++; ((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++;
@ -1080,6 +1200,7 @@ absmi(int inp)
/* retry_and_mark Label,NArgs */ /* retry_and_mark Label,NArgs */
BOp(retry_and_mark, ld); BOp(retry_and_mark, ld);
actual_retry_and_mark:
#ifdef YAPOR #ifdef YAPOR
CUT_wait_leftmost(); CUT_wait_leftmost();
#endif /* YAPOR */ #endif /* YAPOR */

6
C/amasm.c
View File

@ -2532,6 +2532,12 @@ do_pass(void)
case retry_profiled_op: case retry_profiled_op:
a_pl(_retry_profiled, (PredEntry *)(cpc->rnd1)); a_pl(_retry_profiled, (PredEntry *)(cpc->rnd1));
break; break;
case count_call_op:
a_pl(_count_call, (PredEntry *)(cpc->rnd1));
break;
case count_retry_op:
a_pl(_count_retry, (PredEntry *)(cpc->rnd1));
break;
case fetch_args_for_bccall: case fetch_args_for_bccall:
if (cpc->nextInst->op != bccall_op) { if (cpc->nextInst->op != bccall_op) {
Error(SYSTEM_ERROR, TermNil, "compiling binary test", (int) cpc->op); Error(SYSTEM_ERROR, TermNil, "compiling binary test", (int) cpc->op);

112
C/cdmgr.c
View File

@ -74,6 +74,10 @@ STATIC_PROTO(Int p_compile_mode, (void));
STATIC_PROTO(Int p_is_profiled, (void)); STATIC_PROTO(Int p_is_profiled, (void));
STATIC_PROTO(Int p_profile_info, (void)); STATIC_PROTO(Int p_profile_info, (void));
STATIC_PROTO(Int p_profile_reset, (void)); STATIC_PROTO(Int p_profile_reset, (void));
STATIC_PROTO(Int p_is_call_counted, (void));
STATIC_PROTO(Int p_call_count_info, (void));
STATIC_PROTO(Int p_call_count_set, (void));
STATIC_PROTO(Int p_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void)); STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
#ifdef DEBUG #ifdef DEBUG
STATIC_PROTO(void list_all_predicates_in_use, (void)); STATIC_PROTO(void list_all_predicates_in_use, (void));
@ -380,6 +384,8 @@ retract_all(PredEntry *p, int in_use)
p->OpcodeOfPred = cpt->opc; p->OpcodeOfPred = cpt->opc;
if (p->PredFlags & ProfiledPredFlag) { if (p->PredFlags & ProfiledPredFlag) {
((yamop *)lclause)->opc = opcode(_profiled_trust_me); ((yamop *)lclause)->opc = opcode(_profiled_trust_me);
} else if (p->PredFlags & CountPredFlag) {
((yamop *)lclause)->opc = opcode(_count_trust_me);
} else { } else {
((yamop *)lclause)->opc = opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p))); ((yamop *)lclause)->opc = opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p)));
} }
@ -520,6 +526,8 @@ add_first_dynamic(PredEntry *p, CODEADDR cp, int spy_flag)
* backtrack to the previous block */ * backtrack to the previous block */
if (p->PredFlags & ProfiledPredFlag) if (p->PredFlags & ProfiledPredFlag)
((yamop *)cp)->opc = opcode(_profiled_retry_and_mark); ((yamop *)cp)->opc = opcode(_profiled_retry_and_mark);
else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = opcode(_count_retry_and_mark);
else else
((yamop *)cp)->opc = opcode(_retry_and_mark); ((yamop *)cp)->opc = opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE; ((yamop *)cp)->u.ld.s = p->ArityOfPE;
@ -567,6 +575,11 @@ asserta_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
q->opc = opcode(_profiled_trust_me); q->opc = opcode(_profiled_trust_me);
else else
q->opc = opcode(_profiled_retry_me); q->opc = opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) {
if (p->FirstClause == p->LastClause)
q->opc = opcode(_count_trust_me);
else
q->opc = opcode(_count_retry_me);
} else { } else {
if (p->FirstClause == p->LastClause) { if (p->FirstClause == p->LastClause) {
#ifdef TABLING #ifdef TABLING
@ -606,9 +619,11 @@ asserta_dynam_clause(PredEntry *p, CODEADDR cp)
q->u.ld.s = p->ArityOfPE; q->u.ld.s = p->ArityOfPE;
q->u.ld.p = p; q->u.ld.p = p;
if (p->PredFlags & ProfiledPredFlag) if (p->PredFlags & ProfiledPredFlag)
((yamop *)cp)->opc = opcode(_retry_and_mark);
else
((yamop *)cp)->opc = opcode(_profiled_retry_and_mark); ((yamop *)cp)->opc = opcode(_profiled_retry_and_mark);
else if (p->PredFlags & CountPredFlag)
((yamop *)cp)->opc = opcode(_count_retry_and_mark);
else
((yamop *)cp)->opc = opcode(_retry_and_mark);
((yamop *)cp)->u.ld.s = p->ArityOfPE; ((yamop *)cp)->u.ld.s = p->ArityOfPE;
((yamop *)cp)->u.ld.p = p; ((yamop *)cp)->u.ld.p = p;
p->FirstClause = cp; p->FirstClause = cp;
@ -630,6 +645,12 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
p->TrueCodeOfPred = p->FirstClause; p->TrueCodeOfPred = p->FirstClause;
} else } else
pt->opc = opcode(_profiled_retry_me); pt->opc = opcode(_profiled_retry_me);
} else if (p->PredFlags & CountPredFlag) {
if (p->FirstClause == p->LastClause) {
pt->opc = opcode(TRYCODE(_try_me, _try_me0, PredArity(p)));
p->TrueCodeOfPred = p->FirstClause;
} else
pt->opc = opcode(_count_retry_me);
} else { } else {
if (p->FirstClause == p->LastClause) { if (p->FirstClause == p->LastClause) {
#ifdef TABLING #ifdef TABLING
@ -653,6 +674,8 @@ assertz_stat_clause(PredEntry *p, CODEADDR cp, int spy_flag)
pt = (yamop *)cp; pt = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag) { if (p->PredFlags & ProfiledPredFlag) {
pt->opc = opcode(_profiled_trust_me); pt->opc = opcode(_profiled_trust_me);
} else if (p->PredFlags & CountPredFlag) {
pt->opc = opcode(_count_trust_me);
} else { } else {
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) if (is_tabled(p))
@ -693,6 +716,8 @@ assertz_dynam_clause(PredEntry *p, CODEADDR cp)
q = (yamop *)cp; q = (yamop *)cp;
if (p->PredFlags & ProfiledPredFlag) if (p->PredFlags & ProfiledPredFlag)
q->opc = opcode(_profiled_retry_and_mark); q->opc = opcode(_profiled_retry_and_mark);
else if (p->PredFlags & CountPredFlag)
q->opc = opcode(_count_retry_and_mark);
else else
q->opc = opcode(_retry_and_mark); q->opc = opcode(_retry_and_mark);
q->u.ld.d = p->CodeOfPred; q->u.ld.d = p->CodeOfPred;
@ -1779,6 +1804,9 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
case _retry_profiled: case _retry_profiled:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc); opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp; goto restart_cp;
case _count_retry:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp;
default: default:
pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p); pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p);
} }
@ -1829,7 +1857,6 @@ static char *op_names[_std_top + 1] =
#endif #endif
static void static void
list_all_predicates_in_use(void) list_all_predicates_in_use(void)
{ {
@ -1865,6 +1892,7 @@ list_all_predicates_in_use(void)
case _retry_userc: case _retry_userc:
case _trust_logical_pred: case _trust_logical_pred:
case _retry_profiled: case _retry_profiled:
case _count_retry:
{ {
Atom at; Atom at;
Int arity; Int arity;
@ -1890,7 +1918,7 @@ list_all_predicates_in_use(void)
YP_fprintf(YP_stderr,"CP %p %d (%s)\n", b_ptr, RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, op_names[opnum]); YP_fprintf(YP_stderr,"CP %p %d (%s)\n", b_ptr, RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, op_names[opnum]);
} }
} }
if (opnum == _retry_profiled) { if (opnum == _retry_profiled || opnum == _count_retry) {
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc); opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp; goto restart_cp;
} }
@ -1958,6 +1986,9 @@ do_toggle_static_predicates_in_use(int mask)
case _retry_profiled: case _retry_profiled:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc); opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp; goto restart_cp;
case _count_retry:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp;
default: default:
pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p); pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p);
} }
@ -2171,6 +2202,75 @@ p_profile_reset(void)
return(TRUE); return(TRUE);
} }
static Int
p_is_call_counted(void)
{
Term t = Deref(ARG1);
char *s;
if (IsVarTerm(t)) {
Term ta;
if (CALL_COUNTING) ta = MkAtomTerm(LookupAtom("on"));
else ta = MkAtomTerm(LookupAtom("off"));
BIND((CELL *)t,ta,bind_is_call_counted);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), ta);
if (CellPtr(t) < H0) WakeUp((CELL *)t);
bind_is_call_counted:
#endif
return(TRUE);
} else if (!IsAtomTerm(t)) return(FALSE);
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"on") == 0) {
CALL_COUNTING = TRUE;
return(TRUE);
} else if (strcmp(s,"off") == 0) {
CALL_COUNTING = FALSE;
return(TRUE);
}
return(FALSE);
}
static Int
p_call_count_info(void)
{
return(unify(MkIntegerTerm(ReductionsCounter),ARG1) &&
unify(MkIntegerTerm(PredEntriesCounter),ARG2) &&
unify(MkIntegerTerm(PredEntriesCounter),ARG3));
}
static Int
p_call_count_reset(void)
{
ReductionsCounter = 0;
ReductionsCounterOn = FALSE;
PredEntriesCounter = 0;
PredEntriesCounterOn = FALSE;
RetriesCounter = 0;
RetriesCounterOn = FALSE;
return(TRUE);
}
static Int
p_call_count_set(void)
{
int do_calls = IntOfTerm(ARG2);
int do_retries = IntOfTerm(ARG4);
int do_entries = IntOfTerm(ARG6);
if (do_calls)
ReductionsCounter = IntegerOfTerm(Deref(ARG1));
ReductionsCounterOn = do_calls;
if (do_retries)
RetriesCounter = IntegerOfTerm(Deref(ARG3));
RetriesCounterOn = do_retries;
if (do_entries)
PredEntriesCounter = IntegerOfTerm(Deref(ARG5));
PredEntriesCounterOn = do_entries;
return(TRUE);
}
static Int static Int
p_clean_up_dead_clauses(void) p_clean_up_dead_clauses(void)
{ {
@ -2393,6 +2493,10 @@ InitCdMgr(void)
InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag); InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag);
InitCPred("$profile_info", 3, p_profile_info, SafePredFlag|SyncPredFlag); InitCPred("$profile_info", 3, p_profile_info, SafePredFlag|SyncPredFlag);
InitCPred("$profile_reset", 2, p_profile_reset, SafePredFlag|SyncPredFlag); InitCPred("$profile_reset", 2, p_profile_reset, SafePredFlag|SyncPredFlag);
InitCPred("$is_call_counted", 1, p_is_call_counted, SafePredFlag|SyncPredFlag);
InitCPred("$call_count_info", 3, p_call_count_info, SafePredFlag|SyncPredFlag);
InitCPred("$call_count_set", 6, p_call_count_set, SafePredFlag|SyncPredFlag);
InitCPred("$call_count_reset", 0, p_call_count_reset, SafePredFlag|SyncPredFlag);
InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag); InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag); InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag); InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);

27
C/compiler.c
View File

@ -73,7 +73,7 @@ static Ventry *vtable;
CExpEntry *common_exps; CExpEntry *common_exps;
int n_common_exps, profiling; int n_common_exps, profiling, call_counting;
static int goalno, level, onlast, onhead, onbranch, cur_branch; static int goalno, level, onlast, onhead, onbranch, cur_branch;
@ -1097,6 +1097,8 @@ c_functor(Term Goal, int mod)
Prop p0 = PredPropByFunc(f, mod); Prop p0 = PredPropByFunc(f, mod);
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero); emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
else if (call_counting)
emit(count_call_op, (CELL)RepPredProp(p0), Zero);
c_args(Goal); c_args(Goal);
emit(safe_call_op, (CELL)p0 , Zero); emit(safe_call_op, (CELL)p0 , Zero);
emit(empty_call_op, Zero, Zero); emit(empty_call_op, Zero, Zero);
@ -1177,6 +1179,8 @@ c_goal(Term Goal, int mod)
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomCut,0)), Zero); emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomCut,0)), Zero);
else if (call_counting)
emit(count_call_op, (CELL)RepPredProp(PredPropByAtom(AtomCut,0)), Zero);
if (onlast) { if (onlast) {
/* never a problem here with a -> b, !, c ; d */ /* never a problem here with a -> b, !, c ; d */
emit(deallocate_op, Zero, Zero); emit(deallocate_op, Zero, Zero);
@ -1208,6 +1212,8 @@ c_goal(Term Goal, int mod)
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero); emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero);
else if (call_counting)
emit(count_call_op, (CELL)RepPredProp(PredPropByAtom(AtomRepeat,0)), Zero);
or_found = 1; or_found = 1;
push_branch(onbranch, TermNil); push_branch(onbranch, TermNil);
cur_branch++; cur_branch++;
@ -1245,6 +1251,8 @@ c_goal(Term Goal, int mod)
/* if we are profiling, make sure we register we entered this predicate */ /* if we are profiling, make sure we register we entered this predicate */
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)p, Zero); emit(enter_profiling_op, (CELL)p, Zero);
if (call_counting)
emit(count_call_op, (CELL)p, Zero);
} }
else { else {
f = FunctorOfTerm(Goal); f = FunctorOfTerm(Goal);
@ -1438,6 +1446,8 @@ c_goal(Term Goal, int mod)
} else if (f == FunctorEq) { } else if (f == FunctorEq) {
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)p, Zero); emit(enter_profiling_op, (CELL)p, Zero);
else if (call_counting)
emit(count_call_op, (CELL)p, Zero);
c_eq(ArgOfTerm(1, Goal), ArgOfTerm(2, Goal)); c_eq(ArgOfTerm(1, Goal), ArgOfTerm(2, Goal));
if (onlast) { if (onlast) {
emit(deallocate_op, Zero, Zero); emit(deallocate_op, Zero, Zero);
@ -1457,6 +1467,8 @@ c_goal(Term Goal, int mod)
int op = p->PredFlags & 0x7f; int op = p->PredFlags & 0x7f;
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)p, Zero); emit(enter_profiling_op, (CELL)p, Zero);
else if (call_counting)
emit(count_call_op, (CELL)p, Zero);
if (op >= _atom && op <= _primitive) { if (op >= _atom && op <= _primitive) {
c_test(op, ArgOfTerm(1, Goal)); c_test(op, ArgOfTerm(1, Goal));
if (onlast) { if (onlast) {
@ -1574,6 +1586,8 @@ c_goal(Term Goal, int mod)
} else { } else {
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)p, Zero); emit(enter_profiling_op, (CELL)p, Zero);
else if (call_counting)
emit(count_call_op, (CELL)p, Zero);
c_args(Goal); c_args(Goal);
} }
} }
@ -2820,10 +2834,17 @@ cclause(Term inp_clause, int NOfArgs, int mod)
/* insert extra instructions to count calls */ /* insert extra instructions to count calls */
READ_LOCK(CurrentPred->PRWLock); READ_LOCK(CurrentPred->PRWLock);
if ((CurrentPred->PredFlags & ProfiledPredFlag) || if ((CurrentPred->PredFlags & ProfiledPredFlag) ||
(PROFILING && (CurrentPred->FirstClause == NIL))) (PROFILING && (CurrentPred->FirstClause == NIL))) {
profiling = TRUE; profiling = TRUE;
else call_counting = FALSE;
} else if ((CurrentPred->PredFlags & CountPredFlag) ||
(CALL_COUNTING && (CurrentPred->FirstClause == NIL))) {
call_counting = TRUE;
profiling = FALSE; profiling = FALSE;
} else {
profiling = FALSE;
call_counting = FALSE;
}
READ_UNLOCK(CurrentPred->PRWLock); READ_UNLOCK(CurrentPred->PRWLock);
} }
/* phase 1 : produce skeleton code and variable information */ /* phase 1 : produce skeleton code and variable information */

2
C/computils.c
View File

@ -604,6 +604,8 @@ static char *opformat[] =
"function_to_al\t%v,%B", "function_to_al\t%v,%B",
"enter_profiling\t\t%g", "enter_profiling\t\t%g",
"retry_profiled\t\t%g", "retry_profiled\t\t%g",
"count_call_op\t\t%g",
"count_retry_op\t\t%g",
"restore_temps\t\t%l", "restore_temps\t\t%l",
"restore_temps_and_skip\t\t%l", "restore_temps_and_skip\t\t%l",
"empty_call\t\t%l,%d", "empty_call\t\t%l,%d",

23
C/errors.c
View File

@ -157,6 +157,9 @@ DumpActiveGoals (void)
case _retry_profiled: case _retry_profiled:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc); opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp; goto restart_cp;
case _count_retry_me:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp;
default: default:
pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p); pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p);
} }
@ -417,6 +420,26 @@ Error (yap_error_number type, Term where, char *format,...)
fun = MkFunctor(LookupAtom("abort"),2); fun = MkFunctor(LookupAtom("abort"),2);
serious = TRUE; serious = TRUE;
break; break;
case CALL_COUNTER_UNDERFLOW:
/* Do a long jump */
PredEntriesCounter--;
JumpToEnv(MkAtomTerm(LookupAtom("call_counter")));
P = (yamop *)FAILCODE;
PrologMode &= ~InErrorMode;
return(P);
case PRED_ENTRY_COUNTER_UNDERFLOW:
/* Do a long jump */
JumpToEnv(MkAtomTerm(LookupAtom("call_and_retry_counter")));
P = (yamop *)FAILCODE;
PrologMode &= ~InErrorMode;
return(P);
case RETRY_COUNTER_UNDERFLOW:
/* Do a long jump */
PredEntriesCounter--;
JumpToEnv(MkAtomTerm(LookupAtom("retry_counter")));
P = (yamop *)FAILCODE;
PrologMode &= ~InErrorMode;
return(P);
case DOMAIN_ERROR_ARRAY_OVERFLOW: case DOMAIN_ERROR_ARRAY_OVERFLOW:
{ {
int i; int i;

6
C/heapgc.c
View File

@ -1462,6 +1462,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _retry_userc: case _retry_userc:
case _trust_logical_pred: case _trust_logical_pred:
case _retry_profiled: case _retry_profiled:
case _count_retry:
{ {
Atom at; Atom at;
Int arity; Int arity;
@ -1594,6 +1595,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
break; break;
case _trust_logical_pred: case _trust_logical_pred:
case _retry_profiled: case _retry_profiled:
case _count_retry:
rtp = NEXTOP(rtp,l); rtp = NEXTOP(rtp,l);
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = op_from_opcode(op);
@ -1706,6 +1708,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trust_me: case _trust_me:
case _profiled_retry_me: case _profiled_retry_me:
case _profiled_trust_me: case _profiled_trust_me:
case _count_retry_me:
case _count_trust_me:
case _retry_me0: case _retry_me0:
case _trust_me0: case _trust_me0:
case _retry_me1: case _retry_me1:
@ -1718,6 +1722,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trust_me4: case _trust_me4:
case _retry_and_mark: case _retry_and_mark:
case _profiled_retry_and_mark: case _profiled_retry_and_mark:
case _count_retry_and_mark:
case _retry: case _retry:
case _trust_in: case _trust_in:
case _trust: case _trust:
@ -2201,6 +2206,7 @@ sweep_choicepoints(choiceptr gc_B)
break; break;
case _trust_logical_pred: case _trust_logical_pred:
case _retry_profiled: case _retry_profiled:
case _count_retry:
rtp = NEXTOP(rtp,l); rtp = NEXTOP(rtp,l);
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = op_from_opcode(op);

4
C/index.c
View File

@ -252,6 +252,8 @@ emit_cp_inst(compiler_vm_op op, yamop * Address, int Flag, int NClausesAfter)
indexed_code_for_cut = NIL; indexed_code_for_cut = NIL;
if (op != try_op && profiling) if (op != try_op && profiling)
emit(retry_profiled_op, Unsigned(CurrentPred), Zero); emit(retry_profiled_op, Unsigned(CurrentPred), Zero);
else if (op != try_op && call_counting)
emit(count_retry_op, Unsigned(CurrentPred), Zero);
if (NGroups == 1) if (NGroups == 1)
Flag = Flag | LoneGroup; Flag = Flag | LoneGroup;
else if (Flag & LastGroup) { else if (Flag & LastGroup) {
@ -1335,6 +1337,8 @@ PredIsIndexable(PredEntry *ap)
CurrentPred = ap; CurrentPred = ap;
if (CurrentPred->PredFlags & ProfiledPredFlag) if (CurrentPred->PredFlags & ProfiledPredFlag)
profiling = TRUE; profiling = TRUE;
else if (CurrentPred->PredFlags & CountPredFlag)
call_counting = TRUE;
else else
profiling = FALSE; profiling = FALSE;
IPredArity = ap->ArityOfPE; IPredArity = ap->ArityOfPE;

1
C/init.c
View File

@ -852,6 +852,7 @@ InitCodes(void)
} }
heap_regs->consultcapacity = InitialConsultCapacity; heap_regs->consultcapacity = InitialConsultCapacity;
heap_regs->profiling = FALSE; heap_regs->profiling = FALSE;
heap_regs->call_counting = FALSE;
heap_regs->update_mode = 0; heap_regs->update_mode = 0;
heap_regs->consultbase = heap_regs->consultsp = heap_regs->consultbase = heap_regs->consultsp =
heap_regs->consultlow + heap_regs->consultcapacity; heap_regs->consultlow + heap_regs->consultcapacity;

28
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.29 2002-06-05 01:34:06 vsc Exp $ * * version: $Id: Heap.h,v 1.30 2002-09-03 14:28:07 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -27,6 +27,15 @@ typedef struct atom_hash_entry {
Atom Entry; Atom Entry;
} AtomHashEntry; } AtomHashEntry;
typedef struct reduction_counters {
YAP_LONG_LONG reductions;
YAP_LONG_LONG reductions_retries;
YAP_LONG_LONG retries;
int reductions_on;
int reductions_retries_on;
int retries_on;
} red_counters;
typedef int (*Agc_hook)(Atom); typedef int (*Agc_hook)(Atom);
typedef struct various_codes { typedef struct various_codes {
@ -113,6 +122,7 @@ typedef struct various_codes {
struct pred_entry *undef_code; struct pred_entry *undef_code;
struct pred_entry *spy_code; struct pred_entry *spy_code;
int profiling; int profiling;
int call_counting;
AtomHashEntry invisiblechain; AtomHashEntry invisiblechain;
OPCODE dummycode; OPCODE dummycode;
Int maxdepth, maxlist; Int maxdepth, maxlist;
@ -288,6 +298,7 @@ typedef struct various_codes {
UInt n_of_file_aliases; UInt n_of_file_aliases;
UInt sz_of_file_aliases; UInt sz_of_file_aliases;
struct AliasDescS * file_aliases; struct AliasDescS * file_aliases;
struct reduction_counters call_counters;
void *foreign_code_loaded; void *foreign_code_loaded;
char *yap_lib_dir; char *yap_lib_dir;
Agc_hook agc_hook; Agc_hook agc_hook;
@ -331,6 +342,7 @@ typedef struct various_codes {
#define OP_RTABLE heap_regs->op_rtable #define OP_RTABLE heap_regs->op_rtable
#endif #endif
#define PROFILING heap_regs->profiling #define PROFILING heap_regs->profiling
#define CALL_COUNTING heap_regs->call_counting
#define UPDATE_MODE heap_regs->update_mode #define UPDATE_MODE heap_regs->update_mode
#define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code #define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code
#define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code #define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code
@ -483,6 +495,12 @@ typedef struct various_codes {
#define NOfFileAliases heap_regs->n_of_file_aliases #define NOfFileAliases heap_regs->n_of_file_aliases
#define SzOfFileAliases heap_regs->sz_of_file_aliases #define SzOfFileAliases heap_regs->sz_of_file_aliases
#define FileAliases heap_regs->file_aliases #define FileAliases heap_regs->file_aliases
#define ReductionsCounter heap_regs->call_counters.reductions
#define PredEntriesCounter heap_regs->call_counters.reductions_retries
#define RetriesCounter heap_regs->call_counters.retries
#define ReductionsCounterOn heap_regs->call_counters.reductions_on
#define PredEntriesCounterOn heap_regs->call_counters.reductions_retries_on
#define RetriesCounterOn heap_regs->call_counters.retries_on
#define ForeignCodeLoaded heap_regs->foreign_code_loaded #define ForeignCodeLoaded heap_regs->foreign_code_loaded
#define Yap_LibDir heap_regs->yap_lib_dir #define Yap_LibDir heap_regs->yap_lib_dir
#define AGCHook heap_regs->agc_hook #define AGCHook heap_regs->agc_hook
@ -491,10 +509,10 @@ typedef struct various_codes {
#define SizeOfOverflow heap_regs->size_of_overflow #define SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime #define LastWtimePtr heap_regs->last_wtime
#ifdef COROUTINING #ifdef COROUTINING
#define WakeUpCode heap_regs->wake_up_code #define WakeUpCode heap_regs->wake_up_code
#define WokenGoals heap_regs->woken_goals #define WokenGoals heap_regs->woken_goals
#define MutableList heap_regs->mutable_list #define MutableList heap_regs->mutable_list
#define AttsMutableList heap_regs->atts_mutable_list #define AttsMutableList heap_regs->atts_mutable_list
#endif #endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define FreeBlocksLock heap_regs->free_blocks_lock #define FreeBlocksLock heap_regs->free_blocks_lock

5
H/YapOpcodes.h
View File

@ -252,6 +252,11 @@
OPCODE(profiled_retry_me ,ld), OPCODE(profiled_retry_me ,ld),
OPCODE(profiled_trust_me ,ld), OPCODE(profiled_trust_me ,ld),
OPCODE(profiled_retry_and_mark ,ld), OPCODE(profiled_retry_and_mark ,ld),
OPCODE(count_call ,l),
OPCODE(count_retry ,l),
OPCODE(count_retry_me ,ld),
OPCODE(count_trust_me ,ld),
OPCODE(count_retry_and_mark ,ld),
OPCODE(try_logical_pred ,l), OPCODE(try_logical_pred ,l),
OPCODE(trust_logical_pred ,l), OPCODE(trust_logical_pred ,l),
OPCODE(alloc_for_logical_pred ,EC), OPCODE(alloc_for_logical_pred ,EC),

4
H/compile.h
View File

@ -150,6 +150,8 @@ typedef enum compiler_op {
f_val_op, f_val_op,
enter_profiling_op, enter_profiling_op,
retry_profiled_op, retry_profiled_op,
count_call_op,
count_retry_op,
restore_tmps_op, restore_tmps_op,
restore_tmps_and_skip_op, restore_tmps_and_skip_op,
empty_call_op, empty_call_op,
@ -273,3 +275,5 @@ extern jmp_buf CompilerBotch;
extern int profiling; extern int profiling;
extern int call_counting;

5
H/rheap.h
View File

@ -599,6 +599,8 @@ RestoreClause(Clause *Cl, int mode)
case _trust_me: case _trust_me:
case _profiled_retry_me: case _profiled_retry_me:
case _profiled_trust_me: case _profiled_trust_me:
case _count_retry_me:
case _count_trust_me:
case _try_me0: case _try_me0:
case _retry_me0: case _retry_me0:
case _trust_me0: case _trust_me0:
@ -617,6 +619,7 @@ RestoreClause(Clause *Cl, int mode)
case _spy_or_trymark: case _spy_or_trymark:
case _try_and_mark: case _try_and_mark:
case _profiled_retry_and_mark: case _profiled_retry_and_mark:
case _count_retry_and_mark:
case _retry_and_mark: case _retry_and_mark:
case _try_clause: case _try_clause:
case _retry: case _retry:
@ -646,7 +649,9 @@ RestoreClause(Clause *Cl, int mode)
break; break;
/* instructions type l */ /* instructions type l */
case _enter_profiling: case _enter_profiling:
case _count_call:
case _retry_profiled: case _retry_profiled:
case _count_retry:
case _try_logical_pred: case _try_logical_pred:
case _trust_logical_pred: case _trust_logical_pred:
case _execute: case _execute:

1
Makefile.in
View File

@ -156,6 +156,7 @@ C_SOURCES= \
PL_SOURCES= \ PL_SOURCES= \
$(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \ $(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \
$(srcdir)/pl/callcount.yap\
$(srcdir)/pl/checker.yap $(srcdir)/pl/consult.yap \ $(srcdir)/pl/checker.yap $(srcdir)/pl/consult.yap \
$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \ $(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
$(srcdir)/pl/directives.yap \ $(srcdir)/pl/directives.yap \

67
docs/yap.tex
View File

@ -155,6 +155,7 @@ Built In Predicates
* OS:: Access to Operating System Functionality * OS:: Access to Operating System Functionality
* Term Modification:: Updating Prolog Terms * Term Modification:: Updating Prolog Terms
* Profiling:: Profiling Prolog Execution * Profiling:: Profiling Prolog Execution
* Calls Execution Limits:: Limiting the Maximum Number of Reductions
* Arrays:: Supporting Global and Local Arrays * Arrays:: Supporting Global and Local Arrays
* Preds:: Information on Predicates * Preds:: Information on Predicates
* Misc:: Miscellaneous Predicates * Misc:: Miscellaneous Predicates
@ -2034,6 +2035,7 @@ Builtins, Debugging, Syntax, Top
* OS:: Access to Operating System Functionality * OS:: Access to Operating System Functionality
* Term Modification:: Updating Prolog Terms * Term Modification:: Updating Prolog Terms
* Profiling:: Profiling Prolog Execution * Profiling:: Profiling Prolog Execution
* Calls Execution Limits:: Limiting the Maximum Number of Reductions
* Arrays:: Supporting Global and Local Arrays * Arrays:: Supporting Global and Local Arrays
* Preds:: Information on Predicates * Preds:: Information on Predicates
* Misc:: Miscellaneous Predicates * Misc:: Miscellaneous Predicates
@ -5646,7 +5648,7 @@ Unify the current value of mutable term @var{M} with term @var{D}.
Set the current value of mutable term @var{M} to term @var{D}. Set the current value of mutable term @var{M} to term @var{D}.
@end table @end table
@node Profiling, Arrays, Term Modification, Top @node Profiling, Call Counting, Term Modification, Top
@section Profiling Prolog Programs @section Profiling Prolog Programs
@cindex profiling @cindex profiling
@ -5723,6 +5725,61 @@ Reset all profiling information.
@end table @end table
@node Call Counting, Arrays, Profiling, Top
@section Counting Calls
@cindex Counting Calls
Predicates compiled with YAP's flag @code{call_counting} set to
@code{on} update counters on the numbers of calls and of
retries. Counters are actually decreasing counters, so that they can be
used as timers. Three counters are available:
@itemize @bullet
@item @code{calls}: number of predicate calls since execution started or since
system was reset;
@item @code{retries}: number of retries for predicates called since
execution started or since counters were reset;
@item @code{calls_and_retries}: count both on predicate calls and
retries.
@end itemize
These counters can be used to find out how many calls a certain
goal takes to execute. They can also be used as timers.
These are the predicates that access and manipulate the call counters:
@table @code
@item call_count_data(-@var{Calls}, -@var{Retries}, -@var{CallsAndRetries})
@findex call_count_data/3
@snindex call_count_data/3
@cnindex call_count_data/3
Give current call count data. The first argument gives the current value
for the @var{Calls} counter, next the @var{Retries} counter, and last
the @var{CallsAndRetries} counter.
@item call_count_reset
@findex call_count_data/0
@snindex call_count_data/0
@cnindex call_count_data/0
Reset call count counters. All timers are also reset.
@item call_count(?@var{CallsMax}, ?@var{RetriesMax}, ?@var{CallsAndRetriesMax})
@findex call_count_data/3
@snindex call_count_data/3
@cnindex call_count_data/3
Set call count counter as timers. YAP will generate an exception
if one of the instantiated call counters decreases to 0. YAP will ignore
unbound arguments:
@itemize @bullet
@item @var{CallsMax}: throw the exception @code{call_counter} when the
counter @code{calls} reaches 0;
@item @var{RetriesMax}: throw the exception @code{retry_counter} when the
counter @code{retries} reaches 0;
@item @var{CallsAndRetriesMax}: throw the exception
@code{call_and_retry_counter} when the counter @code{calls_and_retries}
reaches 0.
@end itemize
@end table
@node Arrays, Preds, Profiling , Top @node Arrays, Preds, Profiling , Top
@section Arrays @section Arrays
@ -6036,6 +6093,14 @@ arguments to Yap after @code{--}.
Read-only flag telling whether integers are bounded. The value depends Read-only flag telling whether integers are bounded. The value depends
on whether YAP uses the GMP library or not. on whether YAP uses the GMP library or not.
@item profiling
@findex call_counting (yap_flag/2 option)
@*
If @code{off} (default) do not compile call counting information for
procedures. If @code{on} compile predicates so that they calls and
retries to the predicate may be counted. Profiling data can be read through the
@code{call_count_data/3} built-in.
@item char_conversion [ISO] @item char_conversion [ISO]
@findex char_conversion (yap_flag/2 option) @findex char_conversion (yap_flag/2 option)
@* @*

20
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.29 2002-06-17 15:28:00 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.30 2002-09-03 14:28:08 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -102,7 +102,7 @@
#undef USE_THREADED_CODE #undef USE_THREADED_CODE
#endif #endif
#define inline __inline #define inline __inline
#define YAP_VERSION "Yap-4.3.21" #define YAP_VERSION "Yap-4.3.23"
#define BIN_DIR "c:\\Program Files\\Yap\\bin" #define BIN_DIR "c:\\Program Files\\Yap\\bin"
#define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap" #define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap"
#define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap" #define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap"
@ -220,6 +220,19 @@
#define SHORT_INTS 0 #define SHORT_INTS 0
#endif #endif
#ifdef USE_GMP
#ifdef __GNUC__
typedef long long int SIGNED_YAP_LONG_LONG;
typedef unsigned long long int YAP_LONG_LONG;
#else
typedef long int SIGNED_YAP_LONG_LONG;
typedef unsigned long int YAP_LONG_LONG;
#endif
#else
typedef long int SIGNED_YAP_LONG_LONG;
typedef unsigned long int YAP_LONG_LONG;
#endif
#if DEBUG #if DEBUG
extern char Option[20]; extern char Option[20];
#endif #endif
@ -390,6 +403,7 @@ typedef enum {
FATAL_ERROR, FATAL_ERROR,
INTERNAL_ERROR, INTERNAL_ERROR,
PURE_ABORT, PURE_ABORT,
CALL_COUNTER_UNDERFLOW,
/* ISO_ERRORS */ /* ISO_ERRORS */
DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR_ARRAY_OVERFLOW,
DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR_ARRAY_TYPE,
@ -435,9 +449,11 @@ typedef enum {
PERMISSION_ERROR_OUTPUT_TEXT_STREAM, PERMISSION_ERROR_OUTPUT_TEXT_STREAM,
PERMISSION_ERROR_RESIZE_ARRAY, PERMISSION_ERROR_RESIZE_ARRAY,
PERMISSION_ERROR_REPOSITION_STREAM, PERMISSION_ERROR_REPOSITION_STREAM,
PRED_ENTRY_COUNTER_UNDERFLOW,
REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR_CHARACTER,
REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR_CHARACTER_CODE,
REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR_MAX_ARITY,
RETRY_COUNTER_UNDERFLOW,
SYNTAX_ERROR, SYNTAX_ERROR,
SYSTEM_ERROR, SYSTEM_ERROR,
TYPE_ERROR_ARRAY, TYPE_ERROR_ARRAY,

1
m4/Yatom.h.m4
View File

@ -162,6 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
CodeOfPred holds the address of the correspondent C-function. CodeOfPred holds the address of the correspondent C-function.
*/ */
typedef enum { typedef enum {
CountPredFlag = 0x4000000L, /* count calls to pred */
HiddenPredFlag = 0x2000000L, /* ! should ! across */ HiddenPredFlag = 0x2000000L, /* ! should ! across */
CArgsPredFlag = 0x1000000L, /* ! should ! across */ CArgsPredFlag = 0x1000000L, /* ! should ! across */
CutTransparentPredFlag = 0x800000L, /* ! should ! across */ CutTransparentPredFlag = 0x800000L, /* ! should ! across */

36
pl/callcount.yap Normal file
View File

@ -0,0 +1,36 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: callcount.yap *
* Last rev: 8/2/02 *
* mods: *
* comments: Some profiling predicates available in yap *
* *
*************************************************************************/
call_count_data(Calls, Retries, Both) :-
'$call_count_info'(Calls, Retries, Both).
call_count_reset :-
'$call_count_reset'.
call_count(Calls, Retries, Both) :-
'$check_if_call_count_on'(Calls, CallsOn),
'$check_if_call_count_on'(Retries, RetriesOn),
'$check_if_call_count_on'(Both, BothOn),
'$call_count_set'(Calls, CallsOn, Retries, RetriesOn, Both, BothOn).
'$check_if_call_count_on'(Calls, 1) :- integer(Calls), !.
'$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
'$check_if_call_count_on'(Calls, _) :-
throw(error(type_error(integer,Calls),call_count(A))).

3
pl/directives.yap
View File

@ -181,6 +181,9 @@ yap_flag(dollar_as_lower_case,off) :-
yap_flag(profiling,X) :- (var(X); X = on; X = off), !, yap_flag(profiling,X) :- (var(X); X = on; X = off), !,
'$is_profiled'(X). '$is_profiled'(X).
yap_flag(call_counting,X) :- (var(X); X = on; X = off), !,
'$is_call_counted'(X).
yap_flag(bounded,X) :- yap_flag(bounded,X) :-
var(X), !, var(X), !,
'$access_yap_flags'(0, X1), '$access_yap_flags'(0, X1),

1
pl/init.yap
View File

@ -58,6 +58,7 @@ false :- fail.
% with meta-predicate expansion being invoked % with meta-predicate expansion being invoked
'modules.yap', 'modules.yap',
'profile.yap', 'profile.yap',
'callcount.yap',
'load_foreign.yap', 'load_foreign.yap',
'sockets.yap', 'sockets.yap',
'sort.yap', 'sort.yap',