This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
236
C/tracer.c
Normal file
236
C/tracer.c
Normal file
@@ -0,0 +1,236 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog @(#)amidefs.h 1.3 3/15/90
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: tracer.h *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: definitions for low level tracer *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
#include "Yap.h"
|
||||
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
|
||||
#include "Yatom.h"
|
||||
#include "yapio.h"
|
||||
#include "tracer.h"
|
||||
|
||||
STATIC_PROTO(int TracePutchar, (int, int));
|
||||
STATIC_PROTO(void send_tracer_message, (char *, char *, Int, char *, CELL *));
|
||||
|
||||
int do_low_level_trace = FALSE;
|
||||
static int do_trace_primitives = TRUE;
|
||||
|
||||
int
|
||||
TracePutchar(int sno, int ch)
|
||||
{
|
||||
return(YP_putc(ch, stderr)); /* use standard error stream, which is supposed to be 2*/
|
||||
}
|
||||
|
||||
static void
|
||||
send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
|
||||
{
|
||||
if (name == NULL) {
|
||||
#ifdef YAPOR
|
||||
#ifdef DEPTH_LIMIT
|
||||
YP_fprintf(YP_stderr, "(%d)%s (D:%d)", worker_id, start, (CELL)IntegerOfTerm(DEPTH)/2);
|
||||
#else
|
||||
YP_fprintf(YP_stderr, "(%d)%s", worker_id, start);
|
||||
#endif
|
||||
#else
|
||||
#ifdef DEPTH_LIMIT
|
||||
YP_fprintf(YP_stderr, "%s (D:%d)", start, (CELL)IntegerOfTerm(DEPTH)/2);
|
||||
#else
|
||||
YP_fprintf(YP_stderr, "%s", start);
|
||||
#endif
|
||||
#endif
|
||||
} else {
|
||||
int i;
|
||||
|
||||
if (arity) {
|
||||
#ifdef DEPTH_LIMIT
|
||||
YP_fprintf(YP_stderr, "%s (D:%d) %s:%s(", start, (CELL)IntegerOfTerm(DEPTH)/2, mname, name);
|
||||
#else
|
||||
YP_fprintf(YP_stderr, "%s %s:%s(", start, mname, name);
|
||||
#endif
|
||||
} else {
|
||||
#ifdef DEPTH_LIMIT
|
||||
YP_fprintf(YP_stderr, "%s (D:%d) %s:%s", start, (CELL)IntegerOfTerm(DEPTH)/2, mname, name);
|
||||
#else
|
||||
YP_fprintf(YP_stderr, "%s %s:%s", start, mname, name);
|
||||
#endif
|
||||
}
|
||||
for (i= 0; i < arity; i++) {
|
||||
if (i > 0) YP_fprintf(YP_stderr, ",");
|
||||
#if DEBUG
|
||||
#if COROUTINING
|
||||
Portray_delays = TRUE;
|
||||
#endif
|
||||
#endif
|
||||
plwrite(args[i], TracePutchar, 4);
|
||||
#if DEBUG
|
||||
#if COROUTINING
|
||||
Portray_delays = FALSE;
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
if (arity) YP_fprintf(YP_stderr, ")");
|
||||
}
|
||||
YP_fprintf(YP_stderr, "\n");
|
||||
}
|
||||
|
||||
unsigned long vsc_count;
|
||||
|
||||
/*
|
||||
static int
|
||||
check_trail_consistency(void) {
|
||||
tr_fr_ptr ptr = TR;
|
||||
while (ptr > (CELL *)TrailBase) {
|
||||
ptr = --ptr;
|
||||
if (!IsVarTerm(TrailTerm(ptr))) {
|
||||
if (IsApplTerm(TrailTerm(ptr))) {
|
||||
CELL *cptr = (CELL *)ptr;
|
||||
ptr = (tr_fr_ptr)(cptr-1);
|
||||
} else {
|
||||
if (IsPairTerm(TrailTerm(ptr))) {
|
||||
CELL *p = RepPair(TrailTerm(ptr));
|
||||
if (p < H0) continue;
|
||||
}
|
||||
printf("Oops at call %ld, B->cp(%p) TR(%p) pt(%p)\n", vsc_count,B->cp_tr, TR, ptr);
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
*/
|
||||
|
||||
void
|
||||
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
{
|
||||
char *s;
|
||||
char *mname;
|
||||
Int arity;
|
||||
extern int gc_calls;
|
||||
|
||||
vsc_count++;
|
||||
/* if (vsc_count < 420430) return; */
|
||||
/* if (vsc_count > 500000) exit(0); */
|
||||
/* if (gc_calls < 1) return;*/
|
||||
YP_fprintf(YP_stderr,"%lu ",vsc_count);
|
||||
/* check_trail_consistency(); */
|
||||
if (pred == NULL) {
|
||||
return;
|
||||
}
|
||||
if (pred->ModuleOfPred == 0 && !do_trace_primitives) {
|
||||
return;
|
||||
}
|
||||
switch (port) {
|
||||
case enter_pred:
|
||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||
arity = pred->ArityOfPE;
|
||||
if (arity == 0) {
|
||||
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
|
||||
} else {
|
||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||
}
|
||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||
return; */
|
||||
send_tracer_message("CALL: ", s, arity, mname, args);
|
||||
break;
|
||||
case try_or:
|
||||
send_tracer_message("TRY_OR ", NULL, 0, NULL, args);
|
||||
break;
|
||||
case retry_or:
|
||||
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
||||
send_tracer_message("RETRY_OR ", NULL, 0, NULL, args);
|
||||
break;
|
||||
case retry_table_producer:
|
||||
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
||||
/* HANDLE METACALLS */
|
||||
if (pred == NULL) {
|
||||
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
|
||||
} else {
|
||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||
arity = pred->ArityOfPE;
|
||||
if (arity == 0) {
|
||||
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
|
||||
} else {
|
||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||
}
|
||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||
return; */
|
||||
send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL);
|
||||
}
|
||||
break;
|
||||
case retry_table_consumer:
|
||||
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
||||
/* HANDLE METACALLS */
|
||||
if (pred == NULL) {
|
||||
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
|
||||
} else {
|
||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||
arity = pred->ArityOfPE;
|
||||
if (arity == 0) {
|
||||
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
|
||||
} else {
|
||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||
}
|
||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||
return; */
|
||||
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
|
||||
}
|
||||
break;
|
||||
case retry_pred:
|
||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||
arity = pred->ArityOfPE;
|
||||
if (arity == 0) {
|
||||
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
|
||||
} else {
|
||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||
}
|
||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||
return; */
|
||||
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
||||
send_tracer_message("RETRY: ", s, arity, mname, args);
|
||||
break;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
void
|
||||
toggle_low_level_trace(void)
|
||||
{
|
||||
do_low_level_trace = !do_low_level_trace;
|
||||
}
|
||||
|
||||
static Int p_start_low_level_trace(void)
|
||||
{
|
||||
do_low_level_trace = TRUE;
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Int p_stop_low_level_trace(void)
|
||||
{
|
||||
do_low_level_trace = FALSE;
|
||||
do_trace_primitives = TRUE;
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
void
|
||||
InitLowLevelTrace(void)
|
||||
{
|
||||
InitCPred("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag);
|
||||
InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user