support trace

fix for ^c in readline


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

C/cdmgr.c

@@ -2161,6 +2161,22 @@ p_clean_up_dead_clauses(void)
   return(TRUE);
 }
 
+static Int			/* $parent_pred(Module, Name, Arity) */
+p_parent_pred(void)
+{
+  Atom at;
+  Int arity;
+  SMALLUNSGN module;
+  if (!PredForCode((CODEADDR)CP, &at, &arity, &module)) {
+    return(unify(ARG1, MkIntTerm(0)) &&
+	   unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
+	   unify(ARG3, MkIntTerm(0)));
+  }
+  return(unify(ARG1, MkIntTerm(module)) &&
+	 unify(ARG2, MkAtomTerm(at)) &&
+	 unify(ARG3, MkIntTerm(arity)));
+}
+
 void 
 InitCdMgr(void)
 {
@@ -2197,4 +2213,5 @@ InitCdMgr(void)
   InitCPred("$search_for_static_predicates_in_use", 1, p_search_for_static_predicate_in_use, TestPredFlag|SafePredFlag|SyncPredFlag);
   InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
   InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
+  InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
 }

C/exec.c

@@ -200,6 +200,16 @@ CallMetaCall(void) {
   return (FastCallProlog(PredMetaCall));
 }
 
+inline static Int
+EnterCreepMode(PredEntry *pen) {
+  Atom a = NameOfFunctor(FunctorSpy);
+  PredEntry *PredSpy = RepPredProp(PredProp(a,1));
+  ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1);
+  CreepFlag = CalculateStackGap();
+  WRITE_LOCK(PredSpy->PRWLock);
+  return (FastCallProlog(PredSpy));
+}
+
 static Int
 p_execute(void)
 {				/* '$execute'(Goal)	 */
@@ -209,10 +219,6 @@ p_execute(void)
   Atom            a;
 
  restart_exec:
-  if (yap_flags[SPY_CREEP_FLAG]) {
-    a = NameOfFunctor(FunctorSpiedMetaCall);
-    return (CallProlog(RepPredProp(PredProp(a,1)), 1, (Int) (-1)));
-  }
   if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
     return(CallMetaCall());
   } else  if (IsVarTerm(t)) {
@@ -268,6 +274,9 @@ p_execute(void)
       if (pen->PredFlags & MetaPredFlag) {
 	return(CallMetaCall());
       }
+      if (yap_flags[SPY_CREEP_FLAG]) {
+	return(EnterCreepMode(pen));
+      }
       /* now let us do what we wanted to do from the beginning !! */
       /* I cannot use the standard macro here because
 	 otherwise I would dereference the argument and
@@ -312,6 +321,9 @@ p_execute(void)
 	return(CallMetaCall());
       }
     }
+    if (yap_flags[SPY_CREEP_FLAG]) {
+      return(EnterCreepMode(RepPredProp(pe)));
+    }
     return (CallProlog(RepPredProp(pe), arity, (Int) (-1)));
   } else {
     /* Is Pair Term */
@@ -336,10 +348,6 @@ p_execute_within(void)
   Atom            a;
 
  restart_exec:
-  if (yap_flags[SPY_CREEP_FLAG]) {
-    a = NameOfFunctor(FunctorSpiedMetaCall);
-    return (CallProlog(RepPredProp(PredProp(a,1)), 1, (Int) (-1)));
-  }
   if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
     return(CallMetaCallWithin());
   } else  if (IsVarTerm(t)) {
@@ -395,6 +403,10 @@ p_execute_within(void)
       if (pen->PredFlags & MetaPredFlag) {
 	return(CallMetaCallWithin());
       }
+      /* at this point check if we should enter creep mode */ 
+      if (yap_flags[SPY_CREEP_FLAG]) {
+	return(EnterCreepMode(pen));
+      }
       /* now let us do what we wanted to do from the beginning !! */
       /* I cannot use the standard macro here because
 	 otherwise I would dereference the argument and
@@ -463,6 +475,9 @@ p_execute_within(void)
 	return(CallMetaCallWithin());
       }
     }
+    if (yap_flags[SPY_CREEP_FLAG]) {
+      return(EnterCreepMode(RepPredProp(pe)));
+    }
     return (CallProlog(RepPredProp(pe), arity, (Int) (-1)));
   } else {
     /* Is Pair Term */

C/init.c

@@ -710,7 +710,7 @@ InitCodes(void)
     AtomNot,
     AtomQuery,
     AtomSemic,
-    AtomSpiedMetaCall,
+    AtomSpy,
     AtomStream,
     AtomStreamPos,
     AtomVar;
@@ -881,7 +881,7 @@ InitCodes(void)
   AtomStreamPos = LookupAtom ("$stream_position");
   heap_regs->atom_throw = LookupAtom("$throw");
   heap_regs->atom_true = LookupAtom("true");
-  AtomSpiedMetaCall = LookupAtom("$spied_meta_call");
+  AtomSpy = LookupAtom("$spy");
   heap_regs->atom_user = LookupAtom ("user");
   heap_regs->atom_usr_err = LookupAtom ("user_error");
   heap_regs->atom_usr_in = LookupAtom ("user_input");
@@ -927,7 +927,7 @@ InitCodes(void)
   heap_regs->functor_or = MkFunctor(AtomSemic, 2);
   heap_regs->functor_portray = MkFunctor(AtomPortray, 1);
   heap_regs->functor_query = MkFunctor(AtomQuery, 1);
-  heap_regs->functor_spied_meta_call = MkFunctor(AtomSpiedMetaCall, 1);
+  heap_regs->functor_spy = MkFunctor(AtomSpy, 1);
   heap_regs->functor_stream = MkFunctor (AtomStream, 1);
   heap_regs->functor_stream_pos = MkFunctor (AtomStreamPos, 3);
   heap_regs->functor_stream_eOS = MkFunctor (LookupAtom("end_of_stream"), 1);

C/iopreds.c

@@ -82,14 +82,14 @@ jmp_buf IOBotch;
 
 int  in_getc = FALSE;
 
-int  sigint_pending = FALSE;
-
 #if HAVE_LIBREADLINE
-jmp_buf readline_jmpbuf;
 
 #if _MSC_VER || defined(__MINGW32__)
 FILE *rl_instream, *rl_outstream;
 #endif
+
+jmp_buf readline_jmpbuf;
+
 #endif
 
 typedef struct
@@ -512,9 +512,9 @@ PlIOError (yap_error_number type, Term culprit, char *who)
 
 /*
  * Used by the prompts to check if they are after a newline, and then a
- * prompt should be output, or if we are in the middle of a line 
+ * prompt should be output, or if we are in the middle of a line.
  */
-static int newline = TRUE;
+int newline = TRUE;
 
 static void
 count_output_char(int ch, StreamDesc *s, int sno)
@@ -863,15 +863,23 @@ ReadlineGetc(int sno)
   register StreamDesc *s = &Stream[sno];
   register int ch;
 
-  if (ttyptr == NIL) {
+  while (ttyptr == NULL) {
-    if (setjmp(readline_jmpbuf) < 0) {
-      Abort("");
-    }
     in_getc = TRUE;
     /* Do it the gnu way */
+    if (sigsetjmp(readline_jmpbuf, TRUE)) {
+      printf("hello\n");
+      if (PrologMode & InterruptMode) {
+	PrologMode &= ~InterruptMode;
+	ProcessSIGINT();
+	if (PrologMode & AbortMode) {
+	  PrologMode &= ~AbortMode;
+	  Abort("");
+	}
+      }
+    }
     YP_fflush (YP_stdout);
     /* Only sends a newline if we are at the start of a line */
-    if (_line != (char *) NULL && _line != (char *) EOF)
+    if (_line != NULL && _line != (char *) EOF)
       free (_line);
     rl_instream = Stream[sno].u.file.file;
     rl_outstream = Stream[cur_out_sno].u.file.file;

C/save.c

@@ -1088,7 +1088,7 @@ restore_codes(void)
   heap_regs->functor_or = FuncAdjust(heap_regs->functor_or);
   heap_regs->functor_portray = FuncAdjust(heap_regs->functor_portray);
   heap_regs->functor_query = FuncAdjust(heap_regs->functor_query);
-  heap_regs->functor_spied_meta_call = FuncAdjust(heap_regs->functor_spied_meta_call);
+  heap_regs->functor_spy = FuncAdjust(heap_regs->functor_spy);
   heap_regs->functor_stream = FuncAdjust(heap_regs->functor_stream);
   heap_regs->functor_stream_pos = FuncAdjust(heap_regs->functor_stream_pos);
   heap_regs->functor_stream_eOS = FuncAdjust(heap_regs->functor_stream_eOS);

C/sysbits.c

@@ -885,7 +885,7 @@ my_signal_info(int sig, void (*handler)(int, siginfo_t  *, ucontext_t *))
 
   sigact.sa_handler = handler;
   sigemptyset(&sigact.sa_mask);
-  sigact.sa_flags = SA_SIGINFO|SA_RESTART;
+  sigact.sa_flags = SA_SIGINFO;
 
   sigaction(sig,&sigact,NULL);
 }
@@ -897,9 +897,7 @@ my_signal(int sig, void (*handler)(int, siginfo_t *, ucontext_t *))
 
   sigact.sa_handler=handler;
   sigemptyset(&sigact.sa_mask);
-  sigact.sa_flags = 0
+  sigact.sa_flags = 0;
-;
-
   sigaction(sig,&sigact,NULL);
 }
 
@@ -1014,11 +1012,6 @@ HandleSIGSEGV(int   sig)
 
 #ifdef HAVE_SIGACTION
 
-#if !defined(SA_RESTART)
-/* sunos machine has no SA_RESTART, as most other 4.2BSD based machines */
-#define SA_RESTART 0
-#endif
-
 static void
 my_signal_info(int sig, void (*handler)(int))
 {
@@ -1026,7 +1019,6 @@ my_signal_info(int sig, void (*handler)(int))
 
   sigact.sa_handler = handler;
   sigemptyset(&sigact.sa_mask);
-  sigact.sa_flags = SA_RESTART;
 
   sigaction(sig,&sigact,NULL);
 }
@@ -1038,7 +1030,6 @@ my_signal(int sig, void (*handler)(int))
 
   sigact.sa_handler=handler;
   sigemptyset(&sigact.sa_mask);
-  sigact.sa_flags = SA_RESTART;
 
   sigaction(sig,&sigact,NULL);
 }
@@ -1081,6 +1072,10 @@ InteractSIGINT(char ch) {
   case 'c':
     /* continue */
     return(1);
+  case 'd':
+    /* enter debug mode */
+    PutValue (LookupAtom ("debug"), MkIntTerm (1));
+    return(1);
   case 'e':
     /* exit */
     exit_yap(0, "");
@@ -1089,7 +1084,8 @@ InteractSIGINT(char ch) {
     /* start tracing */
     PutValue (LookupAtom ("debug"), MkIntTerm (1));
     PutValue (LookupAtom ("spy_sl"), MkIntTerm (0));
-    PutValue (LookupAtom ("spy_creep"), MkIntTerm (1));
+    PutValue (FullLookupAtom ("$trace"), MkIntTerm (1));
+    yap_flags[SPY_CREEP_FLAG] = 1;
     p_creep ();
     return(1);
 #ifdef LOW_LEVEL_TRACER
@@ -1097,10 +1093,6 @@ InteractSIGINT(char ch) {
     toggle_low_level_trace();
     return(1);
 #endif
-  case 'd':
-    /* enter debug mode */
-    PutValue (LookupAtom ("debug"), MkIntTerm (1));
-    return(1);
   case 's':
     /* show some statistics */
 #if SHORT_INTS==0
@@ -1163,7 +1155,7 @@ InteractSIGINT(char ch) {
     /* show an helpful message */
     YP_fprintf(YP_stderr, "Please press one of:\n");
     YP_fprintf(YP_stderr, "  a for abort\n  c for continue\n  d for debug\n");
-    YP_fprintf(YP_stderr, "  e for exit\n  t for trace\n  s for statistics\n");
+    YP_fprintf(YP_stderr, "  e for exit\n  s for statistics\n  t for trace\n");
     return(0);
   }
 }
@@ -1176,6 +1168,7 @@ int
 ProcessSIGINT(void)
 {
   int ch, out;
+  extern int newline;
 
   do {
 #if  HAVE_LIBREADLINE
@@ -1187,6 +1180,8 @@ ProcessSIGINT(void)
       continue;
     }
     ch = _line[0];
+    free(_line);
+    _line = NULL;
 #else
     /* ask for a new line */
     fprintf(stderr, "Action (h for help): ");
@@ -1195,13 +1190,7 @@ ProcessSIGINT(void)
     while ((fgetc(stdin)) != '\n');
 #endif
   } while (!(out = InteractSIGINT(ch)));
-  if (out < 0)
+  newline = TRUE;
-    sigint_pending = out;
-#if  HAVE_LIBREADLINE
-  if (in_getc) {
-    longjmp(readline_jmpbuf, (out < 0 ? -1 : 1));
-  }
-#endif
   return(out);
 }
 
@@ -1222,26 +1211,23 @@ HandleSIGINT (int sig)
     InteractSIGINT('e');
   }
 #endif
-#if !HAVE_LIBREADLINE
+  if (in_getc || (PrologMode & CritMode)) {
-  if (in_getc) {
     PrologMode |= InterruptMode;
-    return;
+#if HAVE_LIBREADLINE
-  }
+    if (in_getc) {
+      siglongjmp(readline_jmpbuf, 0);
+    }
 #endif
-  if (PrologMode & CritMode) {
-    /* delay processing if we are messing with the Code space */
-    PrologMode |= InterruptMode;
     return;
   }
 #ifdef HAVE_SETBUF
   /* make sure we are not waiting for the end of line */
-  YP_setbuf (stdin, NULL); 
+  YP_setbuf (stdin, NULL);
 #endif
-  if (snoozing)
+  if (snoozing) {
-    {
+    snoozing = FALSE;
-      snoozing = FALSE;
+    return;
-      return;
+  }
-    }
   ProcessSIGINT();
 }
 

C/tracer.c

@@ -20,6 +20,7 @@
 #ifdef LOW_LEVEL_TRACER
 
 #include "Yatom.h"
+#include "Heap.h"
 #include "yapio.h"
 #include "tracer.h"
 
@@ -132,7 +133,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /* if (vsc_count < 2518) return; */
   /* if (vsc_count > 500000) exit(0); */
   /* if (gc_calls < 1) return;*/
-  YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H);
+  YP_fprintf(YP_stderr,"%lu (%x,%d)", vsc_count, CreepFlag,yap_flags[SPY_CREEP_FLAG]);
   /* check_trail_consistency(); */
   if (pred == NULL) {
     return;

C/utilpreds.c

@@ -101,7 +101,7 @@ static void copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *
 	pt0_end = ap2 + 1;
 	ptf = H;
 	H += 2;
-	if (H > ENV - CreepFlag) {
+	if (H > ENV - 2048) {
 	  goto overflow;
 	}
       } else if (IsApplTerm(d0)) {
@@ -148,7 +148,7 @@ static void copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *
 	H[0] = (CELL)f;
 	ptf = H+1;
 	H += 1+d0;
-	if (H > ENV - CreepFlag) {
+	if (H > ENV - 2048) {
 	  goto overflow;
 	}
       } else {
@@ -368,7 +368,7 @@ static void copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_e
 	pt0_end = ap2 + 1;
 	ptf = H;
 	H += 2;
-	if (H > ENV - CreepFlag) {
+	if (H > ENV - 2048) {
 	  goto overflow;
 	}
       } else if (IsApplTerm(d0)) {
@@ -413,7 +413,7 @@ static void copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_e
 	H[0] = (CELL)f;
 	ptf = H+1;
 	H += 1+d0;
-	if (H > ENV - CreepFlag) {
+	if (H > ENV - 2048) {
 	  goto overflow;
 	}
       } else {

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.7 2001-06-22 17:53:36 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.8 2001-08-08 21:17:27 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -243,7 +243,7 @@ typedef struct various_codes {
     functor_or,
     functor_portray,
     functor_query,
-    functor_spied_meta_call,
+    functor_spy,
     functor_stream,
     functor_stream_pos,
     functor_stream_eOS,
@@ -427,7 +427,7 @@ typedef struct various_codes {
 #define  FunctorOr                heap_regs->functor_or
 #define  FunctorPortray           heap_regs->functor_portray
 #define  FunctorQuery             heap_regs->functor_query
-#define  FunctorSpiedMetaCall     heap_regs->functor_spied_meta_call
+#define  FunctorSpy               heap_regs->functor_spy
 #define  FunctorStream            heap_regs->functor_stream
 #define  FunctorStreamPos         heap_regs->functor_stream_pos
 #define  FunctorStreamEOS         heap_regs->functor_stream_eOS

H/yapio.h

@@ -316,9 +316,8 @@ extern int  Portray_delays;
 
 extern jmp_buf IOBotch;
 
-#if HAVE_LIBREADLINE
+extern int in_getc;
-extern jmp_buf readline_jmpbuf;
+
+#ifdef HAVE_LIBREADLINE
+extern sigjmp_buf readline_jmpbuf;
 #endif
-
-extern int in_getc, sigint_pending;
-

changes4.3.html

@@ -16,6 +16,9 @@
 
 <h2>Yap-4.3.19:</h2>
 <ul>
+	<li>NEW: trace and notrace.</li>
+	<li>FIXED: make C-c t actually trace.</li>
+	<li>FIXED: put [debug] when in debug mode.</li>
 	<li>FIXED: make install_info.(actual fix is in Yap-4.3.19)</li>
 </ul>
 

docs/yap.tex

@@ -11544,6 +11544,9 @@ The possible forms for @var{P} are the same as in @code{spy P}.
 @cnindex nospyall/0
 Removes all existing spy-points.
 
+@item notrace
+Switches off the debugger and stops tracing.
+
 @item leash(+@var{M})
 @findex leash/1
 @syindex leash/1
@@ -11601,6 +11604,9 @@ the ports where the debugger should stop. For example,
 If defined by the user, this predicate will be used to print goals by
 the debugger instead of @code{write/2}.
 
+@item trace
+Switches on the debugger and starts tracing.
+
 @end table
 
 
@@ -12805,12 +12811,6 @@ These are YAP built-ins not available in C-Prolog.
 These are C-Prolog built-ins not available in YAP:
 
 @table @code
-@item notrace
-Switches off the debugger and stops tracing.
-
-@item trace
-Switches on the debugger and starts tracing.
-
 @item 'LC'
 The following Prolog text uses lower case letters.
 

m4/Yap.h.m4

@@ -10,7 +10,7 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.8 2001-07-04 16:48:54 uid49918 Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.9 2001-08-08 21:17:27 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -362,7 +362,7 @@ typedef CELL Term;
 #ifdef mips
 #include <mips_locks_funcs.h>
 #endif
-#ifdef mips
+#ifdef __alpha
 #include <alpha_locks_funcs.h>
 #endif
 #endif

pl/boot.yap

@@ -158,6 +158,15 @@ nl.
 	prompt(_,'   | '),
 	'$system_catch'('$do_yes_no'((G->true)),Error,user:'$Error'(Error)),
 	fail.
+'$enter_top_level' :-
+	( '$get_value'('$trace', 1) ->
+	    '$set_value'(spy_sl,0),
+	    '$format'(user_error, "[trace]~n", [])
+	;
+	  '$get_value'(debug, 1) ->
+	    '$format'(user_error, "[debug]~n", [])
+	),
+	fail.
 '$enter_top_level' :-
 	prompt(_,'   ?- '),
 	prompt('   | '),
@@ -166,7 +175,11 @@ nl.
 	'$set_value'(spy_fs,0),
 	'$set_value'(spy_sp,0),
 	'$set_value'(spy_gn,1),
-	'$set_yap_flags'(10,0),
+	( '$get_value'('$trace', 1) ->
+	    '$set_yap_flags'(10,1)
+	    ;
+	    '$set_yap_flags'(10,0)
+	),
 	'$set_value'(spy_cl,1),
 	'$set_value'(spy_leap,0),
 	'$setflop'(0),

pl/debug.yap

@@ -104,7 +104,23 @@ debug :- '$set_value'(debug,1), write(user_error,'[ Debug mode on ]'), nl(user_e
 
 nodebug :- nospyall,
 	'$set_value'(debug,0),
-	write(user_error,'[ Debug mode off ]'), nl(user_error).
+	'$set_value'('$trace',0),
+	'$format'(user_error,"[ Debug mode off ]~n",[]).
+
+trace :- '$get_value'('$trace',1), !.
+trace :-
+	'$format'(user_error,"[ Trace mode on ]~n",[]),
+	'$set_value'('$trace',1),
+	'$set_value'(debug,1),
+	'$set_value'(spy_sl,0),
+	% start creep,
+	'$set_yap_flags'(10,1),
+	'$creep'.
+
+notrace :- 
+	'$set_value'('$trace',0),
+	'$set_value'(debug,0),
+	'$format'(user_error,"[ Trace and Debug mode off ]",[]).
 
 /*-----------------------------------------------------------------------------
 
@@ -220,6 +236,7 @@ debugging :-
 %	spy_leap	leap		0	0...
 %	spy_cl		clause number	1	1...
 %	spy_fs		fast skip	0	0, 1
+%	spy_trace	trace		0	0, 1
 % a flip-flop is also used
 %	when 1 spying is enabled
 %'$spy'(G) :- write(user_error,'$spy'(G)), nl, fail.
@@ -230,17 +247,20 @@ debugging :-
 	'$awoken_goals'(LG), !,
 	'$creep',
 	'$wake_up_goal'(G, LG).
+'$spy'([Module|G]) :-
+%    '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
+        '$system_predicate'(G),
+	'$parent_pred'(0,_,_),
+         !,
+	 /* called from prolog module   */
+	 '$creep',
+	 '$execute0'(G).
 '$spy'([Module|G]) :- !,
-%    write(user_error,$spym(M,G)), nl,
     (	  Module=prolog -> '$spy'(G);
 	  '$mod_switch'(Module, '$spy'(G))
      ).
 '$spy'(true) :- !, '$creep'.
 '$spy'('$cut_by'(M)) :- !, '$cut_by'(M).
-'$spy'(G) :-
-    '$hidden'(G), !,			/* dont spy hidden predicates 	*/
-    '$creep',
-    '$execute0'(G).
 '$spy'(G) :-
 %   write(user_error,$spy(G)), nl,
     '$get_value'(debug,1),		/* ditto if debug off		*/
@@ -292,6 +312,7 @@ debugging :-
 '$spy'(G) :- '$execute0'(G).	/* this clause applies when we do not want
 				   to spy the goal			*/
 
+'$cont_creep' :-  '$get_value'('$trace',1), '$set_yap_flags'(10,1), fail.
 '$cont_creep' :- '$access_yap_flags'(10,1), !, '$creep'.
 '$cont_creep'.