debugging

This commit is contained in:
Vitor Santos Costa 2017-09-17 07:48:21 +01:00
parent 3fd8ccb06b
commit 65126b1b54
6 changed files with 274 additions and 301 deletions

106
C/exec.c
View File

@ -886,7 +886,7 @@ static bool watch_retry(Term d0 USES_REGS) {
complete_pt[0] = t; complete_pt[0] = t;
} else if (box) { } else if (box) {
t = TermRetry; t = TermRedo;
} else { } else {
return true; return true;
} }
@ -952,7 +952,6 @@ static Int cleanup_on_exit(USES_REGS1) {
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);
Term catcher = ArgOfTerm(2, task);
Term complete = IsNonVarTerm(ArgOfTerm(4, task)); Term complete = IsNonVarTerm(ArgOfTerm(4, task));
while (B->cp_ap->opc == FAIL_OPCODE) while (B->cp_ap->opc == FAIL_OPCODE)
@ -1152,6 +1151,83 @@ restart_exec:
RepPredProp(pe)->CodeOfPred PASS_REGS); RepPredProp(pe)->CodeOfPred PASS_REGS);
} }
static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
*/
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
unsigned int arity;
Prop pe;
bool rc;
t = Yap_YapStripModule(t, &mod);
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
register CELL *pt;
if (IsExtensionFunctor(f))
return (FALSE);
pe = PredPropByFunc(f, mod);
arity = ArityOfFunctor(f);
if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
}
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t) + 1;
for (i = 1; i <= arity; ++i) {
#if YAPOR_SBA
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt - 1);
else
XREGS[i] = d0;
#else
XREGS[i] = *pt++;
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
}
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) {
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag) {
PP = RepPredProp(pe);
PELOCK(80, PP);
}
#endif
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
} else {
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->CodeOfPred PASS_REGS);
}
if (!LOCAL_InterruptsDisabled &&
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return rc;
}
static Int execute_nonstop(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod) static Int execute_nonstop(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
*/ */
Term t = Deref(ARG1); Term t = Deref(ARG1);
@ -1361,8 +1437,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
} }
LOCAL_PrologMode &= ~AbortMode; LOCAL_PrologMode &= ~AbortMode;
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
if (LOCAL_CBorder)
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
return false; return false;
break; break;
@ -1927,23 +2001,14 @@ static Int JumpToEnv() {
so get pointers here */ so get pointers here */
/* 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 &&
// printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder); LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
if (handler == (choiceptr)(LCL0 - LOCAL_CBorder)) { handler->cp_b != NULL) {
break;
}
/* we are already doing a catch */
/* make sure we prune C-choicepoints */
if ((handler->cp_ap == NOCODE && handler->cp_b == NULL) ||
(handler->cp_b >= (choiceptr)(LCL0 - LOCAL_CBorder))) {
break;
}
handler = handler->cp_b; handler = handler->cp_b;
} }
if (LOCAL_PrologMode & AsyncIntMode) { if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL); Yap_signal(YAP_FAIL_SIGNAL);
} }
POP_FAIL(handler);
B = handler; B = handler;
P = FAILCODE; P = FAILCODE;
return true; return true;
@ -1979,7 +2044,10 @@ static Int jump_env(USES_REGS1) {
LOCAL_ActiveError->classAsText = NULL; LOCAL_ActiveError->classAsText = NULL;
} }
} else { } else {
// LOCAL_Error_TYPE = THROW_EVENT; Yap_find_prolog_culprit(PASS_REGS1);
LOCAL_ActiveError->errorAsText = NULL;
LOCAL_ActiveError->classAsText = NULL;
//return true;
} }
LOCAL_ActiveError->prologPredName = NULL; LOCAL_ActiveError->prologPredName = NULL;
Yap_PutException(t); Yap_PutException(t);
@ -2197,9 +2265,11 @@ void Yap_InitExecFs(void) {
#endif #endif
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag); Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag); Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, 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("$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("$ ", 1,
current_choice_point, 0);
CurrentModule = HACKS_MODULE; CurrentModule = HACKS_MODULE;
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);

View File

@ -318,6 +318,7 @@
AtomRecordedP = Yap_FullLookupAtom("$recordep"); TermRecordedP = MkAtomTerm(AtomRecordedP); AtomRecordedP = Yap_FullLookupAtom("$recordep"); TermRecordedP = MkAtomTerm(AtomRecordedP);
AtomRecordedWithKey = Yap_FullLookupAtom("$recorded_with_key"); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey); AtomRecordedWithKey = Yap_FullLookupAtom("$recorded_with_key"); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey);
AtomRedefineWarnings = Yap_LookupAtom("redefine_warnings"); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings); AtomRedefineWarnings = Yap_LookupAtom("redefine_warnings"); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings);
AtomRedo = Yap_FullLookupAtom("redo"); TermRedo = MkAtomTerm(AtomRedo);
AtomRedoFreeze = Yap_FullLookupAtom("$redo_freeze"); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze); AtomRedoFreeze = Yap_FullLookupAtom("$redo_freeze"); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze);
AtomRefoundVar = Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"); TermRefoundVar = MkAtomTerm(AtomRefoundVar); AtomRefoundVar = Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"); TermRefoundVar = MkAtomTerm(AtomRefoundVar);
AtomRelativeTo = Yap_FullLookupAtom("relative_to"); TermRelativeTo = MkAtomTerm(AtomRelativeTo); AtomRelativeTo = Yap_FullLookupAtom("relative_to"); TermRelativeTo = MkAtomTerm(AtomRelativeTo);

View File

@ -318,6 +318,7 @@
AtomRecordedP = AtomAdjust(AtomRecordedP); TermRecordedP = MkAtomTerm(AtomRecordedP); AtomRecordedP = AtomAdjust(AtomRecordedP); TermRecordedP = MkAtomTerm(AtomRecordedP);
AtomRecordedWithKey = AtomAdjust(AtomRecordedWithKey); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey); AtomRecordedWithKey = AtomAdjust(AtomRecordedWithKey); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey);
AtomRedefineWarnings = AtomAdjust(AtomRedefineWarnings); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings); AtomRedefineWarnings = AtomAdjust(AtomRedefineWarnings); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings);
AtomRedo = AtomAdjust(AtomRedo); TermRedo = MkAtomTerm(AtomRedo);
AtomRedoFreeze = AtomAdjust(AtomRedoFreeze); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze); AtomRedoFreeze = AtomAdjust(AtomRedoFreeze); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze);
AtomRefoundVar = AtomAdjust(AtomRefoundVar); TermRefoundVar = MkAtomTerm(AtomRefoundVar); AtomRefoundVar = AtomAdjust(AtomRefoundVar); TermRefoundVar = MkAtomTerm(AtomRefoundVar);
AtomRelativeTo = AtomAdjust(AtomRelativeTo); TermRelativeTo = MkAtomTerm(AtomRelativeTo); AtomRelativeTo = AtomAdjust(AtomRelativeTo); TermRelativeTo = MkAtomTerm(AtomRelativeTo);

View File

@ -318,6 +318,7 @@ X_API EXTERNAL Atom AtomReconsult; X_API EXTERNAL Term TermReconsult;
X_API EXTERNAL Atom AtomRecordedP; X_API EXTERNAL Term TermRecordedP; X_API EXTERNAL Atom AtomRecordedP; X_API EXTERNAL Term TermRecordedP;
X_API EXTERNAL Atom AtomRecordedWithKey; X_API EXTERNAL Term TermRecordedWithKey; X_API EXTERNAL Atom AtomRecordedWithKey; X_API EXTERNAL Term TermRecordedWithKey;
X_API EXTERNAL Atom AtomRedefineWarnings; X_API EXTERNAL Term TermRedefineWarnings; X_API EXTERNAL Atom AtomRedefineWarnings; X_API EXTERNAL Term TermRedefineWarnings;
X_API EXTERNAL Atom AtomRedo; X_API EXTERNAL Term TermRedo;
X_API EXTERNAL Atom AtomRedoFreeze; X_API EXTERNAL Term TermRedoFreeze; X_API EXTERNAL Atom AtomRedoFreeze; X_API EXTERNAL Term TermRedoFreeze;
X_API EXTERNAL Atom AtomRefoundVar; X_API EXTERNAL Term TermRefoundVar; X_API EXTERNAL Atom AtomRefoundVar; X_API EXTERNAL Term TermRefoundVar;
X_API EXTERNAL Atom AtomRelativeTo; X_API EXTERNAL Term TermRelativeTo; X_API EXTERNAL Atom AtomRelativeTo; X_API EXTERNAL Term TermRelativeTo;

View File

@ -1094,35 +1094,34 @@ incore(G) :- '$execute'(G).
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, M) :- '$user_call'(G, M) :-
'$gated_call'( gated_call(
('$$save_by'(CP), '$enable_debugging',
'$enable_debugging'), M:G,
'$call'(G, CP, M:G, M), Port,
Port, '$disable_debugging_on_port'(Port)
'$disable_debugging_on_port'(Port)
). ).
'$disable_debugging_on_port'(retry) :- '$disable_debugging_on_port'(retry) :-
!, !,
'$enable_debugging'. '$enable_debugging'.
'$disable_debugging_on_port'(_Port) :- '$disable_debugging_on_port'(_Port) :-
'$disable_debugging'. '$disable_debugging'.
% enable creeping % enable creeping
'$enable_debugging':- '$enable_debugging':-
current_prolog_flag(debug, false), !. current_prolog_flag(debug, false), !.
'$enable_debugging' :- '$enable_debugging' :-
'$trace_on', !, '$trace_on', !,
'$creep'. '$creep'.
'$enable_debugging'. '$enable_debugging'.
'$trace_on' :- '$trace_on' :-
'$nb_getval'('$trace', on, fail). '$nb_getval'('$trace', on, fail).
'$trace_off' :- '$trace_off' :-
'$nb_getval'('$trace', off, fail). '$nb_getval'('$trace', off, fail).
/** @pred :_P_ , :_Q_ is iso, meta /** @pred :_P_ , :_Q_ is iso, meta
@ -1300,7 +1299,7 @@ not(G) :- \+ '$execute'(G).
bootstrap(F) :- bootstrap(F) :-
% '$open'(F, '$csult', Stream, 0, 0, F), % '$open'(F, '$csult', Stream, 0, 0, F),
% '$file_name'(Stream,File), % '$file_name'(Stream,File),
yap_flag(verbose_load, Old, silent), yap_flag(verbose_load, Old, silent),
open(F, read, Stream), open(F, read, Stream),
stream_property(Stream, [file_name(File)]), stream_property(Stream, [file_name(File)]),
'$start_consult'(consult, File, LC), '$start_consult'(consult, File, LC),
@ -1434,14 +1433,14 @@ Command = (H --> B) ->
gated_call(Setup, Goal, Catcher, Cleanup) :- gated_call(Setup, Goal, Catcher, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup), '$setup_call_catcher_cleanup'(Setup),
'$gated_call'( true , Goal, Catcher, Cleanup) . '$gated_call'( true , Goal, Catcher, Cleanup) .
'$gated_call'( All , Goal, Catcher, Cleanup) :- '$gated_call'( All , Goal, Catcher, Cleanup) :-
Task0 = cleanup( All, Catcher, Cleanup, Tag, true, CP0), Task0 = cleanup( All, Catcher, Cleanup, Tag, true, CP0),
TaskF = cleanup( All, Catcher, Cleanup, Tag, false, CP0), TaskF = cleanup( All, Catcher, Cleanup, Tag, false, CP0),
'$tag_cleanup'(CP0, Task0), '$tag_cleanup'(CP0, Task0),
call( Goal ), '$execute'( Goal ),
'$cleanup_on_exit'(CP0, TaskF). '$cleanup_on_exit'(CP0, TaskF).

View File

@ -16,7 +16,7 @@
*************************************************************************/ *************************************************************************/
:- system_module( '$_debug', [], ['$do_spy'/4, :- system_module( '$_debug', [], ['$spycall'/4,
'$init_debugger'/0, '$init_debugger'/0,
'$skipeol'/1]). '$skipeol'/1]).
@ -269,43 +269,44 @@ be lost.
% %
% $spy may be called from user code, so be careful. % $spy may be called from user code, so be careful.
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
current_prolog_flag(debug, false), !, '$stop_creeping'(_),
'$execute_nonstop'(G,Mod). current_prolog_flag(debug, false),
!,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
'$stop_creeping'(_), CP is '$last_choice_pt',
CP is '$last_choice_pt', '$debugger_input',
'$debugger_input', '$spycall'(G, Mod, CP, not_expanded).
'$do_spy'(G, Mod, CP, spy).
'$spy'([Mod|G], A1) :- '$spy'([Mod|G], A1) :-
G =.. L, G =.. L,
lists:append( L, [A1], NL), lists:append( L, [A1], NL),
NG =.. NL, NG =.. NL,
'$spy'([Mod|NG]). '$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2) :- '$spy'([Mod|G], A1, A2) :-
G =.. L, G =.. L,
lists:append( L, [A1, A2], NL), lists:append( L, [A1, A2], NL),
NG =.. NL, NG =.. NL,
'$spy'([Mod|NG]). '$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3) :- '$spy'([Mod|G], A1, A2, A3) :-
G =.. L, G =.. L,
lists:append( L, [A1, A2, A3], NL), lists:append( L, [A1, A2, A3], NL),
NG =.. NL, NG =.. NL,
'$spy'([Mod|NG]). '$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4) :- '$spy'([Mod|G], A1, A2, A3, A4) :-
G =.. L, G =.. L,
lists:append( L, [A1,A2,A3,A4], NL), lists:append( L, [A1,A2,A3,A4], NL),
NG =.. NL, NG =.. NL,
'$spy'([Mod|NG]). '$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4, A5) :- '$spy'([Mod|G], A1, A2, A3, A4, A5) :-
G =.. L, G =.. L,
lists:append( L, [A1, A2, A3, A4, A5], NL), lists:append( L, [A1, A2, A3, A4, A5], NL),
NG =.. NL, NG =.. NL,
'$spy'([Mod|NG]). '$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4, A5, A6) :- '$spy'([Mod|G], A1, A2, A3, A4, A5, A6) :-
G =.. L, G =.. L,
@ -343,134 +344,167 @@ be lost.
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
'$do_spy'(G, M, CP, spy ). '$spycall'(G, M, CP, not_expanded ).
% last argument to do_spy says that we are at the end of a context. It %% @pred '$spycall'( +G, +M, +CP, Expanded)
% is required to know whether we are controlled by the debugger. %
%'$do_spy'(V, M, CP, Flag) :- %% debug a complex query
% writeln('$do_spy'(V, M, CP, Flag)), fail. '$spycall'(V, M, CP, _) :-
'$do_spy'(V, M, CP, Flag) :-
'$stop_creeping'(_),
var(V), !, var(V), !,
'$do_spy'(call(V), M, CP, Flag). '$spycall'(call(V), M, CP, _).
'$do_spy'(!, _, CP, _) :- '$spycall'(!, _, CP, _) :-
!, '$$cut_by'(CP). !, '$$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- '$spycall'('$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M). !, '$$cut_by'(M).
'$do_spy'('$$cut_by'(M), _, _, _) :- '$spycall'('$$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M). !, '$$cut_by'(M).
'$do_spy'(true, _, _, _) :- !. '$spycall'(true, _, _, _) :- !.
%'$do_spy'(fail, _, _, _) :- !, fail. %'$spycall'(fail, _, _, _) :- !, fail.
'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !, '$spycall'(M:G, _, CP, Expanded) :-
'$do_spy'(G, M, CP, CalledFromDebugger). !,
'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !, '$yap_strip_module'(M:G, G0, M0),
'$do_spy'(A, M, CP, debugger), '$spycall'(G0, M0, CP, Expanded ).
'$do_spy'(B, M, CP, CalledFromDebugger). '$spycall'((A,B), M, CP, Expanded) :- !,
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !, '$spycall'(A, M, CP, Expanded),
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) '$spycall'(B, M, CP, Expanded).
'$spycall'((T->A;B), M, CP, Expanded) :- !,
( '$spycall'(T, M, CP, Expanded) -> '$spycall'(A, M, CP, Expanded)
; ;
'$do_spy'(B, M, CP, CalledFromDebugger) '$spycall'(B, M, CP, Expanded)
). ).
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !, '$spycall'((T->A|B), M, CP, Expanded) :- !,
( (
'$do_spy'(T, M, CP, debugger) '$spycall'(T, M, CP, Expanded)
-> ->
'$do_spy'(A, M, CP, CalledFromDebugger) '$spycall'(A, M, CP, Expanded)
; ;
'stop_creeping'(_), '$spycall'(B, M, CP, Expanded)
'$do_spy'(B, M, CP, CalledFromDebugger)
). ).
'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !, '$spycall'((T->A), M, CP, Expanded) :- !,
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ). ( '$spycall'(T, M, CP, Expanded) -> '$spycall'(A, M, CP, Expanded) ).
'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !, '$spycall'((A;B), M, CP, Expanded) :- !,
( (
'$do_spy'(A, M, CP, CalledFromDebugger) '$spycall'(A, M, CP, Expanded)
; ;
'$stop_creeping'(_), '$spycall'(B, M, CP, Expanded)
'$do_spy'(B, M, CP, CalledFromDebugger)
). ).
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !, '$spycall'((A|B), M, CP, Expanded) :- !,
( (
'$do_spy'(A, M, CP, CalledFromDebugger ) '$spycall'(A, M, CP, Expanded )
; ;
'$stop_creeping'(_) , '$spycall'(B, M, CP, Expanded )
'$do_spy'(B, M, CP, CalledFromDebugger )
). ).
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !, '$spycall'((\+G), M, CP, Expanded) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger). \+ '$spycall'(G, M, CP, Expanded).
'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !, '$spycall'((not(G)), M, CP, Expanded) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger). \+ '$spycall'(G, M, CP, Expanded).
'$do_spy'(once(G), M, CP, CalledFromDebugger) :- !, '$spycall'(once(G), M, CP, Expanded) :- !,
once( '$do_spy'(G, M, CP, CalledFromDebugger) ). once( '$spycall'(G, M, CP, Expanded) ).
'$do_spy'(ignore(G), M, CP, CalledFromDebugger) :- !, '$spycall'(ignore(G), M, CP, Expanded) :- !,
ignore( '$do_spy'(G, M, CP, CalledFromDebugger) ). ignore( '$spycall'(G, M, CP, Expanded) ).
'$do_spy'(G, Module, _, CalledFromDebugger) :- '$spycall'(G, M, CP, not_expanded) :-
'$loop_spy'(G, Module, CalledFromDebugger). '$is_metapredicate'(G, M),
!,
'$expand_meta_call'(M:G, [], G1),
'$spycall'(G1, M, CP, expanded).
'$spycall'(G, M, CP, _) :-
'$undefined'(G, M), !,
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
'$spycall'(Goal, NM, CP, expanded).
'$spycall'(G, M, CP, _) :-
/* get goal no. */
'__NB_getval__'('$spy_gn',L,fail),
/* bump it */
L1 is L+1,
/* and save it globaly */
'__NB_setval__'('$spy_gn',L1),
% spy a literal
catch(
'$spygoal'(G, M, L, H),
E,
'$re_spycall'(E, G, M, L, H)
).
% we are skipping, so we can just call the goal, '$spygoal'(G, M, GoalNumber, H) :-
% while leaving the minimal structure in place. '$is_source'( G, M ), % use the interpreter
'$loop_spy'(G, Module, CalledFromDebugger) :- !,
catch( gated_call(
gated_call( '$enter_spy'(GoalNumber, G, M, true, H),
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H), '$spy_go'(G, M),
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger), Port,
Port, '$spy_port'(Port, GoalNumber, G, M, true, H)
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)), ).
E, '$spygoal'(G, M, _, GoalNumber, H) :-
'$redo_spy'( E, G, Module, CalledFromDebugger, GoalNumber, H) gated_call(
). '$enter_spy'(GoalNumber, G, M, true, H),
'$creep_step'(G,M),
Port,
'$spy_port'(Port, GoalNumber, G, M, true, H)
).
%%% fail just fails.
'$redo_spy'(abort, _G, _Module, _CalledFromDebugger, _GoalNumber, _H) :- '$spy_go'(G, M) :-
CP is '$last_choice_pt',
clause(M:G, Cl, _),
'$spycall'(Cl, M, CP, expanded).
%% @pred '$re_spycall'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
% - redo resets the goal
% - fail gives up on the goal.
'$re_spycall'(abort, _G, _Module, _GoalNumber, _H) :-
!, !,
abort. abort.
'$redo_spy'('$forward'('$wrapper'(E),G0), _G, _Module, _CalledFromDebugger, _ '$redo_spy'('$forward'('$fail_spy',G0), __G, __Module, __CalledFromDebugger, GoalNumber, _H) :- '$re_spycall'(forward(fail,G0), _G, __Module, GoalNumber, _H) :-
GoalNumber =< G0, GoalNumber =< G0,
!, !,
fail. fail.
'$redo_spy'('$forward'('$retry_spy',G0), G, Module, CalledFromDebugger, GoalNumber, H) :- '$re_spycall'(forward(redo,G0), G, M, GoalNumber, H) :-
GoalNumber =< G0, GoalNumber =< G0,
!, !,
catch( catch(
gated_call( '$spygoal'(G, M, GoalNumber, H),
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H), E,
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger), '$re_spycall'(E, G,M, GoalNumber, H)
Port, ).
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)), '$re_spycall'(forward(C,G0), _G, _Module, _GoalNumber, _H) :-
E, throw(forward(C,G0)).
throw(E)
).
'$redo_spy'('$forward'(C,G0), G, _Module, _CalledFromDebugger, _GoalNumber, _H) :-
throw(C,G0).
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H) :- '$enter_spy'(L, G, Module, _CalledFromDebugger, Info) :-
'__NB_getval__'('$spy_gn',L,fail), /* get goal no. */ /* get goal list */
L1 is L+1, /* bump it */ '__NB_getval__'('$spy_glist',History,true),
'__NB_setval__'('$spy_gn',L1), /* and save it globaly */ H = [Info|History],
'__NB_getval__'('$spy_glist',History,true), /* get goal list */ Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers),
H = [info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History], '__B_setval__'('$spy_glist',H),
'__B_setval__'('$spy_glist',H). /* and update it */
/* and update it */ % %'$spy_port_'(call, L, G, Module, CalledFromDebugger, Info).
'$enter_goal'(L, G, Module).
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :-
'$stop_creeping'(_) , '$stop_creeping'(_) ,
'$spy_port_'(Port, GoalNumber, G, Module, CalledFromDebugger, Info). '$spy_port_'(Port, GoalNumber, G, Module, CalledFromDebugger, Info).
'$spy_port_'(call, GoalNumber, G, Module, _CalledFromDebugger, _Info) :-
'$show_trace'(call,G,Module,GoalNumber,deterministic).
'$spy_port_'(exit, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$spy_port_'(exit, GoalNumber, G, Module, CalledFromDebugger, Info) :-
nb_setarg(6, Info, true), nb_setarg(6, Info, true),
'$show_trace'(exit,G,Module,GoalNumber,true), '$show_trace'(exit,G,Module,GoalNumber,deterministic),
'$continue_debugging'(exit, CalledFromDebugger). '$continue_debugging'(exit, CalledFromDebugger).
'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(exit,G,Module,GoalNumber,false), '$show_trace'(exit,G,Module,GoalNumber,nondeterministic),
'$continue_debugging'(exit, CalledFromDebugger). '$continue_debugging'(exit, CalledFromDebugger).
'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ '$show_trace'(redo,G,Module,GoalNumber,nondeterministic), /* inform user_error v */
'$continue_debugging'(fail, CalledFromDebugger). '$continue_debugging'(fail, CalledFromDebugger).
'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform user_error */ '$show_trace'(fail,G,Module,GoalNumber,deterministic), /* inform user_error */
'$continue_debugging'(fail, CalledFromDebugger). '$continue_debugging'(fail, CalledFromDebugger).
'$spy_port_'(! ,G,Module,GoalNumber,_) :- /* inform user_error */ '$spy_port_'(! ,_GoalNumber,_G,_Module,_,deterministic) :- /* inform user_error */
!. !.
'$spy_port_'(exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :- '$spy_port_'(exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger). '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger).
@ -480,13 +514,13 @@ be lost.
%%% - retry: forward throw while the call is newer than goal %%% - retry: forward throw while the call is newer than goal
'$TraceError'( abort, _, _, _, _). '$TraceError'( abort, _, _, _, _).
'$TraceError'('$forward'('$retry_spy'(_G0)), _, _, _, _). '$TraceError'(forward(redo,_G0), _, _, _, _).
%%% - backtrack long distance %%% - backtrack long distance
'$TraceError'('$forward'('$fail_spy'(_G0)),GoalNumber, _, _, _) :- !, '$TraceError'(forward(fail,_G0),GoalNumber, _, _, _) :- !,
throw(error('$fail_spy'(GoalNumber))). throw(error(fail(GoalNumber))).
%%% %%%
%%% - forward through the debugger %%% - forward through the debugger
'$TraceError'('$forward'('$wrapper'(Event)), _, _, _, _) :- '$TraceError'(forward('$wrapper',Event), _, _, _, _) :-
!, !,
throw(Event). throw(Event).
%%% - anything else, leave to the user and restore the catch %%% - anything else, leave to the user and restore the catch
@ -515,7 +549,7 @@ be lost.
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
'$zip'(GoalNumber, G, Module), !. '$zip'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
'$trace'(call, G, Module, GoalNumber, _). '$trace'(call, G, Module, GoalNumber, deterministic).
'$show_trace'(_, G, Module, GoalNumber,_) :- '$show_trace'(_, G, Module, GoalNumber,_) :-
'$zip'(GoalNumber, G, Module), !. '$zip'(GoalNumber, G, Module), !.
@ -545,122 +579,6 @@ be lost.
). ).
%
'$spycall'(G, M, _, _) :-
current_prolog_flag( debug, false),
!,
'$execute_nonstop'(G,M).
'$spycall'(G, M, _, _) :-
'__NB_getval__'('$debug_jump',true, fail),
!,
( '$is_metapredicate'(G, M)
->
'$expand_meta_call'(M:G, [], G1)
;
G = G1
),
'$execute_nonstop'(G1,M).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$is_metapredicate'(G, M),
'$debugger_expand_meta_call'(M:G, [], G10),
G10 \== M:G,
!,
'$debugger_input',
G10 = NM:NG,
'$spycall_f'(NG, NM, CalledFromDebugger, InRedo).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_f'(G, M, CalledFromDebugger, InRedo).
'$spycall_f'(G, M, _, _) :-
( '$is_opaque_predicate'(G,M) ; '$tabled_predicate'(G,M) ),
!,
'$continue_debugging_goal'(yes, '$execute_nonstop'(G,M)).
'$spycall_f'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :-
'$undefined'(G, M), !,
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
'$spycall'(Goal, NM, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
CP is '$last_choice_pt',
(
'$is_source'( G, M ) % use the interpreter
->
(
'$clause'(G, M, Cl, _)
*->
% I may backtrack to here from far away
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true )
)
;
(
'$static_clause'(G,M,_,R)
*->
'$stop_creeping'(_),
(
'$creep'('$execute_clause'(G, M, R, CP), M)
;
InRedo = true
)
)
;
( '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M) ) ; InRedo = true )
).
% I may backtrack to here from far away
%
%
'$creep'('$execute_clause'(G,Mod,Ref,CP),_M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute_clause'(G,Mod,Ref,CP),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'(_)
;
'$stop_creeping'(_) ,
fail
).
'$creep'(G,M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'(_)
;
fail
).
/**
* call predicate M:G within the ddebugger
*
*
* @return
*/
'$trace'(G,M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute0'( G, M ),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
;
fail
).
'$tabled_predicate'(G,M) :-
'$predicate_flags'(G,M,F,F),
F /\ 0x00000040 =\= 0.
%'$trace'(P,G,Module,L,Deterministic) :-
% '__NB_getval__'('$system_mode',On,fail), writeln(On), fail.
'$trace'(P,G,Module,L,Deterministic) :- '$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip % at this point we are done with leap or skip
'__NB_setval__'('$debug_run',off), '__NB_setval__'('$debug_run',off),
@ -675,7 +593,9 @@ be lost.
'$action'(10,P,L,G,Module,Debug), '$action'(10,P,L,G,Module,Debug),
put_code(user_error, 10) put_code(user_error, 10)
; ;
write(user_error,' ? '), get_code(debugger_input,C), write(user_error,' ? '),
'$clear_input'(debugger_input),
get_code(debugger_input,C),
'$action'(C,P,L,G,Module,Debug) '$action'(C,P,L,G,Module,Debug)
), ),
/* (Debug = on /* (Debug = on
@ -694,7 +614,7 @@ be lost.
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
functor(P,P0,_), functor(P,P0,_),
(P = exit, Deterministic \= true -> Det = '?' ; Det = ' '), (P = exit, Deterministic \= deterministic -> Det = '?' ; Det = ' '),
('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '), ('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
% vsc: fix this % vsc: fix this
% ( SL = L -> SLL = '>' ; SLL = ' '), % ( SL = L -> SLL = '>' ; SLL = ' '),
@ -714,7 +634,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'0001 =:= 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 ), !,
@ -775,7 +695,7 @@ be lost.
halt. halt.
'$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail '$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail
'$scan_number'(0'f, CallId, GoalId), %'f '$scan_number'(0'f, CallId, GoalId), %'f
throw('$forward'('$fail_spy'(GoalId))). throw(forward(fail,GoalId)).
'$action'(0'h,_,_,_,_,_) :- !, % 'h help '$action'(0'h,_,_,_,_,_) :- !, % 'h help
'$action_help', '$action_help',
'$skipeol'(104), '$skipeol'(104),
@ -822,14 +742,10 @@ be lost.
'__NB_setval__'('$debug_run', -1), '__NB_setval__'('$debug_run', -1),
'__NB_setval__'('$debug_jump',true), '__NB_setval__'('$debug_jump',true),
nodebug. nodebug.
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
'$scan_number'(0'r,CallId,ScanNumber), % '
% set_prolog_flag(debug, true),
throw('$forward'('$retry_spy'(ScanNumber))).
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry '$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
'$scan_number'(0'r,CallId,ScanNumber), % ' '$scan_number'(0'r,CallId,ScanNumber), % '
% set_prolog_flag(debug, true), % set_prolog_flag(debug, true),
throw('$forward'('$wrapper'(ScanNumber))). throw(forward(redo,ScanNumber)).
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip '$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
'$skipeol'(0's), % ' '$skipeol'(0's), % '
( (
@ -861,7 +777,7 @@ be lost.
'$show_ancestors'(HowMany), '$show_ancestors'(HowMany),
fail. fail.
'$action'(0'T,exception(G),_,_,_,_) :- !, % 'T throw '$action'(0'T,exception(G),_,_,_,_) :- !, % 'T throw
throw( '$forward'('$wrapper'(G))). throw( forward('$wrapper',G)).
'$action'(C,_,_,_,_,_) :- '$action'(C,_,_,_,_,_) :-
'$skipeol'(C), '$skipeol'(C),
'$ilgl'(C), '$ilgl'(C),
@ -900,18 +816,6 @@ be lost.
'$continue_debugging_goal'(_,G) :- '$continue_debugging_goal'(_,G) :-
'$execute_creep_dgoal'(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)) :-
'$creep',
'$execute_nonstop'(G,M).
'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$creep',
'$execute_clause'(G, M, R, CP).
'$show_ancestors'(HowMany) :- '$show_ancestors'(HowMany) :-
'__NB_getval__'('$spy_glist',[_|History], fail), '__NB_getval__'('$spy_glist',[_|History], fail),
( (
@ -1046,14 +950,11 @@ be lost.
'$delete_if_there'([Q|L], T, TN, [Q|LN]) :- '$delete_if_there'([Q|L], T, TN, [Q|LN]) :-
'$delete_if_there'(L, T, TN, LN). '$delete_if_there'(L, T, TN, LN).
'$debugger_deterministic_goal'(G) :- '$debugger_deterministic_goal'(exit).
yap_hacks:current_choicepoints(CPs0), '$debugger_deterministic_goal'(fail).
% $cps(CPs0), '$debugger_deterministic_goal'(!).
'$debugger_skip_traces'(CPs0,CPs1), '$debugger_deterministic_goal'(exception(_)).
'$debugger_skip_loop_spy2'(CPs1,CPs2), '$debugger_deterministic_goal'(external_exception(_)).
'$debugger_skip_spycall'(CPs2,CPs3),
'$debugger_skip_loop_spy2'(CPs3,[Catch|_]),
yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$TraceError'(_,_,G,_,_),_),_).
'$cps'([CP|CPs]) :- '$cps'([CP|CPs]) :-