fix mess with add clause

improves on sigsegv handling


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1239 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/cdmgr.c

@@ -11,8 +11,12 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2005-01-28 23:14:34 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-02-08 04:05:23 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.150  2005/01/28 23:14:34  vsc
+* move to Yap-4.5.7
+* Fix clause size
+*
 * Revision 1.149  2005/01/05 05:35:01  vsc
 * get rid of debugging stub.
 *
@@ -2058,12 +2062,16 @@ p_compile_dynamic(void)
   Term            t1 = Deref(ARG2);
   Term            mod = Deref(ARG4);
   yamop        *code_adr;
-  int             old_optimize;
+  int             old_optimize, mode;
 
-  if (IsVarTerm(t1) || !IsAtomTerm(t1))
+  if (IsVarTerm(t1) || !IsAtomicTerm(t1))
     return FALSE;
   if (IsVarTerm(mod) || !IsAtomTerm(mod))
     return FALSE;
+  if (IsAtomTerm(t1)) {
+    if (RepAtom(AtomOfTerm(t1))->StrOfAE[0] == 'f') mode = asserta;
+    else mode = assertz;						    
+  } else mode = IntegerOfTerm(t1);
   old_optimize = optimizer_on;
   optimizer_on = FALSE;
   YAPEnterCriticalSection();
@@ -2074,7 +2082,7 @@ p_compile_dynamic(void)
     
     
     optimizer_on = old_optimize;
-    addclause(t, code_adr, RepAtom(AtomOfTerm(t1))->StrOfAE[0] == 'f', mod, &ARG5);
+    addclause(t, code_adr, mode , mod, &ARG5);
   } 
   if (Yap_ErrorMessage) {
     if (!Yap_Error_Term)
@@ -2425,7 +2433,7 @@ p_new_multifile(void)
   if (IsIntTerm(t))
     arity = IntOfTerm(t);
   else
-    return (FALSE);
+    return FALSE;
   if (arity == 0) 
     pe = RepPredProp(PredPropByAtom(at, mod));
   else 

C/errors.c

@@ -299,8 +299,12 @@ dump_stack(void)
 static void
 error_exit_yap (int value)
 {
-  if (!Yap_PrologMode & BootMode)
+  if (!Yap_PrologMode & BootMode) {
+#if DEBUG
+    fprintf(stderr,"%d garbage collections\n", GcCalls);
+#endif
     dump_stack();
+  }
   Yap_exit(value);
 }
 

C/exec.c

@@ -230,6 +230,7 @@ EnterCreepMode(Term t, Term mod) {
   LOCK(SignalLock);
   CreepFlag = CalculateStackGap();
   UNLOCK(SignalLock);
+  yap_flags[SPY_CREEP_FLAG] = TRUE;
   P_before_spy = P;
   return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred));
 }

C/stdpreds.c

@@ -11,8 +11,11 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2005-01-05 05:32:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-02-08 04:05:35 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.80  2005/01/05 05:32:37  vsc
+* Ricardo's latest version of profiler.
+*
 * Revision 1.79  2004/12/28 22:20:36  vsc
 * some extra bug fixes for trail overflows: some cannot be recovered that easily,
 * some can.
@@ -655,6 +658,23 @@ p_creep(void)
   return TRUE;
 }
 
+static Int 
+p_delayed_creep(void)
+{
+  Atom            at;
+  PredEntry      *pred;
+
+  at = Yap_FullLookupAtom("$creep");
+  pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
+  CreepCode = pred;
+  yap_flags[SPY_CREEP_FLAG] = FALSE;
+  do_signal(YAP_CREEP_SIGNAL);
+  LOCK(SignalLock);
+  CreepFlag = CalculateStackGap();
+  UNLOCK(SignalLock);
+  return TRUE;
+}
+
 static Int 
 p_stop_creep(void)
 {
@@ -2959,7 +2979,8 @@ Yap_InitCPreds(void)
   /* they are defined in analyst.c */
   /* Basic predicates for the debugger */
   Yap_InitCPred("$creep", 0, p_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred("$stop_creep", 0, p_stop_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$late_creep", 0, p_delayed_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$do_not_creep", 0, p_stop_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
 #ifdef DEBUG
   Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag|HiddenPredFlag);
 #endif

C/sysbits.c

@@ -879,7 +879,8 @@ HandleSIGSEGV(int   sig,   siginfo_t   *sip, ucontext_t *uap)
 {
 
 #if !USE_SYSTEM_MALLOC
-  if (sip->si_code != SI_NOINFO &&
+  if (
+      sip->si_code != SI_NOINFO &&
       sip->si_code == SEGV_MAPERR &&
       (void *)(sip->si_addr) > (void *)(Yap_HeapBase) &&
       (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) {
@@ -950,6 +951,135 @@ my_signal(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
   sigaction(sig,&sigact,NULL);
 }
 
+#elif defined(__linux__)
+
+STATIC_PROTO (RETSIGTYPE HandleMatherr, (int));
+STATIC_PROTO (RETSIGTYPE HandleSIGSEGV, (int,siginfo_t *,void *));
+STATIC_PROTO (void my_signal_info, (int, void (*)(int,siginfo_t *,void *)));
+STATIC_PROTO (void my_signal, (int, void (*)(int)));
+
+/******** Handling floating point errors *******************/
+
+
+/* old code, used to work with matherror(), deprecated now:
+  char err_msg[256];
+  switch (x->type)
+    {
+    case DOMAIN:
+    case SING:
+      Yap_Error(EVALUATION_ERROR_UNDEFINED, TermNil, "%s", x->name);
+      return(0);
+    case OVERFLOW:
+      Yap_Error(EVALUATION_ERROR_FLOAT_OVERFLOW, TermNil, "%s", x->name);
+      return(0);
+    case UNDERFLOW:
+      Yap_Error(EVALUATION_ERROR_FLOAT_UNDERFLOW, TermNil, "%s", x->name);
+      return(0);
+    case PLOSS:
+    case TLOSS:
+      Yap_Error(EVALUATION_ERROR_UNDEFINED, TermNil, "%s(%g) = %g", x->name,
+	       x->arg1, x->retval);
+      return(0);
+    default:
+      Yap_Error(EVALUATION_ERROR_UNDEFINED, TermNil, NULL);
+      return(0);
+    }
+  */
+
+
+#if HAVE_FENV_H
+#include <fenv.h>
+#endif
+
+static RETSIGTYPE
+HandleMatherr(int sig)
+{
+#if HAVE_FETESTEXCEPT
+
+  /* This should work in Linux, but it doesn't seem to. */
+  
+  int raised = fetestexcept(FE_ALL_EXCEPT);
+
+  if (raised & FE_OVERFLOW) {
+    Yap_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
+  } else if (raised & (FE_INVALID|FE_INEXACT)) {
+    Yap_matherror = EVALUATION_ERROR_UNDEFINED;
+  } else if (raised & FE_DIVBYZERO) {
+    Yap_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
+  } else if (raised & FE_UNDERFLOW) {
+    Yap_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
+  } else
+#endif
+    Yap_matherror = EVALUATION_ERROR_UNDEFINED;
+  /* something very bad happened on the way to the forum */
+  set_fpu_exceptions(FALSE);
+  Yap_Error(Yap_matherror, TermNil, "");
+}
+
+static void
+SearchForTrailFault(siginfo_t *siginfo)
+{
+  void *ptr = siginfo->si_addr;
+
+  fprintf(stderr,"error at %p\n",ptr);
+  /* If the TRAIL is very close to the top of mmaped allocked space,
+     then we can try increasing the TR space and restarting the
+     instruction. In the worst case, the system will
+     crash again
+     */
+#if  OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC
+  if ((ptr > (void *)Yap_TrailTop-1024  && 
+       TR < (void *)Yap_TrailTop+(64*1024))) {
+    if (!Yap_growtrail(64*1024, TRUE)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP failed to reserve %ld bytes in growtrail", 64*1024L);
+    }
+    /* just in case, make sure the OS keeps the signal handler. */
+    /*    my_signal_info(SIGSEGV, HandleSIGSEGV); */
+  } else
+#endif /* OS_HANDLES_TR_OVERFLOW */
+    {
+      Yap_Error(FATAL_ERROR, TermNil,
+		"likely bug in YAP, segmentation violation at %p", ptr);
+  }
+}
+
+static RETSIGTYPE
+HandleSIGSEGV(int   sig, siginfo_t *siginfo, void *context)
+{
+  if (Yap_PrologMode & ExtendStackMode) {
+    Yap_Error(FATAL_ERROR, TermNil, "OS memory allocation crashed at address %p, bailing out\n",Yap_TrailTop);
+  }
+  SearchForTrailFault(siginfo);
+}
+
+static void
+my_signal_info(int sig, void (*handler)(int,siginfo_t *,void *))
+{
+  struct sigaction sigact;
+
+  sigact.sa_sigaction = handler;
+  sigemptyset(&sigact.sa_mask);
+#if HAVE_SIGINFO
+  sigact.sa_flags = SA_SIGINFO;
+#else
+  sigact.sa_flags = 0;
+#endif
+
+  sigaction(sig,&sigact,NULL);
+}
+
+static void
+my_signal(int sig, void (*handler)(int))
+{
+  struct sigaction sigact;
+
+  sigact.sa_handler=handler;
+  sigemptyset(&sigact.sa_mask);
+  sigact.sa_flags = 0;
+
+  sigaction(sig,&sigact,NULL);
+}
+
 #else /* if not (defined(__svr4__) || defined(__SVR4)) */
 
 STATIC_PROTO (RETSIGTYPE HandleMatherr, (int));

CLPBN/clpbn/evidence.yap

@@ -3,6 +3,8 @@
 %
 %
 
+
+
 :- module(evidence, [
 	store_evidence/1,
         incorporate_evidence/2
@@ -22,7 +24,7 @@
 
 :- meta_predicate store_evidence(:).
 
-:- dynamic node/4, reachable_from_evidence/2, evidence/2.
+:- dynamic node/4, edge/2, evidence/2.
 
 %
 % new evidence storage algorithm. The idea is that instead of 
@@ -39,8 +41,7 @@ store_evidence(G) :-
 
 compute_evidence(G, PreviousSolver) :-
 	catch(call_residue(G, Vars), Ball, evidence_error(Ball,PreviousSolver)), !,
-	store_graph(Vars,KEv),
+	store_graph(Vars),
-	mark_from_evidence(Vars,KEv),
 	set_clpbn_flag(solver,PreviousSolver).
 compute_evidence(_, PreviousSolver) :-
 	set_clpbn_flag(solver,PreviousSolver).
@@ -50,22 +51,21 @@ evidence_error(Ball,PreviousSolver) :-
 	set_clpbn_flag(solver,PreviousSolver),
 	throw(Ball).
 
-store_graph([], _).
+store_graph([]).
-store_graph([_-node(K,Dom,CPT,TVs,Ev)|Vars], Kev) :-
+store_graph([_-node(K,Dom,CPT,TVs,Ev)|Vars]) :-
 	\+ node(K,_,_,_), !,
 	assert(node(K,Dom,CPT,TVs)),
-	( nonvar(Ev) -> assert(evidence(K,Ev)), Kev = K ; true),
+	( nonvar(Ev) -> assert(evidence(K,Ev)) ; true),
-	store_graph(Vars, Kev).
+	add_links(TVs,K),
-store_graph([_|Vars], Kev) :-
+	store_graph(Vars).
-	store_graph(Vars, Kev).
+store_graph([_|Vars]) :-
+	store_graph(Vars).
+
+add_links([],_).
+add_links([K0|TVs],K) :-
+	assert(edge(K,K0)),
+	add_links(TVs,K).
 
-mark_from_evidence([], _).
-mark_from_evidence([_-node(K,_,_,_,_)|Vars], Kev) :-
-	\+ reachable_from_evidence(K,Kev), !,
-	assert(reachable_from_evidence(K,Kev)),
-	mark_from_evidence(Vars, Kev).
-mark_from_evidence([_|Vars], Kev) :-
-	mark_from_evidence(Vars, Kev).
 
 incorporate_evidence(Vs,AllVs) :-
 	new(Cache0),
@@ -116,6 +116,5 @@ add_evidence(_, _).
 check_for_evidence(_, V, Vf, Vf, C, C) :-
 	clpbn:get_atts(V, [evidence(_)]), !.
 check_for_evidence(K, _, Vf0, Vff, C0, Ci) :-
-	findall(Rt,reachable_from_evidence(K,Rt),Rts),
+	findall(Rt,edge(Rt,K),Rts),
 	add_variables(Rts, _, Vf0, Vff, C0, Ci).
-

CLPBN/clpbn/vel.yap

@@ -68,11 +68,11 @@ get_rid_of_ev_vars([V|LVs0],[V|LVs]) :-
 
 
 find_all_clpbn_vars([], [], [], []) :- !.
-find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Deps,Sizes)|Tables]) :-
+find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Sizes)|Tables]) :-
-	var_with_deps(V, Table, Deps, Sizes, Ev, Vals), !,
+	var_with_deps(V, Table, Parents, Sizes, Ev, Vals), !,
 	% variables with evidence should not be processed.
 	(var(Ev) ->
-	    Var = var(V,I,Sz,Vals,Ev,_,_),
+	    Var = var(V,I,Sz,Vals,Parents,Ev,_,_),
 	    get_dist_size(V,Sz),
 	    ProcessedVars = [Var|ProcessedVars0]
 	;
@@ -81,9 +81,9 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Deps,Sizes)|
 	find_all_clpbn_vars(Vs, LV, ProcessedVars0, Tables).
 
 var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :-
-	clpbn:get_atts(V, [dist(Vals,OTable,VDeps)]),
+	clpbn:get_atts(V, [dist(Vals,OTable,Parents)]),
 	( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true),
-	reorder_table([V|VDeps],Sizes0,OTable,Deps0,Table0),
+	reorder_table([V|Parents],Sizes0,OTable,Deps0,Table0),
 	simplify_evidence(Deps0, Table0, Deps0, Sizes0, Table, Deps, Sizes).
 
 get_sizes([], []).
@@ -146,7 +146,7 @@ add_table_deps([V|Deps], I, Deps0, Table, Sizes, DepGraph0, [V-tab(Table,Deps0,S
 	add_table_deps(Deps, I, Deps0, Table, Sizes, DepGraph0, DepGraph).
 
 add_table_deps_to_variables([], []).
-add_table_deps_to_variables([var(V,_,_,_,_,Deps,K)|LV], DepGraph) :-
+add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :-
 	steal_deps_for_variable(DepGraph, V, NDepGraph, Deps),
 	compute_size(Deps,[],K),
 %	( clpbn:get_atts(V,[key(Key)]) -> write(Key:K), nl ; true),
@@ -186,14 +186,16 @@ process(LV0, _, Out) :-
 find_best([], V, _TF, V, _, [], _).
 %:-
 %	clpbn:get_atts(V,[key(K)]), write(chosen:K:TF), nl.
-find_best([var(V,I,Sz,Vals,Ev,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
+% root_with_single_child
+%find_best([var(V,I,_,_,[],Ev,[Dep],K)|LV], _, _, V, [Dep], LVF, Inputs) :- !.	
+find_best([var(V,I,Sz,Vals,Parents,Ev,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
 	( K < Threshold ; Threshold < 0),
 	clpbn_not_var_member(Inputs, V), !,
 	find_best(LV, V, K, VF, WorkTables,LV0, Inputs),
 	(V == VF ->
 	    LVF = LV0, Deps = NWorktables
 	;
-	    LVF = [var(V,I,Sz,Vals,Ev,Deps,K)|LV0], WorkTables = NWorktables
+	    LVF = [var(V,I,Sz,Vals,Parents,Ev,Deps,K)|LV0], WorkTables = NWorktables
 	).
 find_best([V|LV], V0, Threshold, VF, WorkTables, [V|LVF], Inputs) :-
 	find_best(LV, V0, Threshold, VF, WorkTables, LVF, Inputs).
@@ -227,7 +229,7 @@ generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :-
 
 
 fetch_tables([], []).
-fetch_tables([var(_,_,_,_,_,Deps,_)|LV0], Tables) :-
+fetch_tables([var(_,_,_,_,_,_,Deps,_)|LV0], Tables) :-
 	append(Deps,Tables0,Tables),
 	fetch_tables(LV0, Tables0).
 
@@ -326,10 +328,10 @@ project_inner_loop(I,Sz,[_|Evs],NBase,F,Table,Ent0,Ent) :- !,
 	
 	
 include([],_,_,[]).
-include([var(V,P,VSz,D,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Ev,Tabs,Est)|NLV]) :-
+include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Parents,Ev,Tabs,Est)|NLV]) :-
 	clpbn_not_var_member(Vs,V), !,
 	include(LV,tab(T,Vs,Sz),V1,NLV).
-include([var(V,P,VSz,D,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Ev,NTabs,NEst)|NLV]) :-
+include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :-
 	update_tables(Tabs,NTabs,Table,NV),
 	compute_size(NTabs, [], NEst),
 %	( clpbn:get_atts(V,[key(Key)]) -> write(Key:NEst), nl ; true),

pl/boot.yap

@@ -260,25 +260,18 @@ repeat :- '$repeat'.
 '$process_directive'(G, top, _) :- !,
 	'$do_error'(context_error((:- G),clause),query).
 %
-% always allow directives.
-%
-'$process_directive'(D, Mode, M) :-
-	'$directive'(D), !,
-	( '$exec_directive'(D, Mode, M) -> true ; true ).
-%
-% allow multiple directives
-%
-'$process_directive'((G1,G2), Mode, M) :-
-	'$all_directives'(G1),
-	'$all_directives'(G2), !,
-	'$exec_directives'(G1, Mode, M),
-	'$exec_directives'(G2, Mode, M).
-%
 % allow modules
 %
 '$process_directive'(M:G, Mode, _) :- !,
 	'$process_directive'(G, Mode, M).
 %
+% default case
+%
+'$process_directive'(Gs, Mode, M) :-
+	'$all_directives'(Gs), !,
+	'$exec_directives'(Gs, Mode, M).
+
+%
 % ISO does not allow goals (use initialization).
 %
 '$process_directive'(D, _, M) :-
@@ -288,15 +281,8 @@ repeat :- '$repeat'.
 % but YAP and SICStus does.
 %
 '$process_directive'(G, _, M) :-
-	( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
+	( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ),
-
+	'$do_not_creep'.
-'$all_directives'(_:G1) :- !,
-	'$all_directives'(G1).
-'$all_directives'((G1,G2)) :- !,
-	'$all_directives'(G1),
-	'$all_directives'(G2).
-'$all_directives'(G) :- !,
-	'$directive'(G).
 
 '$continue_with_command'(reconsult,V,G,Source) :-
 	'$go_compile_clause'(G,V,5,Source),
@@ -305,7 +291,8 @@ repeat :- '$repeat'.
 	'$go_compile_clause'(G,V,13,Source),
 	fail.
 '$continue_with_command'(top,V,G,_) :-
-	'$query'(G,V).
+	'$query'(G,V),
+	'$do_not_creep'.
 
 %
 % not 100% compatible with SICStus Prolog, as SICStus Prolog would put
@@ -386,14 +373,14 @@ repeat :- '$repeat'.
 	(
 	        ( recorded('$trace',on,_) -> '$creep' ; true),
 		'$execute'(G),
-		'$do_stop_creep',
+		'$do_not_creep',
 		'$extract_goal_vars_for_dump'(V,LIV),
 		'$show_frozen'(G,LIV,LGs),
 		'$write_answer'(V, LGs, Written),
 		'$write_query_answer_true'(Written),
 		'$another',
 		!, fail ;
-		'$do_stop_creep',
+		'$do_not_creep',
 		( '$undefined'('$print_message'(_,_),prolog) -> 
 		   '$present_answer'(user_error,"no~n", [])
 	        ;
@@ -405,7 +392,7 @@ repeat :- '$repeat'.
 '$yes_no'(G,C) :-
 	'$current_module'(M),
 	'$do_yes_no'(G,M),
-	'$do_stop_creep',
+	'$do_not_creep',
 	'$show_frozen'(G, [], LGs),
 	'$write_answer'([], LGs, Written),
         ( Written = [] ->
@@ -414,7 +401,7 @@ repeat :- '$repeat'.
 	),
 	fail.
 '$yes_no'(_,_) :-
-	'$do_stop_creep',
+	'$do_not_creep',
 	( '$undefined'('$print_message'(_,_),prolog) -> 
 	   '$present_answer'(user_error,"no~n", [])
 	;
@@ -422,15 +409,11 @@ repeat :- '$repeat'.
 	),
 	fail.
 
-% make sure we have Prolog code to force running any delayed goals.
-'$do_stop_creep' :-
-	'$stop_creep'.
-
-
 '$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
 '$do_yes_no'(G, M) :-
 	  ( recorded('$trace',on,_) -> '$creep' ; true),
 	  '$execute'(M:G).
+
 '$extract_goal_vars_for_dump'([],[]).
 '$extract_goal_vars_for_dump'([[_|V]|VL],[V|LIV]) :-
 	'$extract_goal_vars_for_dump'(VL,LIV).
@@ -845,8 +828,10 @@ break :-
 	;
 	    '$print_message'(informational, loading(consulting, File))
 	),
+	( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
 	'$loop'(Stream,consult),
 	'$end_consult',
+	( nonvar(TraceR) -> recorda('$trace', on, _) ; true),
 	set_value('$consulting',Old),
 	set_value('$consulting_file',OldF),
 	'$current_module'(NewMod,OldModule),
@@ -955,7 +940,7 @@ break :-
 '$find_in_path'(user_input,user_input, _) :- !.
 '$find_in_path'(S,NewFile, _) :-
 	S =.. [Name,File], !,
-	user:file_search_path(Name, Dir),
+	( user:file_search_path(Name, Dir) -> '$do_not_creep' ; '$do_not_creep'),
 	'$dir_separator'(D),
 	atom_codes(A,[D]),
 	atom_concat([Dir,A,File],NFile),
@@ -990,11 +975,13 @@ break :-
 
 expand_term(Term,Expanded) :-
 	( \+ '$undefined'(term_expansion(_,_), user),
-	  user:term_expansion(Term,Expanded)
+	  user:term_expansion(Term,Expanded),
+	 '$do_not_creep'
         ;
+	  '$do_not_creep',
 	  '$expand_term_grammar'(Term,Expanded)
 	),
-	!.
+!.
 
 
 %
@@ -1090,15 +1077,14 @@ throw(Ball) :-
 	G \= '$',
 	'$current_module'(M),
 	'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
+	'$do_not_creep',
 	fail.
 '$exec_initialisation_goals'.
 
 '$run_toplevel_hooks' :-
 	get_value('$break',0),
 	recorded('$toplevel_hooks',H,_), !,
-	( '$execute'(H) -> true ; true).
+	( '$execute'(H) -> true ; true),
+	'$do_not_creep'.
 '$run_toplevel_hooks'.
 
-
-
-

pl/consult.yap

@@ -126,8 +126,10 @@ reconsult(Fs) :-
 	'$remove_multifile_clauses'(File),
 	recorda('$initialisation','$',_),
 	'$print_message'(informational, loading(reconsulting, File)),
+	( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
 	'$loop'(Stream,reconsult),
 	'$end_consult',
+	( nonvar(TraceR) -> recorda('$trace', on, _) ; true),
 	'$clear_reconsulting',
 	set_value('$consulting',Old),
 	set_value('$consulting_file',OldF),

pl/corout.yap

@@ -617,9 +617,11 @@ call_residue(Goal,Residue) :-
 '$project_module'([Mod|LMods], LIV, LAV) :-
 	\+ '$undefined'(project_attributes(LIV, LAV), Mod),
 	'$execute'(Mod:project_attributes(LIV, LAV)), !,
+	'$do_not_creep',
 	attributes:all_attvars(NLAV),
 	'$project_module'(LMods,LIV,NLAV).
 '$project_module'([_|LMods], LIV, LAV) :-
+	'$do_not_creep',
 	'$project_module'(LMods,LIV,LAV).
 
 
@@ -634,11 +636,13 @@ call_residue(Goal,Residue) :-
 '$do_convert_att_vars'([V|LAV], LIV, NGs) :-
 	var(V),
 	attributes:convert_att_var(V,G),
+	'$do_not_creep',
 	G \= true,
 	!,
 	'$split_goals_for_catv'(G,V,NGs,IGs),
 	'$do_convert_att_vars'(LAV, LIV, IGs).
 '$do_convert_att_vars'([_|LAV], LIV, Gs) :-
+	'$do_not_creep',
 	'$do_convert_att_vars'(LAV, LIV, Gs).
 
 '$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !,

pl/debug.yap

@@ -23,7 +23,6 @@
 
 :- op(900,fx,[spy,nospy]).
 
-:- thread_local([idb:'$debug',idb:'$trace',idb:'$spy_skip',idb:'$spy_stop']).
 
 % First part : setting and reseting spy points
 
@@ -271,10 +270,11 @@ debugging :-
 % last argument to do_spy says that we are at the end of a context. It
 % is required to know whether we are controlled by the debugger.
 '$do_spy'(_, _, _, _) :-
-	'$stop_debugging', fail.
+	'$do_not_creep', fail.
 '$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
 '$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
 '$do_spy'(true, _, _, _) :- !.
+%'$do_spy'(fail, _, _, _) :- !, fail.
 '$do_spy'(M:G, _, CP, InControl) :- !,
 	'$do_spy'(G, M, CP, InControl).
 '$do_spy'((A,B), M, CP, InControl) :- !,
@@ -285,14 +285,16 @@ debugging :-
 	;
 	  '$do_spy'(B, M, CP, InControl)
 	).
-'$do_spy'((A;B), M, CP, InControl) :- !,
+'$do_spy'((T->A|B), M, CP, InControl) :- !,
-	(
+	( '$do_spy'(T, M, CP, yes) -> 	'$do_spy'(A, M, CP, yes)
-	  '$do_spy'(A, M, CP, yes)
 	;
 	  '$do_spy'(B, M, CP, InControl)
 	).
-'$do_spy'((T->A|B), M, CP, InControl) :- !,
+'$do_spy'((T->A), M, CP, InControl) :- !,
-	( '$do_spy'(T, M, CP, yes) -> 	'$do_spy'(A, M, CP, yes)
+	( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ).
+'$do_spy'((A;B), M, CP, InControl) :- !,
+	(
+	  '$do_spy'(A, M, CP, yes)
 	;
 	  '$do_spy'(B, M, CP, InControl)
 	).
@@ -321,7 +323,7 @@ debugging :-
 
 % handle weird things happening in the debugger.		    
 '$loop_spy_event'(_, _, _, _, _) :-
-	'$stop_debugging', fail.
+	'$do_not_creep', fail.
 '$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
      G0 >= GoalNumber, !,
      '$loop_spy'(GoalNumber, G, Module, InControl).
@@ -355,20 +357,21 @@ debugging :-
 	    '$spycall'(G, Module, InControl),
 	/* go execute the predicate	*/
 	    (
-	       '$stop_debugging',
+	       '$do_not_creep',
 	       '$show_trace'(exit,G,Module,GoalNumber),	/* output message at exit	*/
 	       '$continue_debugging'(InControl)
-	     ;		/* exit				*/
+	     ;
+		/* exit				*/
 	        /* we get here when we want to redo a goal		*/
-	        '$stop_debugging',
+	        '$do_not_creep',
 	        '$show_trace'(redo,G,Module,GoalNumber), /* inform user_error		*/
-	        '$continue_debugging'(InControl),
+	        '$continue_debugging'(InControl,G,Module),
 	        fail			/* to backtrack to spycalls	*/
 	     )
 	  ;
-	    '$stop_debugging',
+	    '$do_not_creep',
 	    '$show_trace'(fail,G,Module,GoalNumber), /* inform at fail port		*/
-	    '$continue_debugging'(InControl),
+	    '$continue_debugging'(InControl,G,Module),
 	    fail
 	).
 
@@ -410,11 +413,11 @@ debugging :-
 	% use the interpreter
 	CP is '$last_choice_pt',
 	'$clause'(G, M, Cl),
-	'$stop_debugging',
+	'$do_not_creep',
 	'$do_spy'(Cl, M, CP, InControl).
 '$spycall'(G, M, InControl) :-
 	% I lost control here.
-	'$continue_debugging'(InControl),
+	'$continue_debugging'(InControl,G,M),
 	'$execute_nonstop'(G, M).
 
 
@@ -568,15 +571,18 @@ debugging :-
 	fail.
 
 % if we are in the interpreter, don't need to care about forcing a trace, do we?
-'$continue_debugging'(no) :- !.
+'$continue_debugging'(no,_,_) :- !.
+'$continue_debugging'(Flag,G,M) :-
+	'$system_predicate'(G,M), !,
+	( '$access_yap_flags'(10,1) -> '$late_creep' ; true).
+'$continue_debugging'(Flag,_,_) :-
+	'$continue_debugging'(Flag).
+	
 '$continue_debugging'(_) :-
 	'$access_yap_flags'(10,1), !,
 	'$creep'.
 '$continue_debugging'(_).
 
-'$stop_debugging' :-
-	'$stop_creep'.
-
 '$action_help' :-
 	format(user_error,"newline  creep       a       abort~n", []),
 	format(user_error,"c        creep       e       exit~n", []),

pl/directives.yap

@@ -15,6 +15,14 @@
 *									 *
 *************************************************************************/
 
+'$all_directives'(_:G1) :- !,
+	'$all_directives'(G1).
+'$all_directives'((G1,G2)) :- !,
+	'$all_directives'(G1),
+	'$all_directives'(G2).
+'$all_directives'(G) :- !,
+	'$directive'(G).
+
 '$directive'(multifile(_)).
 '$directive'(discontiguous(_)).
 '$directive'(initialization(_)).
@@ -42,6 +50,12 @@
 '$directive'(uncutable(_)).
 '$directive'(thread_local(_)).
 
+'$exec_directives'((G1,G2), Mode, M) :- !,
+	'$exec_directives'(G1, Mode, M),
+	'$exec_directives'(G2, Mode, M).
+'$exec_directives'(G, Mode, M) :-
+	'$exec_directive'(G, Mode, M).
+
 '$exec_directive'(multifile(D), _, M) :-
 	'$system_catch'('$multifile'(D, M), M,
 	      Error,
@@ -102,12 +116,6 @@
 	'$uncutable'(PredSpec, M).
 
 
-'$exec_directives'((G1,G2), Mode, M) :- !,
-	'$exec_directives'(G1, Mode, M),
-	'$exec_directives'(G2, Mode, M).
-'$exec_directives'(G, Mode, M) :-
-	'$exec_directive'(G, Mode, M).
-
 yap_flag(V,Out) :-
 	var(V), !,
 	'$show_yap_flag_opts'(V,Out).

pl/init.yap

@@ -20,12 +20,18 @@
 
 % These are pseudo declarations
 % so that the user will get a redefining system predicate
-otherwise.
 fail :- fail.
+
 false :- fail.
+
+otherwise.
+
 !.
+
 (:- G) :- '$execute'(G), !.
+
 '$$!'(CP) :- '$cut_by'(CP).
+
 [] :- true.
 
 
@@ -66,6 +72,8 @@ false :- fail.
 	 'threads.yap',
 	 'yapor.yap'].
 
+:- thread_local([idb:'$debug'/0,idb:'$trace'/0,idb:'$spy_skip'/0,idb:'$spy_stop'/0]).
+
 :-	 ['protect.yap'].
 
 version(yap,[4,1]).

pl/modules.yap

@@ -413,6 +413,8 @@ module(N) :-
 
 :- dynamic_predicate('$meta_predicate'/4,logical).
 
+:- multifile '$meta_predicate'/4.
+
 '$meta_predicate'((P,Ps), M) :- !, 
 	'$meta_predicate'(P, M),
 	'$meta_predicate'(Ps, M).

pl/signals.yap

@@ -31,8 +31,15 @@
 	% if more signals alive, set creep flag
 	'$continue_signals',
 	'$wake_up_goal'(G, LG).
-'$do_signal'(sig_creep, G) :-
+'$do_signal'(sig_creep, [M|G]) :-
-	'$start_creep'(G).
+	( '$access_yap_flags'(10,0) ->
+	    % we're not allowed to creep for now,
+	    % maybe we're inside builtin.
+	    '$late_creep',
+	    '$execute'(M:G)
+	    ;
+	    '$start_creep'([M|G])
+	).
 '$do_signal'(sig_delay_creep, [M|G]) :-
 	'$execute'(M:G),
         '$creep'.
@@ -93,7 +100,7 @@
 	'$creep',
 	'$execute_nonstop'(G,Mod).
 '$start_creep'([Mod|G]) :-
-	'$stop_debugging',
+	'$do_not_creep',
 	CP is '$last_choice_pt',	
 	'$do_spy'(G, Mod, CP, yes).