support trace
fix for ^c in readline git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@133 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
5d57058e8e
commit
8fd1bc92f3
17
C/cdmgr.c
17
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);
|
||||
}
|
||||
|
31
C/exec.c
31
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 */
|
||||
|
6
C/init.c
6
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);
|
||||
|
28
C/iopreds.c
28
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) {
|
||||
if (setjmp(readline_jmpbuf) < 0) {
|
||||
Abort("");
|
||||
}
|
||||
while (ttyptr == NULL) {
|
||||
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;
|
||||
|
2
C/save.c
2
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);
|
||||
|
60
C/sysbits.c
60
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)
|
||||
sigint_pending = out;
|
||||
#if HAVE_LIBREADLINE
|
||||
if (in_getc) {
|
||||
longjmp(readline_jmpbuf, (out < 0 ? -1 : 1));
|
||||
}
|
||||
#endif
|
||||
newline = TRUE;
|
||||
return(out);
|
||||
}
|
||||
|
||||
@ -1222,26 +1211,23 @@ HandleSIGINT (int sig)
|
||||
InteractSIGINT('e');
|
||||
}
|
||||
#endif
|
||||
#if !HAVE_LIBREADLINE
|
||||
if (in_getc) {
|
||||
if (in_getc || (PrologMode & CritMode)) {
|
||||
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)
|
||||
{
|
||||
snoozing = FALSE;
|
||||
return;
|
||||
}
|
||||
if (snoozing) {
|
||||
snoozing = FALSE;
|
||||
return;
|
||||
}
|
||||
ProcessSIGINT();
|
||||
}
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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 {
|
||||
|
6
H/Heap.h
6
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
|
||||
|
@ -316,9 +316,8 @@ extern int Portray_delays;
|
||||
|
||||
extern jmp_buf IOBotch;
|
||||
|
||||
#if HAVE_LIBREADLINE
|
||||
extern jmp_buf readline_jmpbuf;
|
||||
extern int in_getc;
|
||||
|
||||
#ifdef HAVE_LIBREADLINE
|
||||
extern sigjmp_buf readline_jmpbuf;
|
||||
#endif
|
||||
|
||||
extern int in_getc, sigint_pending;
|
||||
|
||||
|
@ -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>
|
||||
|
||||
|
12
docs/yap.tex
12
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.
|
||||
|
||||
|
@ -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
|
||||
|
15
pl/boot.yap
15
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),
|
||||
|
33
pl/debug.yap
33
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'.
|
||||
|
||||
|
Reference in New Issue
Block a user