The debugger relied on the environment stack. To fix it:

- absmi.c now tells who called the debugger, besides who it was calling
- this is used to control whether we allow a goal to be debugged.
- I have creep to start creeping immediately, and signal_creep to tell
  the next meta-call to creep what it executes!
- The debugger uses CalledFromTheDebugger to know if it is within the
debugger. If so, we do not need to creep on leaving.
This commit is contained in:
Vítor Santos Costa 2008-08-30 02:39:36 +01:00
parent d636450512
commit 1226b58d8e
14 changed files with 266 additions and 175 deletions

View File

@ -549,6 +549,24 @@ static inline Term rbig(MP_INT *big)
#include "arith2.h"
/*
I can creep if I am not a prolog builtin that has been called
by a prolog builtin,
exception: meta-calls
*/
static PredEntry *
creep_allowed(PredEntry *p, PredEntry *p0)
{
if (p0 == PredMetaCall)
return p0;
if (!p0->ModuleOfPred &&
(!p->ModuleOfPred
||
p->PredFlags & StandardPredFlag))
return NULL;
return p;
}
#ifdef COROUTINING
/*
Imagine we are interrupting the execution, say, because we have a spy
@ -2348,9 +2366,9 @@ Yap_absmi(int inp)
ENDOp();
/* commit_b_x Xi */
Op(commit_b_x, x);
Op(commit_b_x, xp);
BEGD(d0);
d0 = XREG(PREG->u.x.x);
d0 = XREG(PREG->u.xp.x);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitX, H);
@ -2358,7 +2376,7 @@ Yap_absmi(int inp)
do_commit_b_x:
#endif
/* skip a void call and a label */
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, x),sbpp),l);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xp),sbpp),l);
{
choiceptr pt0;
#if defined(SBA) && defined(FROZEN_STACKS)
@ -2395,16 +2413,16 @@ Yap_absmi(int inp)
ENDOp();
/* commit_b_y Yi */
Op(commit_b_y, y);
Op(commit_b_y, yp);
BEGD(d0);
d0 = YREG[PREG->u.y.y];
d0 = YREG[PREG->u.yp.y];
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitY, H);
ENDCACHE_Y_AS_ENV();
do_commit_b_y:
#endif
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, y),sbpp),l);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yp),sbpp),l);
{
choiceptr pt0;
#if defined(SBA) && defined(FROZEN_STACKS)
@ -2488,6 +2506,7 @@ Yap_absmi(int inp)
NoStackExecute:
SREG = (CELL *) PREG->u.pp.p;
PP = PREG->u.pp.p0;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = YREG+E_CB;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
@ -2629,49 +2648,13 @@ Yap_absmi(int inp)
ENDBOp();
NoStackCall:
PP = PREG->u.sbpp.p0;
/* on X86 machines S will not actually be holding the pointer to pred */
if (ActiveSignals & YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.sbpp.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
CACHE_A1();
ENV = ENV_YREG;
/* Try to preserve the environment */
ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.sbpp.s);
CPREG = NEXTOP(PREG, sbpp);
ALWAYS_LOOKAHEAD(ap->OpcodeOfPred);
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
check_depth(DEPTH, ap);
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
#else
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
#endif
}
#else
if (ENV_YREG > (CELL *) B) {
ENV_YREG = (CELL *) B;
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
/* setup GB */
ENV_YREG[E_CB] = (CELL) B;
#ifdef YAPOR
SCH_check_requests();
#endif /* YAPOR */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
} else {
SREG = (CELL *) ap;
goto creepc;
}
}
SREG = (CELL *) PREG->u.sbpp.p;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = (CELL *) (((char *) YREG) + PREG->u.sbpp.s);
@ -2742,6 +2725,7 @@ Yap_absmi(int inp)
/* This is easier: I know there is an environment so I cannot do allocate */
NoStackCommitY:
PP = PREG->u.yp.p0;
/* find something to fool S */
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_y;
@ -2757,6 +2741,7 @@ Yap_absmi(int inp)
/* Problem: have I got an environment or not? */
NoStackCommitX:
PP = PREG->u.xp.p0;
/* find something to fool S */
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_x;
@ -2787,6 +2772,7 @@ Yap_absmi(int inp)
/* Problem: have I got an environment or not? */
NoStackFail:
PP = NULL;
/* find something to fool S */
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto fail;
@ -2800,6 +2786,7 @@ Yap_absmi(int inp)
/* don't forget I cannot creep at ; */
NoStackEither:
PP = PREG->u.sblp.p0;
if (ActiveSignals & YAP_CREEP_SIGNAL) {
goto either_notest;
}
@ -2876,8 +2863,9 @@ Yap_absmi(int inp)
goto creep;
NoStackDExecute:
PP = PREG->u.pp.p0;
if (ActiveSignals & YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.p.p;
PredEntry *ap = PREG->u.pp.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
@ -3014,6 +3002,10 @@ Yap_absmi(int inp)
#ifdef SHADOW_S
S = SREG;
#endif
/* tell whether we can creep or not, this is hard because we will
lose the info RSN
*/
PP = creep_allowed((PredEntry*)SREG,PP);
BEGD(d0);
d0 = ((PredEntry *)(SREG))->ArityOfPE;
if (d0 == 0) {
@ -3061,9 +3053,9 @@ Yap_absmi(int inp)
H += 2;
LOCK(SignalLock);
CreepFlag = CalculateStackGap();
#ifdef COROUTINING
if (ActiveSignals & YAP_WAKEUP_SIGNAL) {
CreepFlag = CalculateStackGap();
ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
UNLOCK(SignalLock);
ARG2 = Yap_ListOfWokenGoals();
@ -3072,13 +3064,16 @@ Yap_absmi(int inp)
Yap_UpdateTimedVar(WokenGoals, TermNil);
} else
#endif
{
CreepFlag = CalculateStackGap();
SREG = (CELL *) CreepCode;
}
UNLOCK(SignalLock);
PREG = ((PredEntry *)SREG)->CodeOfPred;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
#endif /* LOW_LEVEL_TRACE */
PREG = ((PredEntry *)(SREG))->CodeOfPred;
/* for profiler */
save_pc();
CACHE_A1();
@ -13428,6 +13423,7 @@ Yap_absmi(int inp)
ENDD(d0);
NoStackPExecute2:
PP = PredMetaCall;
SREG = (CELL *) pen;
ASP = ENV_YREG;
/* setup GB */
@ -13624,6 +13620,7 @@ Yap_absmi(int inp)
ENDD(d0);
NoStackPExecute:
PP = PredMetaCall;
SREG = (CELL *) pen;
ASP = ENV_YREG;
/* setup GB */
@ -13891,6 +13888,7 @@ Yap_absmi(int inp)
ENDD(d0);
ENDP(pt0);
NoStackPTExecute:
PP = NULL;
WRITEBACK_Y_AS_ENV();
SREG = (CELL *) pen;
ASP = ENV_YREG;

View File

@ -553,6 +553,33 @@ a_v(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct P
return code_p;
}
inline static yamop *
a_vp(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct PSEUDO *cpc, clause_info *clinfo)
{
Ventry *ve = (Ventry *) cpc->rnd1;
OPREG var_offset;
int is_y_var = (ve->KindOfVE == PermVar);
var_offset = Var_Ref(ve, is_y_var);
if (is_y_var) {
if (pass_no) {
code_p->opc = emit_op(opcodey);
code_p->u.yp.y = emit_yreg(var_offset);
code_p->u.yp.p0 = clinfo->CurrentPred;
}
GONEXT(yp);
}
else {
if (pass_no) {
code_p->opc = emit_op(opcodex);
code_p->u.xp.x = emit_xreg(var_offset);
code_p->u.xp.p0 = clinfo->CurrentPred;
}
GONEXT(xp);
}
return code_p;
}
inline static yamop *
a_uv(Ventry *ve, op_numbers opcodex, op_numbers opcodexw, op_numbers opcodey, op_numbers opcodeyw, yamop *code_p, int pass_no)
{
@ -3099,7 +3126,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_v(_save_b_x, _save_b_y, code_p, pass_no, cip->cpc);
break;
case commit_b_op:
code_p = a_v(_commit_b_x, _commit_b_y, code_p, pass_no, cip->cpc);
code_p = a_vp(_commit_b_x, _commit_b_y, code_p, pass_no, cip->cpc, &clinfo);
break;
case save_pair_op:
code_p = a_uv((Ventry *) cip->cpc->rnd1, _save_pair_x, _save_pair_x_write, _save_pair_y, _save_pair_y_write, code_p, pass_no);

View File

@ -3987,9 +3987,12 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
#endif /* TABLING_INNER_CUTS */
pc = NEXTOP(pc,e);
break;
/* instructions type xp */
case _commit_b_x:
pc = NEXTOP(pc,xp);
break;
/* instructions type x */
case _save_b_x:
case _commit_b_x:
case _get_list:
case _put_list:
case _write_x_var:
@ -4011,9 +4014,12 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
case _p_cut_by_x:
pc = NEXTOP(pc,xl);
break;
/* instructions type yp */
case _commit_b_y:
pc = NEXTOP(pc,yp);
break;
/* instructions type y */
case _save_b_y:
case _commit_b_y:
case _write_y_var:
case _write_y_val:
case _write_y_loc:

View File

@ -383,6 +383,7 @@ EnterCreepMode(Term t, Term mod) {
return do_execute(ARG1, mod);
}
}
PP = PredMetaCall;
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1));
if (mod) {
ARG1 = MkPairTerm(mod,t);
@ -623,6 +624,11 @@ p_execute_clause(void)
} else {
code = Yap_ClauseFromTerm(clt)->ClCode;
}
LOCK(SignalLock);
if (ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
UNLOCK(SignalLock);
return CallPredicate(RepPredProp(pe), cut_cp, code);
}
@ -745,6 +751,11 @@ p_execute_nonstop(void)
}
/* N = arity; */
/* call may not define new system predicates!! */
LOCK(SignalLock);
if (ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
UNLOCK(SignalLock);
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
} else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) &&
@ -2040,6 +2051,12 @@ p_uncaught_throw(void)
return out;
}
static Int
p_creep_allowed(void)
{
return (PP != NULL);
}
void
Yap_InitExecFs(void)
{
@ -2089,6 +2106,7 @@ Yap_InitExecFs(void)
Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag);
Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, HiddenPredFlag);
Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, HiddenPredFlag);
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, HiddenPredFlag);
Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, HiddenPredFlag);
}

View File

@ -503,7 +503,7 @@ p_creep(void)
}
static Int
p_delayed_creep(void)
p_signal_creep(void)
{
Atom at;
PredEntry *pred;
@ -511,11 +511,41 @@ p_delayed_creep(void)
at = Yap_FullLookupAtom("$creep");
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred;
do_signal(YAP_CREEP_SIGNAL);
LOCK(SignalLock);
ActiveSignals |= YAP_CREEP_SIGNAL;
UNLOCK(SignalLock);
return TRUE;
}
static Int
p_disable_creep(void)
{
LOCK(SignalLock);
if (ActiveSignals & YAP_CREEP_SIGNAL) {
ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(SignalLock);
return TRUE;
}
UNLOCK(SignalLock);
return FALSE;
}
/* never fails */
static Int
p_disable_docreep(void)
{
LOCK(SignalLock);
if (ActiveSignals & YAP_CREEP_SIGNAL) {
ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(SignalLock);
} else {
UNLOCK(SignalLock);
}
return TRUE;
}
static Int
@ -3925,8 +3955,10 @@ Yap_InitCPreds(void)
/* basic predicates for the prolog machine tracer */
/* they are defined in analyst.c */
/* Basic predicates for the debugger */
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$late_creep", 0, p_delayed_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$signal_creep", 0, p_signal_creep, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$disable_creep", 0, p_disable_creep, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$disable_docreep", 0, p_disable_docreep, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$do_not_creep", 0, p_stop_creep, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#ifdef DEBUG
Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag|HiddenPredFlag);

View File

@ -164,8 +164,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;
vsc_count++;
if (vsc_count < 82500)
return;
#ifdef THREADS
Yap_heap_regs->thread_handle[worker_id].thread_inst_count++;
#endif

View File

@ -117,8 +117,8 @@ typedef struct
choiceptr B_FZ_;
tr_fr_ptr TR_FZ_;
#endif /* SBA || TABLING */
#if defined(YAPOR) || defined(THREADS)
struct pred_entry *PP_;
#if defined(YAPOR) || defined(THREADS)
/* recursive write-locks for PredEntry */
yamop **PREG_ADDR_;
unsigned int worker_id_;
@ -699,9 +699,9 @@ EXTERN inline void restore_B(void) {
#define B_FZ Yap_REGS.B_FZ_
#define TR_FZ Yap_REGS.TR_FZ_
#endif /* SBA || TABLING */
#define PP (Yap_REGS.PP_)
#if defined(YAPOR) || defined(THREADS)
#define worker_id (Yap_REGS.worker_id_)
#define PP (Yap_REGS.PP_)
#define PREG_ADDR (Yap_REGS.PREG_ADDR_)
#ifdef SBA
#define BSEG Yap_REGS.BSEG_

View File

@ -38,8 +38,8 @@
OPCODE(cut_e ,e),
OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y),
OPCODE(commit_b_x ,x),
OPCODE(commit_b_y ,y),
OPCODE(commit_b_x ,xp),
OPCODE(commit_b_y ,yp),
OPCODE(execute ,pp),
OPCODE(dexecute ,pp),
OPCODE(fcall ,sbpp),

View File

@ -520,6 +520,11 @@ typedef struct yami {
wamreg x;
CELL next;
} x;
struct {
wamreg x;
struct pred_entry *p0;
CELL next;
} xp;
struct {
wamreg x;
CELL c;
@ -591,6 +596,11 @@ typedef struct yami {
yslot y;
CELL next;
} y;
struct {
yslot y;
struct pred_entry *p0;
CELL next;
} yp;
struct {
yslot y;
struct yami *F;

View File

@ -480,7 +480,6 @@ restore_opcodes(yamop *pc)
pc = NEXTOP(pc,sssllp);
break;
/* instructions type x */
case _commit_b_x:
case _get_list:
case _put_list:
case _save_b_x:
@ -554,6 +553,12 @@ restore_opcodes(yamop *pc)
pc->u.xllll.l4 = PtoOpAdjust(pc->u.xllll.l4);
pc = NEXTOP(pc,xllll);
break;
/* instructions type xp */
case _commit_b_x:
pc->u.xp.x = XAdjust(pc->u.xp.x);
pc->u.xp.p0 = PtoPredAdjust(pc->u.xp.p0);
pc = NEXTOP(pc,xp);
break;
/* instructions type xx */
case _get_x_val:
case _get_x_var:
@ -627,7 +632,6 @@ restore_opcodes(yamop *pc)
pc = NEXTOP(pc,xy);
break;
/* instructions type y */
case _commit_b_y:
case _save_b_y:
case _write_y_loc:
case _write_y_val:
@ -650,6 +654,12 @@ restore_opcodes(yamop *pc)
pc->u.yl.F = PtoOpAdjust(pc->u.yl.F);
pc = NEXTOP(pc,yl);
break;
/* instructions type yp */
case _commit_b_y:
pc->u.yp.y = YAdjust(pc->u.yp.y);
pc->u.yp.p0 = PtoPredAdjust(pc->u.yp.p0);
pc = NEXTOP(pc,yp);
break;
/* instructions type yx */
case _get_y_val:
case _get_y_var:

View File

@ -1164,3 +1164,9 @@ throw(Ball) :-
nb_setval('$system_mode',off),
( nb_getval('$trace',on) -> '$creep' ; true).
'$donotrace'(G) :-
'$disable_creep', !,
'$execute'(G),
'$creep'.
'$donotrace'(G) :-
'$execute'(G).

View File

@ -275,10 +275,10 @@ debugging :-
% $spy may be called from user code, so be careful.
'$spy'([Mod|G]) :-
nb_getval('$debug',off), !,
'$execute_nonstop'(G,Mod).
'$execute'(G,Mod).
'$spy'([Mod|G]) :-
nb_getval('$system_mode',on), !,
'$execute_nonstop'(G,Mod).
'$execute'(G,Mod).
'$spy'([Mod|G]) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, yes).
@ -289,79 +289,79 @@ debugging :-
'$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) :- !,
'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !,
'$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !,
'$do_spy'(A, M, CP, yes),
'$do_spy'(B, M, CP, InControl).
'$do_spy'((T->A;B), M, CP, InControl) :- !,
'$do_spy'(B, M, CP, CalledFromDebugger).
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
;
'$do_spy'(B, M, CP, InControl)
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A|B), M, CP, InControl) :- !,
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
;
'$do_spy'(B, M, CP, InControl)
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A), M, CP, _) :- !,
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ).
'$do_spy'((A;B), M, CP, InControl) :- !,
'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, yes)
;
'$do_spy'(B, M, CP, InControl)
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((A|B), M, CP, InControl) :- !,
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, yes)
;
'$do_spy'(B, M, CP, InControl)
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((\+G), M, CP, InControl) :- !,
\+ '$do_spy'(G, M, CP, InControl).
'$do_spy'((not(G)), M, CP, InControl) :- !,
\+ '$do_spy'(G, M, CP, InControl).
'$do_spy'(G, Module, _, InControl) :-
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'(G, Module, _, CalledFromDebugger) :-
nb_getval('$spy_gn',L), /* get goal no. */
L1 is L+1, /* bump it */
nb_setval('$spy_gn',L1), /* and save it globaly */
b_getval('$spy_glist',History), /* get goal list */
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det)|History]), /* and update it */
'$loop_spy'(L, G, Module, InControl). /* set creep on */
'$loop_spy'(L, G, Module, CalledFromDebugger). /* set creep on */
% we are skipping, so we can just call the goal,
% while leaving the minimal structure in place.
'$loop_spy'(GoalNumber, G, Module, InControl) :-
'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :-
yap_hacks:current_choice_point(CP),
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl, CP),
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP),
Module, Event,
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger)).
% handle weird things happening in the debugger.
'$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
'$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, CalledFromDebugger) :-
G0 >= GoalNumber, !,
'$loop_spy'(GoalNumber, G, Module, InControl).
'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger).
'$loop_spy_event'('$retry_spy'(GoalNumber), _, _, _, _) :- !,
throw('$retry_spy'(GoalNumber)).
'$loop_spy_event'('$fail_spy'(G0), GoalNumber, G, Module, InControl) :-
'$loop_spy_event'('$fail_spy'(G0), GoalNumber, G, Module, CalledFromDebugger) :-
G0 >= GoalNumber, !,
'$loop_fail'(GoalNumber, G, Module, InControl).
'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
'$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
throw('$fail_spy'(GoalNumber)).
'$loop_spy_event'('$done_spy'(G0,G), GoalNumber, G, _, _) :-
'$loop_spy_event'('$done_spy'(G0,G), GoalNumber, G, _, CalledFromDebugger) :-
G0 >= GoalNumber, !,
'$continue_debugging'.
'$continue_debugging'(CalledFromDebugger).
'$loop_spy_event'('$done_spy'(GoalNumber), _, _, _, _) :- !,
throw('$done_spy'(GoalNumber)).
'$loop_spy_event'(abort, _, _, _, _) :- !,
throw('$abort').
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl) :-
'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
'$debug_error'(Event),
'$system_catch'(
('$trace'(exception,G,Module,GoalNumber,_),fail),
Module,NewEvent,
'$loop_spy_event'(NewEvent, GoalNumber, G, Module, InControl)).
'$loop_spy_event'(NewEvent, GoalNumber, G, Module, CalledFromDebugger)).
'$debug_error'(Event) :-
@ -371,18 +371,19 @@ debugging :-
% just fail here, don't really need to call debugger, the user knows what he
% wants to do
'$loop_fail'(_GoalNumber, _G, _Module, _InControl) :-
'$continue_debugging',
'$loop_fail'(_GoalNumber, _G, _Module, _CalledFromDebugger) :-
'$continue_debugging'(CalledFromDebugger),
fail.
% if we are in
'$loop_spy2'(GoalNumber, G, Module, InControl, CP) :-
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
/* the following choice point is where the predicate is called */
b_getval('$spy_glist',[info(_,_,_,Retry,Det)|_]), /* get goal list */
(
/* call port */
'$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, InControl, Retry),
'$spycall'(G, Module, CalledFromDebugger, Retry),
'$disable_docreep',
(
'$debugger_deterministic_goal'(G) ->
Det=true
@ -402,23 +403,23 @@ debugging :-
;
true
),
'$continue_debugging'
'$continue_debugging'(CalledFromDebugger)
;
/* backtracking from exit */
/* we get here when we want to redo a goal */
/* redo port */
'$disable_docreep',
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
'$continue_debugging'(InControl,G,Module),
'$continue_debugging'(CalledFromDebugger),
fail /* to backtrack to spycalls */
)
;
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$continue_debugging',
'$continue_debugging'(CalledFromDebugger),
/* fail port */
fail
).
'$enter_goal'(GoalNumber, G, Module) :-
'$zip'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :-
@ -449,47 +450,49 @@ debugging :-
).
%
'$spycall'(G, M, _, _) :-
nb_getval('$debug_run',StopPoint),
StopPoint \= off,
!,
'$execute_nonstop'(G, M).
'$execute'(M:G).
'$spycall'(G, M, _, _) :-
'$system_predicate'(G,M),
\+ '$is_metapredicate'(G,M),
!,
'$execute_nonstop'(G, M).
'$spycall'(G, M, InControl, _) :-
'$execute'(M:G).
'$spycall'(G, M, _, _) :-
'$tabled_predicate'(G,M),
!,
'$continue_debugging'(InControl, G, M),
'$execute_nonstop'(G, M).
'$spycall'(G, M, InControl, InRedo) :-
'$continue_debugging'(no, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$flags'(G,M,F,F),
F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, user-C, or source
% use the interpreter
CP is '$last_choice_pt',
'$clause'(G, M, Cl),
( '$do_spy'(Cl, M, CP, InControl) ; InRedo = true ).
'$spycall'(G, M, InControl, InRedo) :-
( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$undefined'(G, M), !,
(
recorded('$import','$import'(NM,M,Goal,G,_,_),_)
->
'$spycall'(Goal, NM, InControl, InRedo)
'$spycall'(Goal, NM, CalledFromDebugger, InRedo)
;
'$enter_undefp',
'$find_undefp_handler'(G,M,Goal,NM)
->
'$spycall'(Goal, NM, InControl, InRedo)
'$spycall'(Goal, NM, CalledFromDebugger, InRedo)
).
'$spycall'(G, M, InControl, InRedo) :-
'$spycall'(G, M, _, InRedo) :-
% I lost control here.
CP is '$last_choice_pt',
'$static_clause'(G,M,_,R),
'$continue_debugging'(InControl, G, M),
( '$execute_clause'(G, M, R, CP) ; InRedo = true ).
(
'$continue_debugging'(no, '$execute_clause'(G, M, R, CP))
;
InRedo = true
).
'$tabled_predicate'(G,M) :-
'$flags'(G,M,F,F),
@ -656,20 +659,34 @@ debugging :-
'$ilgl'(C),
fail.
% if we are in the interpreter, don't need to care about forcing a trace, do we?
'$continue_debugging'(no,_,_) :- !.
'$continue_debugging'(_,G,M) :-
'$system_predicate'(G,M), !,
'$late_creep'.
'$continue_debugging'(_,_,_) :-
'nb_getval'('$debug_run',Zip),
(Zip == nodebug ; number(Zip) ; Zip = spy(_) ), !.
'$continue_debugging'(_,_,_) :-
'$continue_debugging'.
'$continue_debugging' :-
'$continue_debugging'(yes).
% do not need to debug!
'$continue_debugging'(no) :-
'$creep'.
% if we are in the interpreter, don't need to care about forcing a trace, do we?
'$continue_debugging'(yes,G) :- !,
'$execute_dgoal'(G).
% do not need to debug!
'$continue_debugging'(_,G) :-
'nb_getval'('$debug_run',Zip),
(Zip == nodebug ; number(Zip) ; Zip = spy(_) ), !,
'$execute_dgoal'(G).
'$continue_debugging'(_,G) :-
'$execute_creep_dgoal'(G).
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
'$execute_nonstop'(G,M).
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$execute_clause'(G, M, R, CP).
'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :-
'$signal_creep',
'$execute_nonstop'(G,M).
'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$signal_creep',
'$execute_clause'(G, M, R, CP).
'$show_ancestors'(HowMany) :-
b_getval('$spy_glist',[_|History]),
(

View File

@ -984,4 +984,4 @@ current_key(A,K) :-
'$notrace'(G, Mod) :-
\+ '$undefined'(G, Mod),
call(Mod:G).
'$donotrace'(Mod:G).

View File

@ -31,8 +31,13 @@
% if more signals alive, set creep flag
'$continue_signals',
'$wake_up_goal'(G, LG).
% never creep on entering system mode!!!
'$do_signal'(sig_creep, [M|G]) :-
'$creep_allowed', !,
'$start_creep'([M|G]).
'$do_signal'(sig_creep, [M|G]) :-
'$signal_creep',
'$execute_nonstop'(G,M).
'$do_signal'(sig_delay_creep, [M|G]) :-
'$execute'(M:G),
'$creep'.
@ -97,18 +102,13 @@
'$creep'.
'$start_creep'([Mod|G]) :-
'$hidden_predicate'(G,Mod), !,
'$creep',
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
'$system_predicate'(G, Mod),
'$protected_env', !,
'$creep',
'$execute_nonstop'(G,Mod).
'$execute_nonstop'(G,Mod),
'$creep'.
% do not debug if we are zipping through.
'$start_creep'([Mod|G]) :-
nb_getval('$debug_zip',on),
'$zip'(-1, G, Mod), !,
'$creep',
'$signal_creep',
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
CP is '$last_choice_pt',
@ -171,35 +171,4 @@ read_sig :-
read_sig.
'$protected_env' :-
yap_hacks:current_continuations([Env|Envs]),
yap_hacks:continuation(Env,_,Addr,_),
%'$envs'(Envs, Addr),
'$skim_envs'(Envs,Addr,Mod,Name,Arity),
\+ '$external_call_seen'(Mod,Name,Arity).
'$envs'([Env|Envs], Addr0) :-
yap_hacks:cp_to_predicate(Addr0,Mod0,Name0,Arity0,ClId),
format(user_error,'~a:~w/~w ~d~n',[Mod0,Name0,Arity0,ClId]),
yap_hacks:continuation(Env,_,Addr,_),
'$envs'(Envs, Addr).
'$envs'([], _) :- format(user_error,'*****done*****~n',[]).
'$skim_envs'([Env|Envs],Addr0,Mod,Name,Arity) :-
yap_hacks:cp_to_predicate(Addr0, Mod0, Name0, Arity0, _ClId),
'$debugger_env'(Mod0,Name0,Arity0), !,
yap_hacks:continuation(Env,_,Addr,_),
'$skim_envs'(Envs,Addr,Mod,Name,Arity).
'$skim_envs'(_,Addr,Mod,Name,Arity) :-
yap_hacks:cp_to_predicate(Addr, Mod, Name, Arity, _ClId).
'$debugger_env'(prolog,'$start_creep',1).
'$external_call_seen'(prolog,Name,Arity) :- !,
'$allowed'(Name,Arity).
'$external_call_seen'(_,_,_).
'$allowed'('$spycall',4).
'$allowed'('$query',2).