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:
vsc 2001-08-08 21:17:27 +00:00
parent 5d57058e8e
commit 8fd1bc92f3
16 changed files with 6442 additions and 2652 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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();
}

View File

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

View File

@ -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 {

View File

@ -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

View File

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

View File

@ -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>

8857
configure vendored

File diff suppressed because it is too large Load Diff

View File

@ -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.

View File

@ -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

View File

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

View File

@ -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'.