support no trace predicates

This commit is contained in:
Vítor Santos Costa 2013-12-11 01:05:51 +00:00
parent 2f8c3d2d1b
commit ba2c0ca2a0
9 changed files with 92 additions and 8 deletions

View File

@ -2735,6 +2735,57 @@ p_purge_clauses( USES_REGS1 )
******************************************************************/
static Int
p_is_no_trace( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
if (pe->ExtraPredFlags & NoTracePredFlag) {
UNLOCKPE(57,pe);
return TRUE;
}
UNLOCKPE(59,pe);
return FALSE;
}
static Int
p_set_no_trace( USES_REGS1 )
{ /* '$set_no_trace'(+Fun,+M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
int
Yap_SetNoTrace(char *name, UInt arity, Term tmod)
{
PredEntry *pe;
if (arity == 0) {
pe = get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
} else {
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity),tmod));
}
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
static Int
p_setspy( USES_REGS1 )
{ /* '$set_spy'(+Fun,+M) */
@ -6420,6 +6471,8 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$kill_dynamic", 2, p_kill_dynamic, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$new_multifile", 3, p_new_multifile, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$is_multifile", 2, p_is_multifile, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_no_trace", 2, p_is_no_trace, TestPredFlag | SafePredFlag);
Yap_InitCPred("$set_no_trace", 2, p_set_no_trace, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$profile_info", 3, p_profile_info, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$profile_reset", 2, p_profile_reset, SafePredFlag|SyncPredFlag);

View File

@ -932,18 +932,32 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
static void
read_pred(IOSTREAM *stream, Term mod) {
UInt flags;
#if SIZEOF_INT_P==4
UInt eflags;
#endif
UInt nclauses, fl1;
PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_uint(stream));
flags = read_uint(stream);
#if SIZEOF_INT_P==4
eflags = read_uint(stream);
#endif
nclauses = read_uint(stream);
if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap);
}
fl1 = flags & STATIC_PRED_FLAGS;
ap->PredFlags &= ~STATIC_PRED_FLAGS;
#if SIZEOF_INT_P==4
fl1 = flags & ((UInt)STATIC_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS);
ap->PredFlags |= fl1;
ap->ExtraPredFlags = eflags;
#else
fl1 = flags & ((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags |= fl1;
#endif
if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_uint(stream);
} else {
@ -957,7 +971,7 @@ read_pred(IOSTREAM *stream, Term mod) {
if (flags & MultiFileFlag && ap->ModuleOfPred == PROLOG_MODULE)
ap->ModuleOfPred = TermProlog;
read_clauses(stream, ap, nclauses, flags);
if (flags & HiddenPredFlag) {
if (flags & HiddenPredFlag) {
Yap_HidePred(ap);
}
}

View File

@ -688,6 +688,9 @@ static size_t
save_pred(IOSTREAM *stream, PredEntry *ap) {
CHECK(save_uint(stream, (UInt)ap));
CHECK(save_uint(stream, ap->PredFlags));
#if SIZEOF_INT_P==4
CHECK(save_uint(stream, ap->ExtraPredFlags));
#endif
CHECK(save_uint(stream, ap->cs.p_code.NOfClauses));
CHECK(save_uint(stream, ap->src.IndxId));
CHECK(save_uint(stream, ap->TimeStampOfPred));

View File

@ -127,7 +127,7 @@ void Yap_EraseMegaClause(yamop *,struct pred_entry *);
void Yap_ResetConsultStack(void);
void Yap_AssertzClause(struct pred_entry *, yamop *);
void Yap_HidePred(struct pred_entry *pe);
int Yap_SetNoTrace(char *name, UInt arity, Term tmod);
/* cmppreds.c */
Int Yap_compare_terms(Term,Term);

View File

@ -650,10 +650,13 @@ IsValProperty (int flags)
for the pred.
C_Preds are things write, read, ... implemented in C. In this case
CodeOfPred holds the address of the correspondent C-function.
don;t forget to also add in qly.h
*/
typedef enum
{
QuasiQuotationPredFlag = ((UInt)0x00000001 << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */
NoTracePredFlag = ((UInt)0x00000002L << EXTRA_FLAG_BASE), /* cannot trace this preducate */
QuasiQuotationPredFlag = ((UInt)0x00000001L << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */
MegaClausePredFlag = 0x80000000L, /* predicate is implemented as a mega-clause */
ThreadLocalPredFlag = 0x40000000L, /* local to a thread */
MultiFileFlag = 0x20000000L, /* is multi-file */

View File

@ -102,6 +102,7 @@ typedef enum {
} qlf_tag_t;
#define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag)
#define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag)
#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)

View File

@ -2311,6 +2311,9 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
} else {
UserCPredicate((char *)name,(CPredicate)function,arity,tmod,nflags);
}
if (flags & PL_FA_NOTRACE) {
Yap_SetNoTrace((char *)name, arity, tmod);
}
}
X_API void PL_register_extensions(const PL_extension *ptr)

View File

@ -1220,7 +1220,7 @@ catch_ball(C, C).
'$exit_system_mode' :-
'$system_mode'(false),
( '$nb_getval'('$trace',on,fail) -> '$meta_creep' ; true).
( '$nb_getval'('$trace',on,fail) -> '$creep' ; true).
'$run_at_thread_start' :-
recorded('$thread_initialization',M:D,_),

View File

@ -89,8 +89,9 @@
'$execute0'((Goal,M:G),M0).
% we may be creeping outside and coming back to system mode.
'$start_creep'([_|'$enter_system_mode'], _) :- !,
'$enter_system_mode'.
'$start_creep'([M|G], _) :-
'$is_no_trace'(G, M), !,
'$execute0'(G, M).
'$start_creep'([Mod|G], _) :-
'$in_system_mode', !,
'$execute0'(G, Mod).
@ -197,5 +198,11 @@ read_sig :-
fail.
read_sig.
%
% make thes predicates non-traceable.
:- '$set_no_trace'(true, prolog).
:- '$set_no_trace'('$enter_system_mode', prolog).
:- '$set_no_trace'('$do_trace', prolog).
:- '$set_no_trace'('$call'(_,_,_,_), prolog).