diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

debugger

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-05-20 01:00:41 +01:00
parent 0e47ddc802
commit 69dc2a963c
13 changed files with 2061 additions and 1944 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

362
C/exec.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: exec.c * * File: exec.c *
* Last rev: 8/2/88 * * Last rev: 8/2/88 *
* mods: * * mods: *
* comments: Execute Prolog code * * comments: Execute Prolog code *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#endif #endif
@ -37,18 +37,34 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "yapio.h" #include "yapio.h"
static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE); static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE);
// must hold thread worker comm lock at call. // must hold thread worker comm lock at call.
static bool EnterCreepMode(Term, Term CACHE_TYPE); static bool EnterCreepMode(Term, Term CACHE_TYPE);
static Int current_choice_point(USES_REGS1); static Int current_choice_point(USES_REGS1);
static Int execute(USES_REGS1); static Int execute(USES_REGS1);
static Int execute0(USES_REGS1); static Int execute0(USES_REGS1);
static bool should_creep() {
return
!(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode|BootMode))
&&
LOCAL_debugger_state[DEBUG_DEBUGGER_MAY_BE_CALLED] == TermTrue
&&
(
(Yap_has_a_signal() && !LOCAL_InterruptsDisabled) ||
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] == TermUserCreep ||
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] == TermLeap);
}
static Term cp_as_integer(choiceptr cp USES_REGS) { static Term cp_as_integer(choiceptr cp USES_REGS) {
return (MkIntegerTerm(LCL0 - (CELL *)cp)); return (MkIntegerTerm(LCL0 - (CELL *) cp));
} }
static choiceptr cp_from_integer(Term cpt USES_REGS) { static choiceptr cp_from_integer(Term cpt USES_REGS) {
return (choiceptr)(LCL0 - IntegerOfTerm(cpt)); return (choiceptr) (LCL0 - IntegerOfTerm(cpt));
} }
/** /**
@ -100,7 +116,7 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
CP = P; CP = P;
} }
/* make sure we have access to the user given cut */ /* make sure we have access to the user given cut */
YENV[E_CB] = (CELL)cut_pt; YENV[E_CB] = (CELL) cut_pt;
P = code; P = code;
return true; return true;
} }
@ -119,14 +135,14 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call"); Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call");
if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))) if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call"); Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call");
ARG1 = t; ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ARG3 = t; ARG3 = t;
if (mod) { if (mod) {
ARG4 = mod; ARG4 = mod;
} else { } else {
ARG4 = TermProlog; ARG4 = TermProlog;
} }
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) { if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return CallPredicate(PredTraceMetaCall, B, return CallPredicate(PredTraceMetaCall, B,
PredTraceMetaCall->CodeOfPred PASS_REGS); PredTraceMetaCall->CodeOfPred PASS_REGS);
@ -190,7 +206,7 @@ Term Yap_PredicateToIndicator(PredEntry *pe) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)); ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else { } else {
ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred)); ti[0] = MkAtomTerm((Atom) (pe->FunctorOfPred));
ti[1] = MkIntTerm(0); ti[1] = MkIntTerm(0);
} }
Term t = Yap_MkApplTerm(FunctorSlash, 2, ti); Term t = Yap_MkApplTerm(FunctorSlash, 2, ti);
@ -231,7 +247,7 @@ static Int current_choice_point(USES_REGS1) {
if (!IsVarTerm(t)) if (!IsVarTerm(t))
return (FALSE); return (FALSE);
td = cp_as_integer(B PASS_REGS); td = cp_as_integer(B PASS_REGS);
YapBind((CELL *)t, td); YapBind((CELL *) t, td);
return TRUE; return TRUE;
} }
@ -255,7 +271,7 @@ static Int parent_choice_point(USES_REGS1) {
if (cp == NULL || cp->cp_b == NULL) if (cp == NULL || cp->cp_b == NULL)
return false; return false;
td = cp_as_integer(cp->cp_b PASS_REGS); td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td); YapBind((CELL *) t, td);
return TRUE; return TRUE;
} }
@ -275,7 +291,7 @@ static Int parent_choice_point1(USES_REGS1) {
if (B == NULL || B->cp_b == NULL) if (B == NULL || B->cp_b == NULL)
return false; return false;
td = cp_as_integer(B->cp_b PASS_REGS); td = cp_as_integer(B->cp_b PASS_REGS);
YapBind((CELL *)t, td); YapBind((CELL *) t, td);
return true; return true;
} }
@ -288,8 +304,8 @@ static Int save_env_b(USES_REGS1) {
#endif #endif
if (!IsVarTerm(t)) if (!IsVarTerm(t))
return (FALSE); return (FALSE);
td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS); td = cp_as_integer((choiceptr) YENV[E_CB] PASS_REGS);
YapBind((CELL *)t, td); YapBind((CELL *) t, td);
return true; return true;
} }
@ -299,7 +315,7 @@ static Int save_env_b(USES_REGS1) {
static PredEntry *new_pred(Term t, Term tmod, char *pname) { static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t; Term t0 = t;
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
@ -339,9 +355,9 @@ static bool CommaCall(Term t, Term mod) {
for (i = 0; i < pen->ArityOfPE; i++) { for (i = 0; i < pen->ArityOfPE; i++) {
YENV[-EnvSizeInCells - i] = XREGS[i + 1]; YENV[-EnvSizeInCells - i] = XREGS[i + 1];
} }
YENV[E_CB] = (CELL)B; YENV[E_CB] = (CELL) B;
YENV[E_CP] = (CELL)P; YENV[E_CP] = (CELL) P;
YENV[E_E] = (CELL)ENV; YENV[E_E] = (CELL) ENV;
YENV[E_DEPTH] = DEPTH; YENV[E_DEPTH] = DEPTH;
ASP = YENV - (EnvSizeInCells + i); ASP = YENV - (EnvSizeInCells + i);
@ -358,8 +374,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
/* first do predicate expansion, even before you process signals. /* first do predicate expansion, even before you process signals.
This way you don't get to spy goal_expansion(). */ This way you don't get to spy goal_expansion(). */
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled && if ( should_creep() ) {
!(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode))) {
return EnterCreepMode(t, mod PASS_REGS); return EnterCreepMode(t, mod PASS_REGS);
} }
if (IsVarTerm(t) || IsVarTerm(mod)) { if (IsVarTerm(t) || IsVarTerm(mod)) {
@ -375,9 +390,9 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
if (f == FunctorComma && false) { if (f == FunctorComma && false) {
Term t2 = ArgOfTerm(2, t); Term t2 = ArgOfTerm(2, t);
if (IsVarTerm(t2)) if (IsVarTerm(t2))
return CallMetaCall(t0, mod0 PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
if (1 || !CommaCall(t2, mod)) if (1 || !CommaCall(t2, mod))
return CallMetaCall(t0, mod0 PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
Term t1 = ArgOfTerm(1, t); Term t1 = ArgOfTerm(1, t);
t = t1; t = t1;
@ -400,7 +415,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) { if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) {
return CallMetaCall(t0, mod0 PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
} }
pt = RepAppl(t) + 1; pt = RepAppl(t) + 1;
for (i = 1; i <= arity; i++) { for (i = 1; i <= arity; i++) {
@ -431,7 +446,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
pe = RepPredProp(PredPropByAtom(a, mod)); pe = RepPredProp(PredPropByAtom(a, mod));
return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS)); return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS));
} }
return CallMetaCall(t0, mod0 PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
} }
static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n,
@ -445,22 +460,22 @@ static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n,
*HR++ = pt[i]; *HR++ = pt[i];
} }
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
*HR++ = h0[(int)(i - n)]; *HR++ = h0[(int) (i - n)];
} }
tf = AbsPair(h0); tf = AbsPair(h0);
} else { } else {
*HR++ = (CELL)f; *HR++ = (CELL) f;
for (i = 0; i < arity - n; i++) { for (i = 0; i < arity - n; i++) {
*HR++ = pt[i]; *HR++ = pt[i];
} }
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
*HR++ = h0[(int)(i - n)]; *HR++ = h0[(int) (i - n)];
} }
tf = AbsAppl(h0); tf = AbsAppl(h0);
} }
if (mod != CurrentModule) { if (mod != CurrentModule) {
CELL *h0 = HR; CELL *h0 = HR;
*HR++ = (CELL)FunctorModule; *HR++ = (CELL) FunctorModule;
*HR++ = mod; *HR++ = mod;
*HR++ = tf; *HR++ = tf;
tf = AbsAppl(h0); tf = AbsAppl(h0);
@ -476,8 +491,8 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
unsigned int i, arity; unsigned int i, arity;
int j = -n; int j = -n;
Term t0 = t, mod0 = mod; Term t0 = t, mod0 = mod;
t = Yap_YapStripModule(t, &mod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS); return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
@ -555,8 +570,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
PredEntry *PredCreep; PredEntry *PredCreep;
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
ARG1 = t; if (!Yap_locked_growheap(false, 0, NULL)) {
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"YAP failed to grow heap at meta-call"); "YAP failed to grow heap at meta-call");
} }
@ -564,17 +578,13 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
return do_execute(ARG1, mod PASS_REGS); return do_execute(ARG1, mod PASS_REGS);
} }
} }
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep, 1)); PredCreep = RepPredProp(PredPropByFunc(FunctorCreep, 4));
PP = PredCreep; PP = PredCreep;
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) { if (IsVarTerm(t)) { return false; }
ARG1 = MkPairTerm(ArgOfTerm(1, t), ArgOfTerm(2, t)); ARG2 = mod;
} else { ARG1 = t;
if (mod) { ARG3 = MkVarTerm();
ARG1 = MkPairTerm(mod, t); ARG4 = MkVarTerm();
} else {
ARG1 = MkPairTerm(TermProlog, t);
}
}
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
P_before_spy = P; P_before_spy = P;
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS); return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
@ -595,7 +605,7 @@ static void heap_store(Term t USES_REGS) {
*HR++ = t; *HR++ = t;
} else { } else {
RESET_VARIABLE(HR); RESET_VARIABLE(HR);
Bind_Local(VarOfTerm(t), (CELL)HR); Bind_Local(VarOfTerm(t), (CELL) HR);
HR++; HR++;
} }
} else { } else {
@ -734,7 +744,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
yamop *code; yamop *code;
Term clt = Deref(ARG3); Term clt = Deref(ARG3);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE; return FALSE;
@ -793,7 +803,7 @@ restart_exec:
} }
static Int creep_clause(USES_REGS1) { /* '$execute_clause'(Goal) */ static Int creep_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
Int rc = execute_clause( PASS_REGS1 ); Int rc = execute_clause(PASS_REGS1);
if (!LOCAL_InterruptsDisabled) { if (!LOCAL_InterruptsDisabled) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
@ -861,22 +871,22 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
yamop *oP = P, *oCP = CP; yamop *oP = P, *oCP = CP;
Int oENV = LCL0 - ENV; Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV; Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B; Int oB = LCL0 - (CELL *) B;
yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t)); yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, ctx); bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, false); bool rc = Yap_RunTopGoal(t, false);
if (!rc) { if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB)); complete_inner_computation((choiceptr) (LCL0 - oB));
// We'll pass it through // We'll pass it through
} else { } else {
prune_inner_computation((choiceptr)(LCL0 - oB)); prune_inner_computation((choiceptr) (LCL0 - oB));
} }
Yap_popErrorContext(newxp, true); Yap_popErrorContext(newxp, true);
P = oP; P = oP;
CP = oCP; CP = oCP;
ENV = LCL0 - oENV; ENV = LCL0 - oENV;
YENV = LCL0 - oYENV; YENV = LCL0 - oYENV;
B = (choiceptr)(LCL0 - oB); B = (choiceptr) (LCL0 - oB);
return true; return true;
} }
@ -884,7 +894,7 @@ extern void *Yap_blob_info(Term t);
static bool set_watch(Int Bv, Term task) { static bool set_watch(Int Bv, Term task) {
CELL *pt; CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL)setup_call_catcher_cleanup_tag, Term t = Yap_AllocExternalDataInStack((CELL) setup_call_catcher_cleanup_tag,
sizeof(Int), &pt); sizeof(Int), &pt);
if (t == TermNil) if (t == TermNil)
return false; return false;
@ -956,7 +966,7 @@ static bool watch_retry(Term d0 USES_REGS) {
Term cleanup = ArgOfTerm(3, task); Term cleanup = ArgOfTerm(3, task);
bool complete = !IsVarTerm(ArgOfTerm(4, task)); bool complete = !IsVarTerm(ArgOfTerm(4, task));
bool active = ArgOfTerm(5, task) == TermTrue; bool active = ArgOfTerm(5, task) == TermTrue;
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task))); choiceptr B0 = (choiceptr) (LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
LOCAL_Signals = 0; LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
@ -1044,14 +1054,14 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
} }
static Int tag_cleanup(USES_REGS1) { static Int tag_cleanup(USES_REGS1) {
Int iB = LCL0 - (CELL *)B; Int iB = LCL0 - (CELL *) B;
set_watch(iB, Deref(ARG2)); set_watch(iB, Deref(ARG2));
return Yap_unify(ARG1, MkIntegerTerm(iB)); return Yap_unify(ARG1, MkIntegerTerm(iB));
} }
static Int cleanup_on_exit(USES_REGS1) { static Int cleanup_on_exit(USES_REGS1) {
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1))); choiceptr B0 = (choiceptr) (LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2); Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue; bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task); Term cleanup = ArgOfTerm(3, task);
@ -1070,7 +1080,7 @@ static Int cleanup_on_exit(USES_REGS1) {
CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4); CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
if (B < B0) { if (B < B0) {
// non-deterministic // non-deterministic
set_watch(LCL0 - (CELL *)B, task); set_watch(LCL0 - (CELL *) B, task);
if (!box) { if (!box) {
return true; return true;
} }
@ -1112,7 +1122,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) && if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true , omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
/* system:goal_expansion(A,B) */ /* system:goal_expansion(A,B) */
mg_args[0] = cmod; mg_args[0] = cmod;
@ -1199,11 +1209,11 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
unsigned int arity; unsigned int arity;
Prop pe; Prop pe;
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) { if (should_creep()) {
return EnterCreepMode(t, mod PASS_REGS); return EnterCreepMode(t, mod PASS_REGS);
} }
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false; return false;
@ -1322,7 +1332,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) { if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -1337,9 +1347,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
rc = CallPredicate(RepPredProp(pe), B, rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->CodeOfPred PASS_REGS); RepPredProp(pe)->CodeOfPred PASS_REGS);
} }
if (!LOCAL_InterruptsDisabled && if (should_creep()) {
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
return rc; return rc;
@ -1405,7 +1413,7 @@ static Int execute_nonstop(USES_REGS1) {
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) { if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -1417,9 +1425,7 @@ static Int execute_nonstop(USES_REGS1) {
return CallPredicate(RepPredProp(pe), B, return CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS); RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
} else { } else {
if (Yap_get_signal(YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled && if (should_creep()) {
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
return CallPredicate(RepPredProp(pe), B, return CallPredicate(RepPredProp(pe), B,
@ -1499,6 +1505,7 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
} }
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
static Int execute_depth_limit(USES_REGS1) { static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2); Term d = Deref(ARG2);
if (IsVarTerm(d)) { if (IsVarTerm(d)) {
@ -1516,6 +1523,7 @@ static Int execute_depth_limit(USES_REGS1) {
} }
return execute(PASS_REGS1); return execute(PASS_REGS1);
} }
#endif #endif
static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
@ -1544,14 +1552,15 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
/* H is not so important, because we're gonna backtrack */ /* H is not so important, because we're gonna backtrack */
restore_H(); restore_H();
/* set stack */ /* set stack */
ASP = (CELL *)PROTECT_FROZEN_B(B); ASP = (CELL *) PROTECT_FROZEN_B(B);
/* forget any signals active, we're reborne */ /* forget any signals active, we're reborne */
LOCAL_Signals = 0; LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
P = (yamop *)FAILCODE; P = (yamop *) FAILCODE;
} break; }
break;
case 2: { case 2: {
// LOCAL_ActiveError = err_info; // LOCAL_ActiveError = err_info;
/* arithmetic exception */ /* arithmetic exception */
@ -1563,11 +1572,12 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
pop_text_stack(i + 1); pop_text_stack(i + 1);
Yap_set_fpu_exceptions( Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE; P = (yamop *) FAILCODE;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
} break; }
break;
case 3: { /* saved state */ case 3: { /* saved state */
// LOCAL_ActiveError = err_info; // LOCAL_ActiveError = err_info;
pop_text_stack(i + 1); pop_text_stack(i + 1);
@ -1591,7 +1601,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
} }
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
P = (yamop *)FAILCODE; P = (yamop *) FAILCODE;
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
pop_text_stack(i + 1); pop_text_stack(i + 1);
@ -1611,10 +1621,10 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
Yap_JumpToEnv(); Yap_JumpToEnv();
Yap_CloseTemporaryStreams(); Yap_CloseTemporaryStreams();
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
ASP = (CELL *)PROTECT_FROZEN_B(B); ASP = (CELL *) PROTECT_FROZEN_B(B);
if (B == NULL || B->cp_b == NULL || if (B == NULL || B->cp_b == NULL ||
(CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) { (CELL *) (B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder; LOCAL_CBorder = OldBorder;
pop_text_stack(i + 1); pop_text_stack(i + 1);
@ -1643,11 +1653,11 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
Yap_ResetException(worker_id); Yap_ResetException(worker_id);
// sl = Yap_InitSlot(t); // sl = Yap_InitSlot(t);
YENV = ASP; YENV = ASP;
YENV[E_CP] = (CELL)YESCODE; YENV[E_CP] = (CELL) YESCODE;
YENV[E_CB] = (CELL)B; YENV[E_CB] = (CELL) B;
YENV[E_E] = (CELL)ENV; YENV[E_E] = (CELL) ENV;
#ifdef TABLING #ifdef TABLING
YENV[E_B] = (CELL)B; YENV[E_B] = (CELL) B;
#endif #endif
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH; YENV[E_DEPTH] = DEPTH;
@ -1663,7 +1673,7 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
XREGS[i + 1] = *pt++; XREGS[i + 1] = *pt++;
} }
} }
B = (choiceptr)ASP; B = (choiceptr) ASP;
B--; B--;
B->cp_h = HR; B->cp_h = HR;
B->cp_tr = TR; B->cp_tr = TR;
@ -1674,8 +1684,8 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
B->cp_depth = DEPTH; B->cp_depth = DEPTH;
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B; YENV = ASP = (CELL *) B;
YENV[E_CB] = (CELL)B; YENV[E_CB] = (CELL) B;
HB = HR; HB = HR;
CP = YESCODE; CP = YESCODE;
} }
@ -1685,7 +1695,7 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) {
bool out; bool out;
Yap_PrepGoal(arity, pt, saved_b PASS_REGS); Yap_PrepGoal(arity, pt, saved_b PASS_REGS);
// CACHE_A1(); // CACHE_A1();
P = (yamop *)CodeAdr; P = (yamop *) CodeAdr;
// S = CellPtr(RepPredProp( // S = CellPtr(RepPredProp(
// PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */ // PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */
@ -1739,12 +1749,12 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
if (POP_CHOICE_POINT(B->cp_b)) { if (POP_CHOICE_POINT(B->cp_b)) {
POP_EXECUTE(); POP_EXECUTE();
} }
ENV = (CELL *)(ENV[E_E]); ENV = (CELL *) (ENV[E_E]);
/* ASP should be set to the top of the local stack when we /* ASP should be set to the top of the local stack when we
did the call */ did the call */
ASP = B->cp_env; ASP = B->cp_env;
/* YENV should be set to the current environment */ /* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]); YENV = ENV = (CELL *) ((B->cp_env)[E_E]);
if (B->cp_b) { if (B->cp_b) {
B = B->cp_b; B = B->cp_b;
} }
@ -1773,7 +1783,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* we succeeded, let's prune */ /* we succeeded, let's prune */
/* restore the old environment */ /* restore the old environment */
/* get to previous environment */ /* get to previous environment */
cut_B = (choiceptr)ENV[E_CB]; cut_B = (choiceptr) ENV[E_CB];
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(cut_B); CUT_prune_to(cut_B);
#endif /* YAPOR */ #endif /* YAPOR */
@ -1794,7 +1804,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH = ENV[E_DEPTH]; DEPTH = ENV[E_DEPTH];
#endif #endif
ENV = (CELL *)(ENV[E_E]); ENV = (CELL *) (ENV[E_E]);
/* we have failed, and usually we would backtrack to this B, /* we have failed, and usually we would backtrack to this B,
trouble is, we may also have a delayed cut to do */ trouble is, we may also have a delayed cut to do */
if (B != NULL) if (B != NULL)
@ -1802,9 +1812,9 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
YENV = ENV; YENV = ENV;
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if ( Yap_HasException()) { if (Yap_HasException()) {
if (pass_ex && if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) { ((LOCAL_PrologMode & BootMode) || !CurrentModule)) {
Yap_ResetException(LOCAL_ActiveError); Yap_ResetException(LOCAL_ActiveError);
} else { } else {
Yap_RaiseException(); Yap_RaiseException();
@ -1823,15 +1833,15 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
did the call */ did the call */
ASP = B->cp_env; ASP = B->cp_env;
/* YENV should be set to the current environment */ /* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]); YENV = ENV = (CELL *) ((B->cp_env)[E_E]);
B = B->cp_b; B = B->cp_b;
SET_BB(B); SET_BB(B);
HB = PROTECT_FROZEN_H(B); HB = PROTECT_FROZEN_H(B);
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if ( Yap_HasException()) { if (Yap_HasException()) {
if (pass_ex && if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) { ((LOCAL_PrologMode & BootMode) || !CurrentModule)) {
Yap_ResetException(LOCAL_ActiveError); Yap_ResetException(LOCAL_ActiveError);
} else { } else {
Yap_RaiseException(); Yap_RaiseException();
@ -1890,9 +1900,9 @@ void Yap_trust_last(void) {
DEPTH = B->cp_depth; DEPTH = B->cp_depth;
#endif #endif
YENV = ASP = B->cp_env; YENV = ASP = B->cp_env;
ENV = (CELL *)((B->cp_env)[E_E]); ENV = (CELL *) ((B->cp_env)[E_E]);
B = B->cp_b; B = B->cp_b;
P = (yamop *)(ENV[E_CP]); P = (yamop *) (ENV[E_CP]);
if (B) { if (B) {
SET_BB(B); SET_BB(B);
HB = PROTECT_FROZEN_H(B); HB = PROTECT_FROZEN_H(B);
@ -1988,10 +1998,10 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
Int max = ArityOfFunctor(FunctorOfTerm(t)) - 4; Int max = ArityOfFunctor(FunctorOfTerm(t)) - 4;
CELL *ptr = RepAppl(t) + 5; CELL *ptr = RepAppl(t) + 5;
P = (yamop *)IntegerOfTerm(ptr[-4]); P = (yamop *) IntegerOfTerm(ptr[-4]);
CP = (yamop *)IntegerOfTerm(ptr[-3]); CP = (yamop *) IntegerOfTerm(ptr[-3]);
ENV = (CELL *)(LCL0 - IntegerOfTerm(ptr[-2])); ENV = (CELL *) (LCL0 - IntegerOfTerm(ptr[-2]));
YENV = (CELL *)(LCL0 - IntegerOfTerm(ptr[-1])); YENV = (CELL *) (LCL0 - IntegerOfTerm(ptr[-1]));
for (i = 0; i < max; i += 2) { for (i = 0; i < max; i += 2) {
Int j = IntOfTerm(ptr[0]); Int j = IntOfTerm(ptr[0]);
XREGS[j] = ptr[1]; XREGS[j] = ptr[1];
@ -2043,10 +2053,10 @@ static Int restore_regs2(USES_REGS1) {
#if YAPOR_SBA #if YAPOR_SBA
pt0 = (choiceptr)d; pt0 = (choiceptr)d;
#else #else
pt0 = (choiceptr)(LCL0 - d); pt0 = (choiceptr) (LCL0 - d);
#endif #endif
/* find where to cut to */ /* find where to cut to */
if ((CELL *)pt0 != LCL0 && pt0 > B) { if ((CELL *) pt0 != LCL0 && pt0 > B) {
/* Wow, we're gonna cut!!! */ /* Wow, we're gonna cut!!! */
while (B->cp_b < pt0) { while (B->cp_b < pt0) {
while (POP_CHOICE_POINT(B->cp_b)) { while (POP_CHOICE_POINT(B->cp_b)) {
@ -2094,7 +2104,7 @@ static Int clean_ifcp(USES_REGS1) {
B = B->cp_b; B = B->cp_b;
HB = B->cp_h; HB = B->cp_h;
} else { } else {
pt0->cp_ap = (yamop *)TRUSTFAILCODE; pt0->cp_ap = (yamop *) TRUSTFAILCODE;
} }
return TRUE; return TRUE;
} }
@ -2107,7 +2117,7 @@ static int disj_marker(yamop *apc) {
static Int cut_up_to_next_disjunction(USES_REGS1) { static Int cut_up_to_next_disjunction(USES_REGS1) {
choiceptr pt0 = B; choiceptr pt0 = B;
CELL *qenv = (CELL *)ENV[E_E]; CELL *qenv = (CELL *) ENV[E_E];
while (pt0 && !(qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) { while (pt0 && !(qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) {
pt0 = pt0->cp_b; pt0 = pt0->cp_b;
@ -2153,7 +2163,7 @@ bool Yap_Reset(yap_reset_t mode, bool hard) {
Yap_InitYaamRegs(worker_id, false); Yap_InitYaamRegs(worker_id, false);
GLOBAL_Initialised = true; GLOBAL_Initialised = true;
ENV = LCL0; ENV = LCL0;
ASP = (CELL *)B; ASP = (CELL *) B;
/* the first real choice-point will also have AP=FAIL */ /* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */ /* always have an empty slots for people to use */
P = CP = YESCODE; P = CP = YESCODE;
@ -2188,7 +2198,7 @@ static Int JumpToEnv(USES_REGS1) {
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException(); // DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch && while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE && LOCAL_CBorder < LCL0 - (CELL *) handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) { handler->cp_b != NULL) {
handler->cp_ap = TRUSTFAILCODE; handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b; handler = handler->cp_b;
@ -2225,7 +2235,7 @@ static Int jump_env(USES_REGS1) {
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1); bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
LCL0 - (CELL *)B > LOCAL_CBorder) { LCL0 - (CELL *) B > LOCAL_CBorder) {
// we're failing up to the top layer // we're failing up to the top layer
} }
pop_text_stack(LOCAL_MallocDepth + 1); pop_text_stack(LOCAL_MallocDepth + 1);
@ -2236,10 +2246,11 @@ static Int jump_env(USES_REGS1) {
static Int generate_pred_info(USES_REGS1) { static Int generate_pred_info(USES_REGS1) {
ARG1 = ARG3 = ENV[-EnvSizeInCells - 1]; ARG1 = ARG3 = ENV[-EnvSizeInCells - 1];
ARG4 = ENV[-EnvSizeInCells - 3]; ARG4 = ENV[-EnvSizeInCells - 3];
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS); ARG2 = cp_as_integer((choiceptr) ENV[E_CB] PASS_REGS);
return TRUE; return TRUE;
} }
void Yap_InitYaamRegs(int myworker_id, bool full_reset) { void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
Term h0var; Term h0var;
// getchar(); // getchar();
@ -2260,11 +2271,11 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
CACHE_REGS CACHE_REGS
Yap_ResetException(LOCAL_ActiveError); Yap_ResetException(LOCAL_ActiveError);
Yap_PutValue(AtomBreak, MkIntTerm(0)); Yap_PutValue(AtomBreak, MkIntTerm(0));
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) + HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) +
1; // +1: hack to ensure the gc does not try to mark mistakenly 1; // +1: hack to ensure the gc does not try to mark mistakenly
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); LCL0 = ASP = (CELL *) REMOTE_LocalBase(myworker_id);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); CurrentTrailTop = (tr_fr_ptr) (REMOTE_TrailTop(myworker_id) - MinTrailGap);
/* notice that an initial choice-point and environment /* notice that an initial choice-point and environment
*must* be created for the garbage collector to work */ *must* be created for the garbage collector to work */
B = NULL; B = NULL;
@ -2286,7 +2297,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
h0var = MkVarTerm(); h0var = MkVarTerm();
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
#endif #endif
size_t defsz = 128*1024; size_t defsz = 128 * 1024;
Yap_AllocateDefaultArena(defsz, myworker_id, NULL); Yap_AllocateDefaultArena(defsz, myworker_id, NULL);
} else { } else {
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id)); HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
@ -2297,8 +2308,8 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
BSEG = BSEG =
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); BBREG = B_FZ = (choiceptr) REMOTE_LocalBase(myworker_id);
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
/* the first real choice-point will also have AP=FAIL */ /* the first real choice-point will also have AP=FAIL */
@ -2319,8 +2330,8 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
BSEG = BSEG =
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); BBREG = B_FZ = (choiceptr) REMOTE_LocalBase(myworker_id);
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
#ifdef TABLING #ifdef TABLING
@ -2354,6 +2365,98 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
return TRUE; return TRUE;
} }
static Int get_debugger_state(USES_REGS1) {
const char *s = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (!strcmp(s, "creep")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP]);
}
if (!strcmp(s, "goal_number")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_GOAL_NUMBER]);
}
if (!strcmp(s, "spy")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_SPY]);
}
if (!strcmp(s, "trace")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_TRACE_MODE]);
}
if (!strcmp(s, "debug")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_TRACE_MODE]);
}
return false;
}
static Int set_debugger_state(USES_REGS1) {
const char *s = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (!strcmp(s, "creep")) {
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] = Deref(ARG2);
return true;
}
if (!strcmp(s, "goal_number")) {
LOCAL_debugger_state[DEBUG_GOAL_NUMBER] = Deref(ARG2);
return true;
}
if (!strcmp(s, "spy")) {
LOCAL_debugger_state[DEBUG_SPY] = Deref(ARG2);
return true;
}
if (!strcmp(s, "trace")) {
LOCAL_debugger_state[DEBUG_TRACE_MODE] = Deref(ARG2);
return true;
}
if (!strcmp(s, "debug")) {
LOCAL_debugger_state[DEBUG_DEBUGGER_MAY_BE_CALLED] = Deref(ARG2);
return true;
}
return false;
}
static Int set_debugger_state4(USES_REGS1) {
Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] = t1;
}
t1 = Deref(ARG2);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_GOAL_NUMBER] = t1;
}
t1 = Deref(ARG3);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_SPY] = t1;
}
t1 = Deref(ARG4);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_TRACE_MODE] = t1;
}
return true;
}
static Int get_debugger_state4(USES_REGS1) {
Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP], t1))
return false;
}
t1 = Deref(ARG2);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_GOAL_NUMBER], t1))
return false;
}
t1 = Deref(ARG3);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_SPY], t1))
return false;
}
t1 = Deref(ARG4);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_TRACE_MODE], t1))
return false;
}
return true;
}
void Yap_InitExecFs(void) { void Yap_InitExecFs(void) {
CACHE_REGS CACHE_REGS
YAP_opaque_handler_t catcher_ops; YAP_opaque_handler_t catcher_ops;
@ -2397,7 +2500,7 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag); Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag);
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
Yap_InitCPred("$creep_clause", 4,creep_clause, NoTracePredFlag); Yap_InitCPred("$creep_clause", 4, creep_clause, NoTracePredFlag);
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0);
CurrentModule = HACKS_MODULE; CurrentModule = HACKS_MODULE;
@ -2423,4 +2526,9 @@ void Yap_InitExecFs(void) {
0); 0);
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag); Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
Yap_InitCPred("$get_debugger_state", 2, get_debugger_state, 0);
Yap_InitCPred("$get_debugger_state", 4, get_debugger_state4, 0);
Yap_InitCPred("$set_debugger_state", 2, set_debugger_state, 0);
Yap_InitCPred("$set_debugger_state", 4, set_debugger_state4, 0);
} }

5
H/ATOMS
View File

@ -91,6 +91,7 @@ A Context N "context"
A Cputime N "cputime" A Cputime N "cputime"
A Create N "create" A Create N "create"
A Creep F "$creep" A Creep F "$creep"
A UserCreep N "creep"
A CryptAtoms N "crypt_atoms" A CryptAtoms N "crypt_atoms"
A Curly N "{}" A Curly N "{}"
A Csult F "$csult" A Csult F "$csult"
@ -222,6 +223,7 @@ A LOOP N "_LOOP_"
A LoopStream N "loop_stream" A LoopStream N "loop_stream"
A LT N "<" A LT N "<"
A LastExecuteWithin F "$last_execute_within" A LastExecuteWithin F "$last_execute_within"
A Leap N "leap"
A Leash F "$leash" A Leash F "$leash"
A Least N "least" A Least N "least"
A Length F "length" A Length F "length"
@ -454,6 +456,7 @@ A WriteTerm N "write_term"
A Xml N "xml" A Xml N "xml"
A YapHacks N "yap_hacks" A YapHacks N "yap_hacks"
A ZeroDivisor N "zero_divisor" A ZeroDivisor N "zero_divisor"
A Zip N "zip"
F AfInet AfInet 2 F AfInet AfInet 2
F AfLocal AfLocal 1 F AfLocal AfLocal 1
F AfUnix AfUnix 1 F AfUnix AfUnix 1
@ -486,7 +489,7 @@ F Comma Comma 2
F CommentHook CommentHook 3 F CommentHook CommentHook 3
F Context2 Context 2 F Context2 Context 2
F ConsistencyError ConsistencyError 1 F ConsistencyError ConsistencyError 1
F Creep Creep 1 F Creep Creep 4
F Csult Csult 2 F Csult Csult 2
F CurrentModule CurrentModule 1 F CurrentModule CurrentModule 1
F CutBy CutBy 1 F CutBy CutBy 1

12
H/amidefs.h
View File

@ -1043,4 +1043,16 @@ extern void **Yap_ABSMI_OPCODES;
#endif #endif
/// Debugging Support
typedef enum {
DEBUG_CREEP_LEAP_OR_ZIP = 0,
DEBUG_GOAL_NUMBER = 1,
DEBUG_SPY = 2,
DEBUG_TRACE_MODE = 3,
DEBUG_GOAL_QUEUE = 4,
DEBUG_DEBUGGER_MAY_BE_CALLED = 5,
DEBUG_NUMBER_OF_OPTS =6
} debug_key_t ;
#endif #endif

5
H/generated/iatoms.h
View File

@ -86,6 +86,7 @@
AtomCputime = Yap_LookupAtom("cputime"); TermCputime = MkAtomTerm(AtomCputime); AtomCputime = Yap_LookupAtom("cputime"); TermCputime = MkAtomTerm(AtomCputime);
AtomCreate = Yap_LookupAtom("create"); TermCreate = MkAtomTerm(AtomCreate); AtomCreate = Yap_LookupAtom("create"); TermCreate = MkAtomTerm(AtomCreate);
AtomCreep = Yap_FullLookupAtom("$creep"); TermCreep = MkAtomTerm(AtomCreep); AtomCreep = Yap_FullLookupAtom("$creep"); TermCreep = MkAtomTerm(AtomCreep);
AtomUserCreep = Yap_LookupAtom("creep"); TermUserCreep = MkAtomTerm(AtomUserCreep);
AtomCryptAtoms = Yap_LookupAtom("crypt_atoms"); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms); AtomCryptAtoms = Yap_LookupAtom("crypt_atoms"); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms);
AtomCurly = Yap_LookupAtom("{}"); TermCurly = MkAtomTerm(AtomCurly); AtomCurly = Yap_LookupAtom("{}"); TermCurly = MkAtomTerm(AtomCurly);
AtomCsult = Yap_FullLookupAtom("$csult"); TermCsult = MkAtomTerm(AtomCsult); AtomCsult = Yap_FullLookupAtom("$csult"); TermCsult = MkAtomTerm(AtomCsult);
@ -216,6 +217,7 @@
AtomLoopStream = Yap_LookupAtom("loop_stream"); TermLoopStream = MkAtomTerm(AtomLoopStream); AtomLoopStream = Yap_LookupAtom("loop_stream"); TermLoopStream = MkAtomTerm(AtomLoopStream);
AtomLT = Yap_LookupAtom("<"); TermLT = MkAtomTerm(AtomLT); AtomLT = Yap_LookupAtom("<"); TermLT = MkAtomTerm(AtomLT);
AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within"); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin); AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within"); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin);
AtomLeap = Yap_LookupAtom("leap"); TermLeap = MkAtomTerm(AtomLeap);
AtomLeash = Yap_FullLookupAtom("$leash"); TermLeash = MkAtomTerm(AtomLeash); AtomLeash = Yap_FullLookupAtom("$leash"); TermLeash = MkAtomTerm(AtomLeash);
AtomLeast = Yap_LookupAtom("least"); TermLeast = MkAtomTerm(AtomLeast); AtomLeast = Yap_LookupAtom("least"); TermLeast = MkAtomTerm(AtomLeast);
AtomLength = Yap_FullLookupAtom("length"); TermLength = MkAtomTerm(AtomLength); AtomLength = Yap_FullLookupAtom("length"); TermLength = MkAtomTerm(AtomLength);
@ -448,6 +450,7 @@
AtomXml = Yap_LookupAtom("xml"); TermXml = MkAtomTerm(AtomXml); AtomXml = Yap_LookupAtom("xml"); TermXml = MkAtomTerm(AtomXml);
AtomYapHacks = Yap_LookupAtom("yap_hacks"); TermYapHacks = MkAtomTerm(AtomYapHacks); AtomYapHacks = Yap_LookupAtom("yap_hacks"); TermYapHacks = MkAtomTerm(AtomYapHacks);
AtomZeroDivisor = Yap_LookupAtom("zero_divisor"); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor); AtomZeroDivisor = Yap_LookupAtom("zero_divisor"); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor);
AtomZip = Yap_LookupAtom("zip"); TermZip = MkAtomTerm(AtomZip);
FunctorAfInet = Yap_MkFunctor(AtomAfInet,2); FunctorAfInet = Yap_MkFunctor(AtomAfInet,2);
FunctorAfLocal = Yap_MkFunctor(AtomAfLocal,1); FunctorAfLocal = Yap_MkFunctor(AtomAfLocal,1);
FunctorAfUnix = Yap_MkFunctor(AtomAfUnix,1); FunctorAfUnix = Yap_MkFunctor(AtomAfUnix,1);
@ -480,7 +483,7 @@
FunctorCommentHook = Yap_MkFunctor(AtomCommentHook,3); FunctorCommentHook = Yap_MkFunctor(AtomCommentHook,3);
FunctorContext2 = Yap_MkFunctor(AtomContext,2); FunctorContext2 = Yap_MkFunctor(AtomContext,2);
FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1); FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1);
FunctorCreep = Yap_MkFunctor(AtomCreep,1); FunctorCreep = Yap_MkFunctor(AtomCreep,4);
FunctorCsult = Yap_MkFunctor(AtomCsult,2); FunctorCsult = Yap_MkFunctor(AtomCsult,2);
FunctorCurrentModule = Yap_MkFunctor(AtomCurrentModule,1); FunctorCurrentModule = Yap_MkFunctor(AtomCurrentModule,1);
FunctorCutBy = Yap_MkFunctor(AtomCutBy,1); FunctorCutBy = Yap_MkFunctor(AtomCutBy,1);

3
H/generated/ratoms.h
View File

@ -86,6 +86,7 @@
AtomCputime = AtomAdjust(AtomCputime); TermCputime = MkAtomTerm(AtomCputime); AtomCputime = AtomAdjust(AtomCputime); TermCputime = MkAtomTerm(AtomCputime);
AtomCreate = AtomAdjust(AtomCreate); TermCreate = MkAtomTerm(AtomCreate); AtomCreate = AtomAdjust(AtomCreate); TermCreate = MkAtomTerm(AtomCreate);
AtomCreep = AtomAdjust(AtomCreep); TermCreep = MkAtomTerm(AtomCreep); AtomCreep = AtomAdjust(AtomCreep); TermCreep = MkAtomTerm(AtomCreep);
AtomUserCreep = AtomAdjust(AtomUserCreep); TermUserCreep = MkAtomTerm(AtomUserCreep);
AtomCryptAtoms = AtomAdjust(AtomCryptAtoms); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms); AtomCryptAtoms = AtomAdjust(AtomCryptAtoms); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms);
AtomCurly = AtomAdjust(AtomCurly); TermCurly = MkAtomTerm(AtomCurly); AtomCurly = AtomAdjust(AtomCurly); TermCurly = MkAtomTerm(AtomCurly);
AtomCsult = AtomAdjust(AtomCsult); TermCsult = MkAtomTerm(AtomCsult); AtomCsult = AtomAdjust(AtomCsult); TermCsult = MkAtomTerm(AtomCsult);
@ -216,6 +217,7 @@
AtomLoopStream = AtomAdjust(AtomLoopStream); TermLoopStream = MkAtomTerm(AtomLoopStream); AtomLoopStream = AtomAdjust(AtomLoopStream); TermLoopStream = MkAtomTerm(AtomLoopStream);
AtomLT = AtomAdjust(AtomLT); TermLT = MkAtomTerm(AtomLT); AtomLT = AtomAdjust(AtomLT); TermLT = MkAtomTerm(AtomLT);
AtomLastExecuteWithin = AtomAdjust(AtomLastExecuteWithin); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin); AtomLastExecuteWithin = AtomAdjust(AtomLastExecuteWithin); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin);
AtomLeap = AtomAdjust(AtomLeap); TermLeap = MkAtomTerm(AtomLeap);
AtomLeash = AtomAdjust(AtomLeash); TermLeash = MkAtomTerm(AtomLeash); AtomLeash = AtomAdjust(AtomLeash); TermLeash = MkAtomTerm(AtomLeash);
AtomLeast = AtomAdjust(AtomLeast); TermLeast = MkAtomTerm(AtomLeast); AtomLeast = AtomAdjust(AtomLeast); TermLeast = MkAtomTerm(AtomLeast);
AtomLength = AtomAdjust(AtomLength); TermLength = MkAtomTerm(AtomLength); AtomLength = AtomAdjust(AtomLength); TermLength = MkAtomTerm(AtomLength);
@ -447,6 +449,7 @@
AtomWriteTerm = AtomAdjust(AtomWriteTerm); TermWriteTerm = MkAtomTerm(AtomWriteTerm); AtomWriteTerm = AtomAdjust(AtomWriteTerm); TermWriteTerm = MkAtomTerm(AtomWriteTerm);
AtomXml = AtomAdjust(AtomXml); TermXml = MkAtomTerm(AtomXml); AtomXml = AtomAdjust(AtomXml); TermXml = MkAtomTerm(AtomXml);
AtomYapHacks = AtomAdjust(AtomYapHacks); TermYapHacks = MkAtomTerm(AtomYapHacks); AtomYapHacks = AtomAdjust(AtomYapHacks); TermYapHacks = MkAtomTerm(AtomYapHacks);
AtomZip = AtomAdjust(AtomZip); TermZip = MkAtomTerm(AtomZip);
AtomZeroDivisor = AtomAdjust(AtomZeroDivisor); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor); AtomZeroDivisor = AtomAdjust(AtomZeroDivisor); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor);
FunctorAfInet = FuncAdjust(FunctorAfInet); FunctorAfInet = FuncAdjust(FunctorAfInet);
FunctorAfLocal = FuncAdjust(FunctorAfLocal); FunctorAfLocal = FuncAdjust(FunctorAfLocal);

8
H/generated/tatoms.h
View File

@ -85,7 +85,8 @@ X_API EXTERNAL Atom AtomConsultOnBoot; X_API EXTERNAL Term TermConsultOnBoot;
X_API EXTERNAL Atom AtomContext; X_API EXTERNAL Term TermContext; X_API EXTERNAL Atom AtomContext; X_API EXTERNAL Term TermContext;
X_API EXTERNAL Atom AtomCputime; X_API EXTERNAL Term TermCputime; X_API EXTERNAL Atom AtomCputime; X_API EXTERNAL Term TermCputime;
X_API EXTERNAL Atom AtomCreate; X_API EXTERNAL Term TermCreate; X_API EXTERNAL Atom AtomCreate; X_API EXTERNAL Term TermCreate;
X_API EXTERNAL Atom AtomCreep; X_API EXTERNAL Term TermCreep; X_API EXTERNAL Atom AtomCreep; X_API EXTERNAL Term TermCreep;
X_API EXTERNAL Atom AtomUserCreep; X_API EXTERNAL Term TermUserCreep;
X_API EXTERNAL Atom AtomCryptAtoms; X_API EXTERNAL Term TermCryptAtoms; X_API EXTERNAL Atom AtomCryptAtoms; X_API EXTERNAL Term TermCryptAtoms;
X_API EXTERNAL Atom AtomCurly; X_API EXTERNAL Term TermCurly; X_API EXTERNAL Atom AtomCurly; X_API EXTERNAL Term TermCurly;
X_API EXTERNAL Atom AtomCsult; X_API EXTERNAL Term TermCsult; X_API EXTERNAL Atom AtomCsult; X_API EXTERNAL Term TermCsult;
@ -216,7 +217,8 @@ X_API EXTERNAL Atom AtomLOOP; X_API EXTERNAL Term TermLOOP;
X_API EXTERNAL Atom AtomLoopStream; X_API EXTERNAL Term TermLoopStream; X_API EXTERNAL Atom AtomLoopStream; X_API EXTERNAL Term TermLoopStream;
X_API EXTERNAL Atom AtomLT; X_API EXTERNAL Term TermLT; X_API EXTERNAL Atom AtomLT; X_API EXTERNAL Term TermLT;
X_API EXTERNAL Atom AtomLastExecuteWithin; X_API EXTERNAL Term TermLastExecuteWithin; X_API EXTERNAL Atom AtomLastExecuteWithin; X_API EXTERNAL Term TermLastExecuteWithin;
X_API EXTERNAL Atom AtomLeash; X_API EXTERNAL Term TermLeash; X_API EXTERNAL Atom AtomLeash; X_API EXTERNAL Term TermLeash;
X_API EXTERNAL Atom AtomLeap; X_API EXTERNAL Term TermLeap;
X_API EXTERNAL Atom AtomLeast; X_API EXTERNAL Term TermLeast; X_API EXTERNAL Atom AtomLeast; X_API EXTERNAL Term TermLeast;
X_API EXTERNAL Atom AtomLength; X_API EXTERNAL Term TermLength; X_API EXTERNAL Atom AtomLength; X_API EXTERNAL Term TermLength;
X_API EXTERNAL Atom AtomList; X_API EXTERNAL Term TermList; X_API EXTERNAL Atom AtomList; X_API EXTERNAL Term TermList;
@ -448,6 +450,8 @@ X_API EXTERNAL Atom AtomWriteTerm; X_API EXTERNAL Term TermWriteTerm;
X_API EXTERNAL Atom AtomXml; X_API EXTERNAL Term TermXml; X_API EXTERNAL Atom AtomXml; X_API EXTERNAL Term TermXml;
X_API EXTERNAL Atom AtomYapHacks; X_API EXTERNAL Term TermYapHacks; X_API EXTERNAL Atom AtomYapHacks; X_API EXTERNAL Term TermYapHacks;
X_API EXTERNAL Atom AtomZeroDivisor; X_API EXTERNAL Term TermZeroDivisor; X_API EXTERNAL Atom AtomZeroDivisor; X_API EXTERNAL Term TermZeroDivisor;
X_API EXTERNAL Atom AtomZip; X_API EXTERNAL Term TermZip;
X_API EXTERNAL Functor FunctorAfInet; X_API EXTERNAL Functor FunctorAfInet;
X_API EXTERNAL Functor FunctorAfLocal; X_API EXTERNAL Functor FunctorAfLocal;

2
H/locals.h
View File

@ -33,6 +33,8 @@ LOCAL_INIT(bool, newline, true);
LOCAL_INIT(Atom, AtPrompt, AtomNil); LOCAL_INIT(Atom, AtPrompt, AtomNil);
LOCAL_ARRAY(char, Prompt, MAX_PROMPT + 1); LOCAL_ARRAY(char, Prompt, MAX_PROMPT + 1);
LOCAL_ARRAY(Term, debugger_state, DEBUG_NUMBER_OF_OPTS);
LOCAL_INITF(encoding_t, encoding, Yap_DefaultEncoding()); LOCAL_INITF(encoding_t, encoding, Yap_DefaultEncoding());
LOCAL_INIT(bool, quasi_quotations, false); LOCAL_INIT(bool, quasi_quotations, false);
LOCAL_INIT(UInt, default_priority, 1200); LOCAL_INIT(UInt, default_priority, 1200);

2
pl/control.yap
View File

@ -473,7 +473,7 @@ b_getval(GlobalVariable, Val) :-
'$debug_stop' :- '$debug_stop' :-
nb_setval('$debug_state', state(creep,0,stop)), '$set_debugger_state'( zip,0,stop,off ),
b_setval('$trace',off), b_setval('$trace',off),
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
b_setval('$spy_glist',[]), b_setval('$spy_glist',[]),

131
pl/debug.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/ *************************************************************************/
:- system_module('$_debug', :- system_module('$_debug',
[], [],
['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]). ['$trace_goal'/4, '$init_debugger'/0, '$skipeol'/1]).
@ -252,7 +252,7 @@ be lost.
* *
* The debugger is an interpreter. with main predicates: * The debugger is an interpreter. with main predicates:
* - $trace: this is the API * - $trace: this is the API
* - $trace_query: reduce a query to a goal * - $trace_goal: reduce a query to a goal
* - $trace_goal: execute: * - $trace_goal: execute:
* + using the source, Luke * + using the source, Luke
* + hooking into the WAM procedure call mechanism * + hooking into the WAM procedure call mechanism
@ -299,7 +299,7 @@ be lost.
%%! The first case matches system_predicates or zip %%! The first case matches system_predicates or zip
'$trace'(Mod:G) :- '$trace'(Mod:G) :-
'$$save_by'(CP), '$$save_by'(CP),
'$trace_query'(G, Mod, CP, _G). '$trace_goal'(G, Mod, CP, _G).
'$trace'(Mod:G, A1) :- '$trace'(Mod:G, A1) :-
@ -394,64 +394,57 @@ be lost.
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, _G ). '$trace_goal'(G, M, CP, _G ).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded)
'$creep'([M|Q]) :-
'$yap_strip_module'(G,M,Q),
'$current_choicepoint'(CP),
'$trace_goal'(Q, M, CP, _G ).
'$creep'(G0, M0, _CP, H) :-
'$yap_strip_module'(M0:G0, M, G), % spy a literal
'$id_goal'(L),
'$current_choicepoint'(CP),
'$trace_goal'(G, M, CP,L).
%% @pred '$trace_goal'( +G, +M, +CP, +Expanded)
% %
% debug a complex query % debug a complex query
% %
'$trace_query'(V, M, _CP, _) :- '$trace_goal'(V, M, _,_) :-
var(V), var(V),
!, !,
call(M:V). call(M:V).
'$trace_query'(!, _, CP, _) :- '$trace_goal'(!, _, _,CP) :-
!, !,
'$$cut_by'(CP). '$$cut_by'(CP).
'$trace_query'('$cut_by'(M), _, _, _) :- '$trace_goal'('$cut_by'(M), _, _, _) :-
!, !,
'$$cut_by'(M). '$$cut_by'(M).
'$trace_query'('$$cut_by'(M), _, _, _) :- '$trace_goal'('$$cut_by'(M), _, _, _) :-
!, !,
'$$cut_by'(M). '$$cut_by'(M).
'$trace_query'(M:G, _, CP,S) :- '$trace_goal'(M:G, _, S, CP) :-
!, !,
'$yap_strip_module'(M:G, M0, G0), '$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S ). '$trace_goal'(G0, M0, S, CP ).
'$trace_query'((A,B), M, CP, S) :- !, '$trace_goal'((A,B), M, S, CP) :- !,
'$trace_query'(A, M, CP, S), '$trace_goal'(A, M, S, CP),
'$trace_query'(B, M, CP, S). '$trace_goal'(B, M, S, CP).
'$trace_query'((A->B), M, CP, S) :- !, '$trace_goal'((A->B), M, S, CP) :- !,
'$trace_query'(A, M, CP, S) -> '$trace_goal'(A, M, S, CP) ->
'$trace_query'(B, M, CP, S). '$trace_goal'(B, M, S, CP).
'$trace_query'((A;B), M, CP, S) :- !, '$trace_goal'((A;B), M, S, CP) :- !,
'$trace_query'(A, M, CP, S); '$trace_goal'(A, M, S, CP);
'$trace_query'(B, M, CP, S). '$trace_goal'(B, M, S, CP).
'$trace_query'((A|B), M, CP, S) :- !, '$trace_goal'((A|B), M, S, CP) :- !,
'$trace_query'(A, M, CP, S); '$trace_goal'(A, M, S, CP);
'$trace_query'(B, M, CP, S). '$trace_goal'(B, M, S, CP).
'$trace_query'((\+ A), M, CP, S) :- !, '$trace_goal'((\+ A), M, S, CP) :- !,
'$trace_query'(A, M, CP, S). '$trace_goal'(A, M, S, CP).
'$trace_query'(G, M,_CP,S) :-
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
strip_module(M:G1, MF, NG),
% spy a literal
'$id_goal'(L),
catch(
'$trace_goal'(NG, MF, L, S),
E,
'$TraceError'(E, G, M, L, S)
).
'$trace_query'(G, M, _CP, H) :-
% spy a literal
'$id_goal'(L),
catch(
'$trace_goal'(G, M, L, H),
E,
'$TraceError'(E, G, M, L, H)
).
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
%% %%
@ -465,8 +458,8 @@ be lost.
), ),
!, !,
gated_call( gated_call(
'$start_user_code', '$set_debugger_state'(debug, false),
'$execute'(G,M), '$execute_nonstop'(G,M),
Port, Port,
'$reenter_debugger'(Port) '$reenter_debugger'(Port)
). ).
@ -475,8 +468,7 @@ be lost.
'$creep_is_off'(M:G, GoalNumber), '$creep_is_off'(M:G, GoalNumber),
!, !,
gated_call( gated_call(
'$start_user_code', '$set_debugger_state'(debug, false),
% try creeping
'$execute_nonstop'(G,M), '$execute_nonstop'(G,M),
Port, Port,
'$trace_port_'( Port, GoalNumber, G, M, H) '$trace_port_'( Port, GoalNumber, G, M, H)
@ -617,7 +609,7 @@ be lost.
%%% - abort: forward throw while the call is newer than goal %%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) %% @pred '$re_trace_goal'( Exception, +Goal, +Mod, +GoalID )
% %
% debugger code for exceptions. Recognised cases are: % debugger code for exceptions. Recognised cases are:
% - abort always forwarded % - abort always forwarded
@ -678,7 +670,7 @@ be lost.
Goal. Goal.
'$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap
'__NB_getval__'('$debug_state',state(leap,Border,_,_), fail), '$get_debugger_state'( leap,Border,_,_), fail ,
GoalNumber < Border, GoalNumber < Border,
!. !.
'$port'(P,G,Module,L,Deterministic, Info) :- '$port'(P,G,Module,L,Deterministic, Info) :-
@ -720,7 +712,7 @@ be lost.
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %' '$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %'
'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %' '$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
% the same as fail. % the same as fail.
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'10000 =:= 0. %' '$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'10000 =:= 0. %
'$debugger_write'(Stream, G) :- '$debugger_write'(Stream, G) :-
current_prolog_flag( debugger_print_options, OUT ), !, current_prolog_flag( debugger_print_options, OUT ), !,
@ -733,7 +725,7 @@ be lost.
'$action'(C,P,CallNumber,G,Module,H). '$action'(C,P,CallNumber,G,Module,H).
'$action'('\n',_,_,_,_,_) :- !, % newline creep '$action'('\n',_,_,_,_,_) :- !, % newline creep
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(creep, 0, stop, Trace)). '$set_debugger_state'( creep, 0, stop, Trace ).
'$action'(!,_,_,_,_,_) :- !, % ! 'g execute '$action'(!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G), read(debugger_input, G),
% don't allow yourself to be caught by creep. % don't allow yourself to be caught by creep.
@ -750,7 +742,7 @@ be lost.
!, % <'Depth !, % <'Depth
skip( debugger_input, 10), skip( debugger_input, 10),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(creep, 0, stop,Trace)). '$set_debugger_state'( creep, 0, stop,Trace).
'$action'(^,_,_,G,_,_) :- !, % ' '$action'(^,_,_,G,_,_) :- !, % '
'$print_deb_sterm'(G), '$print_deb_sterm'(G),
skip( debugger_input, 10), skip( debugger_input, 10),
@ -771,7 +763,7 @@ be lost.
'$action'(c,_,_,_,_,_) :- !, % 'c creep '$action'(c,_,_,_,_,_) :- !, % 'c creep
skip( debugger_input, 10), skip( debugger_input, 10),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state',status(creep,0,stop,Trace)). '$set_debugger_state'( creep,0,stop,Trace ).
'$action'(e,_,_,_,_,_) :- !, % 'e exit '$action'(e,_,_,_,_,_) :- !, % 'e exit
halt. halt.
'$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail '$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail
@ -806,22 +798,22 @@ be lost.
'$scan_number'(ScanNumber), '$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, stop,Trace)). '$set_debugger_state'( leap, Goal, stop,Trace ).
'$action'(z,_,_allNumber,_,_,_H) :- !, % 'z zip, fast leap '$action'(z,_,_allNumber,_,_,_H) :- !, % 'z zip, fast leap
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, stop, Trace)). '$set_debugger_state'( zip, 0, stop, Trace).
% skip first call (for current goal), % skip first call (for current goal),
% stop next time. % stop next time.
'$action'(k,_,_CallNumber,_,_,_) :- !, % 'k zip, fast leap '$action'(k,_,_CallNumber,_,_,_) :- !, % 'k zip, fast leap
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, stop, Trace)). '$set_debugger_state'( zip, 0, stop, Trace).
% skip first call (for current goal), % skip first call (for current goal),
% stop next time. % stop next time.
'$action'(n,_,_,_,_,_) :- !, % 'n nodebug '$action'(n,_,_,_,_,_) :- !, % 'n nodebug
skip( debugger_input, 10), % ' skip( debugger_input, 10), % '
% tell debugger never to stop. % tell debugger never to stop.
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, ignore, Trace)), '$set_debugger_state'( zip, 0, ignore, Trace),
nodebug. nodebug.
'$action'(r,_,CallNumber,_,_,_) :- !, % r retry '$action'(r,_,CallNumber,_,_,_) :- !, % r retry
'$scan_number'(ScanNumber), '$scan_number'(ScanNumber),
@ -832,7 +824,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P==call; P==redo) -> ( (P==call; P==redo) ->
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, ignore,Trace) ) ; '$set_debugger_state'( leap, Goal, ignore,Trace),
'$ilgl'(s) % ' '$ilgl'(s) % '
). ).
'$action'(t,P,CallNumber,_,_,_) :- !, % 't fast skip '$action'(t,P,CallNumber,_,_,_) :- !, % 't fast skip
@ -840,7 +832,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P=call; P=redo) -> ( (P=call; P=redo) ->
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, Goal, ignore,Trace)) ; '$set_debugger_state'( zip, Goal, ignore,Trace),
'$ilgl'(t) % ' '$ilgl'(t) % '
). ).
'$action'(q,P,CallNumber,_,_,_) :- !, % 'qst skip '$action'(q,P,CallNumber,_,_,_) :- !, % 'qst skip
@ -848,7 +840,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P=call; P=redo) -> ( (P=call; P=redo) ->
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, stop, Trace)) ; '$set_debugger_state'( leap, Goal, stop, Trace),
'$ilgl'(t) % ' '$ilgl'(t) % '
). ).
'$action'(+,_,_,G,M,_) :- !, %% spy this '$action'(+,_,_,G,M,_) :- !, %% spy this
@ -1019,11 +1011,11 @@ be lost.
'$cps'([]). '$cps'([]).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :- '$debugger_skip_trace_goal'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), yap_hacks:choicepoint(CP,_,prolog,'$trace_goal',4,(_;_),_),
!, !,
'$debugger_skip_trace_query'(CPs,CPs1). '$debugger_skip_trace_goal'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs). '$debugger_skip_trace_goal'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :- '$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_),
@ -1069,10 +1061,5 @@ be lost.
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :- '$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s). '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$creep'(creep) :- '$creep'.
'$creep'(leap) :- '$creep'.
'$creep'(zip).
%% @} %% @}
%% @} %% @}

2
pl/init.yap
View File

@ -248,7 +248,7 @@ top_query(G) :-
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
nb_setval('$debug_jump',off), nb_setval('$debug_jump',off),
'__NB_setval__'('$trace',off), '__NB_setval__'('$trace',off),
nb_setval('$debug_state', state(zip, 0, stop,off)), '$set_debugger_state'( zip, 0, stop,off),
set_prolog_flag(break_level, 0), set_prolog_flag(break_level, 0),
catch(user:G, Error, '$Error'(Error)). catch(user:G, Error, '$Error'(Error)).

10
pl/protect.yap
View File

@ -46,11 +46,15 @@ prolog:'$protect' :-
'$is_system_module'(M), '$is_system_module'(M),
functor(P,Name,Arity), functor(P,Name,Arity),
'$new_system_predicate'(Name,Arity,M), '$new_system_predicate'(Name,Arity,M),
sub_atom(Name,0,1,_, '$'),
functor(P,Name,Arity),
'$stash_predicate'(P,M),
% '$hide_predicate'(P,M), % '$hide_predicate'(P,M),
fail. fail.
prolog:'$protect' :-
'$current_predicate'(Name,M,P,_),
'$is_system_module'(M),
functor(P,Name,Arity),
\+ '$visible'(Name),
'$set_private'(P,M),
fail.
prolog:'$protect' :- prolog:'$protect' :-
current_atom(Name), current_atom(Name),
sub_atom(Name,0,1,_, '$'), sub_atom(Name,0,1,_, '$'),

36
pl/spy.yap
View File

@ -206,11 +206,10 @@ debug :-
'$start_user_code' :- '$start_user_code' :-
yap_flag(debug, Can), yap_flag(debug, Can),
'__NB_setval__'(debug, Can), '$set_debugger_state'(debug, Can),
'__NB_getval__'('$trace',Trace, fail), '__NB_getval__'('$trace',Trace, fail),
( Trace == on -> Creep = creep; Creep = zip ), ( Trace == on -> Creep = creep; Creep = zip ),
'__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). '$set_debugger_state'( Creep, 0, stop, Trace ).
nodebug :- nodebug :-
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
'$init_debugger', '$init_debugger',
@ -378,13 +377,13 @@ notrace(G) :-
). ).
'$creep_at_port'(retry) :- '$creep_at_port'(retry) :-
'__NB_getval__'(debug, true, fail), '$get_debugger_state'(debug, true),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
Trace = on, Trace = on,
!, !,
'$enable_debugging'. '$enable_debugging'.
'$creep_at_port'(fail) :- '$creep_at_port'(fail) :-
'__NB_getval__'(debug, true, fail), '$get_debugger_state'(debug, true),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
Trace = on, Trace = on,
!, !,
@ -400,10 +399,10 @@ notrace(G) :-
'$init_debugger_trace' :- '$init_debugger_trace' :-
'__NB_getval__'('$trace',on,fail), '__NB_getval__'('$trace',on,fail),
!, !,
nb_setval('$debug_state', state(creep, 0, stop, on)). '$set_debugger_state'( creep, 0, stop, on ).
'$init_debugger_trace' :- '$init_debugger_trace' :-
'__NB_setval__'('$trace',off), '__NB_setval__'('$trace',off),
nb_setval('$debug_state', state(zip, 0, stop, off)). '$set_debugger_state'( zip, 0, stop, off ).
%% @pred $enter_debugging(G,Mod,CP,G0,NG) %% @pred $enter_debugging(G,Mod,CP,G0,NG)
%% %%
@ -448,7 +447,7 @@ notrace(G) :-
'$reenter_debugger'(fail) :- '$reenter_debugger'(fail) :-
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$reenter_debugger'(_) :- '$reenter_debugger'(_) :-
'__NB_setval__'(debug, false). '$set_debugger_state'(debug, false).
% what to do when you exit the debugger. % what to do when you exit the debugger.
'$continue_debugging'(exit) :- '$continue_debugging'(exit) :-
@ -486,29 +485,29 @@ notrace(G) :-
current_prolog_flag( debug, false ) current_prolog_flag( debug, false )
-> true -> true
; ;
'$is_opaque_zpredicate'(G,Module) '$is_opaque_predicate'(G,Module)
-> true -> true
; ;
'$is_private'(G,Module) '$is_private'(G,Module)
-> true -> true
; ;
'__NB_getval__'('$debug_state',state(zip, GN, Spy,_), fail) '$get_debugger_state'( creep, zip ) ->
->
true true
; ;
'$pred_being_spied'(G,Module) '$pred_being_spied'(G,Module)
-> ->
Spy == ignore '$get_debugger_state'( spy, ignore )
; ;
var(GN) var(GN)
-> ->
false false
; ;
GN > GoalNo '$get_debugger_state'( goal_number, GoalNo ) ,
GN < GoalNo
). ).
'$creep_is_on_at_entry'(G,M,_GoalNo) :- '$creep_is_on_at_entry'(G,M,_GoalNo) :-
\+ '$is_system_predicate'(G,M), \+ '$is_system_predicate'(G,M),
'__NB_getval__'('$debug_state',state(Step, _GN, Spy,_), fail), '$get_debugger_state'(Step, _GN, Spy,_),
( (
Step \= zip Step \= zip
; ;
@ -518,13 +517,14 @@ notrace(G) :-
'$trace_on' :- '$trace_on' :-
'__NB_getval__'('$debug_state', state(_Creep, GN, Spy,Trace), fail), '$get_debugger_state'(_Creep, GN, Spy,Trace),
nb_setval('$trace',on), nb_setval('$trace',on),
nb_setval('$debug_state', state(creep, GN, Spy, Trace)). '$set_debugger_state'( creep, GN, Spy, Trace).
'$trace_off' :- '$trace_off' :-
'__NB_getval__'('$debug_state', state(_Creep, GN, Spy, Trace),fail), '$get_debugger_state'( _Creep, GN, Spy, Trace),
nb_setval('$debug_state', state(zip, GN, Spy,Trace)). nb_setval('$trace',off),
'$set_debugger_state'( creep, GN, Spy, Trace).
/* /*

17
pl/top.yap
View File

@ -44,7 +44,7 @@ live :-
/* main execution loop */ /* main execution loop */
'$read_toplevel'(Goal, Bindings, Pos) :- '$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt', '$prompt',
catch(read_term(user_input, catch(read_term(user_input,
Goal, Goal,
@ -577,18 +577,9 @@ write_query_answer( Bindings ) :-
'$current_choice_point'(CP), '$current_choice_point'(CP),
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, CP, G0, M) :-
catch('$trace_query'(G, M, CP, G0), E, '$Error'(E)).
'$user_call'(G, M) :- '$user_call'(G, M) :-
( '$current_choice_point'(CP),
'$creep_is_off'(Module:G, GoalNo) gated_call('$start_user_code',M:G,Port,'$reenter_debugger'(Port)).
->
gated_call('$start_user_code',call(M:G),Port,'$reenter_debugger'(Port))
;
'$trace'(M:G)
).
'$cut_by'(CP) :- '$$cut_by'(CP). '$cut_by'(CP) :- '$$cut_by'(CP).
@ -1017,7 +1008,7 @@ log_event( String, Args ) :-
DBON = true DBON = true
-> ->
( (
'__NB_getval__'('$debug_state',state( _, _, _,on), fail), '$get_debugger_state'( trace,on),
( (
var(LF) var(LF)
-> ->