support no trace predicates
This commit is contained in:
parent
2f8c3d2d1b
commit
ba2c0ca2a0
53
C/cdmgr.c
53
C/cdmgr.c
@ -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);
|
||||
|
20
C/qlyr.c
20
C/qlyr.c
@ -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);
|
||||
}
|
||||
}
|
||||
|
3
C/qlyw.c
3
C/qlyw.c
@ -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));
|
||||
|
@ -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);
|
||||
|
@ -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 */
|
||||
|
1
H/qly.h
1
H/qly.h
@ -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)
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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,_),
|
||||
|
@ -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).
|
||||
|
||||
|
Reference in New Issue
Block a user