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
parent
d636450512
commit
1226b58d8e
96
C/absmi.c
96
C/absmi.c
|
|
@ -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,48 +2648,12 @@ 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 *) ap;
|
||||
goto creepc;
|
||||
}
|
||||
SREG = (CELL *) PREG->u.sbpp.p;
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
|
|
@ -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
|
||||
SREG = (CELL *) CreepCode;
|
||||
{
|
||||
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;
|
||||
|
|
|
|||
29
C/amasm.c
29
C/amasm.c
|
|
@ -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);
|
||||
|
|
|
|||
10
C/cdmgr.c
10
C/cdmgr.c
|
|
@ -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:
|
||||
|
|
|
|||
18
C/exec.c
18
C/exec.c
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
42
C/stdpreds.c
42
C/stdpreds.c
|
|
@ -503,7 +503,7 @@ p_creep(void)
|
|||
}
|
||||
|
||||
static Int
|
||||
p_delayed_creep(void)
|
||||
p_signal_creep(void)
|
||||
{
|
||||
Atom at;
|
||||
PredEntry *pred;
|
||||
|
|
@ -511,13 +511,43 @@ 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);
|
||||
CreepFlag = CalculateStackGap();
|
||||
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
|
||||
p_stop_creep(void)
|
||||
{
|
||||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
4
H/Regs.h
4
H/Regs.h
|
|
@ -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_
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
12
H/amidefs.h
12
H/amidefs.h
|
|
@ -522,7 +522,12 @@ typedef struct yami {
|
|||
} x;
|
||||
struct {
|
||||
wamreg x;
|
||||
CELL c;
|
||||
struct pred_entry *p0;
|
||||
CELL next;
|
||||
} xp;
|
||||
struct {
|
||||
wamreg x;
|
||||
CELL c;
|
||||
CELL next;
|
||||
} xc;
|
||||
struct {
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
14
H/rclause.h
14
H/rclause.h
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
155
pl/debug.yap
155
pl/debug.yap
|
|
@ -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 */
|
||||
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
|
||||
'$continue_debugging'(InControl,G,Module),
|
||||
fail /* to backtrack to spycalls */
|
||||
'$disable_docreep',
|
||||
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
|
||||
'$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, _) :-
|
||||
\+ '$is_metapredicate'(G,M),
|
||||
'$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]),
|
||||
(
|
||||
|
|
|
|||
|
|
@ -984,4 +984,4 @@ current_key(A,K) :-
|
|||
|
||||
'$notrace'(G, Mod) :-
|
||||
\+ '$undefined'(G, Mod),
|
||||
call(Mod:G).
|
||||
'$donotrace'(Mod:G).
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
|
|
|||
Reference in New Issue