support no trace predicates

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);

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 {

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));

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);

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 */

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)
 

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)

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,_),

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'], _) :- !,
+'$start_creep'([M|G], _) :-
-	'$enter_system_mode'.
+	'$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).