From ba2c0ca2a0d991c99b9a5306f6eb2a954a75ee9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 11 Dec 2013 01:05:51 +0000 Subject: [PATCH] support no trace predicates --- C/cdmgr.c | 53 +++++++++++++++++++++++++++++++++++ C/qlyr.c | 20 +++++++++++-- C/qlyw.c | 3 ++ H/Yapproto.h | 2 +- H/Yatom.h | 5 +++- H/qly.h | 1 + library/dialect/swi/fli/swi.c | 3 ++ pl/boot.yap | 2 +- pl/signals.yap | 11 ++++++-- 9 files changed, 92 insertions(+), 8 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index 4a0c36b35..0d4a85597 100644 --- a/C/cdmgr.c +++ b/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); diff --git a/C/qlyr.c b/C/qlyr.c index 0a066e9bc..3c4848335 100755 --- a/C/qlyr.c +++ b/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); } } diff --git a/C/qlyw.c b/C/qlyw.c index 28347fa62..f643740e6 100755 --- a/C/qlyw.c +++ b/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)); diff --git a/H/Yapproto.h b/H/Yapproto.h index 50c71c638..4fce035c4 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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); diff --git a/H/Yatom.h b/H/Yatom.h index b2df9b8b8..85b5dd312 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -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 */ diff --git a/H/qly.h b/H/qly.h index 379e8b565..3b619d5aa 100644 --- a/H/qly.h +++ b/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) diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index cbe474043..0ff820926 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -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) diff --git a/pl/boot.yap b/pl/boot.yap index eeed650bc..283ef92e0 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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,_), diff --git a/pl/signals.yap b/pl/signals.yap index bd629c42c..b9611982c 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -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).