diff --git a/C/exec.c b/C/exec.c index 4bc84231d..69c4bc987 100755 --- a/C/exec.c +++ b/C/exec.c @@ -886,7 +886,7 @@ static bool watch_retry(Term d0 USES_REGS) { complete_pt[0] = t; } else if (box) { - t = TermRetry; + t = TermRedo; } else { return true; } @@ -952,7 +952,6 @@ static Int cleanup_on_exit(USES_REGS1) { Term task = Deref(ARG2); bool box = ArgOfTerm(1, task) == TermTrue; Term cleanup = ArgOfTerm(3, task); - Term catcher = ArgOfTerm(2, task); Term complete = IsNonVarTerm(ArgOfTerm(4, task)); while (B->cp_ap->opc == FAIL_OPCODE) @@ -1152,6 +1151,83 @@ restart_exec: 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) */ Term t = Deref(ARG1); @@ -1361,8 +1437,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { } LOCAL_PrologMode &= ~AbortMode; P = (yamop *)FAILCODE; - if (LOCAL_CBorder) - LOCAL_CBorder = OldBorder; LOCAL_RestartEnv = sighold; return false; break; @@ -1927,23 +2001,14 @@ static Int JumpToEnv() { so get pointers here */ /* find the first choicepoint that may be a catch */ // DBTerm *dbt = Yap_RefToException(); - while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) { - // printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder); - if (handler == (choiceptr)(LCL0 - LOCAL_CBorder)) { - 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; - } + while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch && + LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE && + handler->cp_b != NULL) { handler = handler->cp_b; } if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } - POP_FAIL(handler); B = handler; P = FAILCODE; return true; @@ -1979,7 +2044,10 @@ static Int jump_env(USES_REGS1) { LOCAL_ActiveError->classAsText = NULL; } } 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; Yap_PutException(t); @@ -2197,9 +2265,11 @@ void Yap_InitExecFs(void) { #endif Yap_InitCPred("$execute0", 2, execute0, 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("$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; Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index 9670d50fb..098f04e86 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -318,6 +318,7 @@ AtomRecordedP = Yap_FullLookupAtom("$recordep"); TermRecordedP = MkAtomTerm(AtomRecordedP); AtomRecordedWithKey = Yap_FullLookupAtom("$recorded_with_key"); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey); AtomRedefineWarnings = Yap_LookupAtom("redefine_warnings"); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings); + AtomRedo = Yap_FullLookupAtom("redo"); TermRedo = MkAtomTerm(AtomRedo); AtomRedoFreeze = Yap_FullLookupAtom("$redo_freeze"); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze); AtomRefoundVar = Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"); TermRefoundVar = MkAtomTerm(AtomRefoundVar); AtomRelativeTo = Yap_FullLookupAtom("relative_to"); TermRelativeTo = MkAtomTerm(AtomRelativeTo); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index e56f4db60..126173d80 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -318,6 +318,7 @@ AtomRecordedP = AtomAdjust(AtomRecordedP); TermRecordedP = MkAtomTerm(AtomRecordedP); AtomRecordedWithKey = AtomAdjust(AtomRecordedWithKey); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey); AtomRedefineWarnings = AtomAdjust(AtomRedefineWarnings); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings); + AtomRedo = AtomAdjust(AtomRedo); TermRedo = MkAtomTerm(AtomRedo); AtomRedoFreeze = AtomAdjust(AtomRedoFreeze); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze); AtomRefoundVar = AtomAdjust(AtomRefoundVar); TermRefoundVar = MkAtomTerm(AtomRefoundVar); AtomRelativeTo = AtomAdjust(AtomRelativeTo); TermRelativeTo = MkAtomTerm(AtomRelativeTo); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index 927e15328..4fc531c69 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -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 AtomRecordedWithKey; X_API EXTERNAL Term TermRecordedWithKey; 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 AtomRefoundVar; X_API EXTERNAL Term TermRefoundVar; X_API EXTERNAL Atom AtomRelativeTo; X_API EXTERNAL Term TermRelativeTo; diff --git a/pl/boot.yap b/pl/boot.yap index 4246f7572..ea1b23993 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1094,35 +1094,34 @@ incore(G) :- '$execute'(G). '$call'(G, CP, G, M). '$user_call'(G, M) :- - '$gated_call'( - ('$$save_by'(CP), - '$enable_debugging'), - '$call'(G, CP, M:G, M), - Port, - '$disable_debugging_on_port'(Port) + gated_call( + '$enable_debugging', + M:G, + Port, + '$disable_debugging_on_port'(Port) ). '$disable_debugging_on_port'(retry) :- !, '$enable_debugging'. '$disable_debugging_on_port'(_Port) :- - '$disable_debugging'. + '$disable_debugging'. % enable creeping '$enable_debugging':- - current_prolog_flag(debug, false), !. + current_prolog_flag(debug, false), !. '$enable_debugging' :- - '$trace_on', !, - '$creep'. + '$trace_on', !, + '$creep'. '$enable_debugging'. '$trace_on' :- - '$nb_getval'('$trace', on, fail). + '$nb_getval'('$trace', on, fail). '$trace_off' :- - '$nb_getval'('$trace', off, fail). + '$nb_getval'('$trace', off, fail). /** @pred :_P_ , :_Q_ is iso, meta @@ -1300,7 +1299,7 @@ not(G) :- \+ '$execute'(G). bootstrap(F) :- % '$open'(F, '$csult', Stream, 0, 0, F), % '$file_name'(Stream,File), - yap_flag(verbose_load, Old, silent), + yap_flag(verbose_load, Old, silent), open(F, read, Stream), stream_property(Stream, [file_name(File)]), '$start_consult'(consult, File, LC), @@ -1434,14 +1433,14 @@ Command = (H --> B) -> gated_call(Setup, Goal, Catcher, Cleanup) :- -'$setup_call_catcher_cleanup'(Setup), -'$gated_call'( true , Goal, Catcher, Cleanup) . + '$setup_call_catcher_cleanup'(Setup), + '$gated_call'( true , 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), '$tag_cleanup'(CP0, Task0), - call( Goal ), + '$execute'( Goal ), '$cleanup_on_exit'(CP0, TaskF). diff --git a/pl/debug.yap b/pl/debug.yap index 544b70c96..187fa8916 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$do_spy'/4, +:- system_module( '$_debug', [], ['$spycall'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -269,43 +269,44 @@ be lost. % % $spy may be called from user code, so be careful. '$spy'([Mod|G]) :- - current_prolog_flag(debug, false), !, - '$execute_nonstop'(G,Mod). + '$stop_creeping'(_), + current_prolog_flag(debug, false), + !, + '$execute_nonstop'(G,Mod). '$spy'([Mod|G]) :- - '$stop_creeping'(_), - CP is '$last_choice_pt', - '$debugger_input', - '$do_spy'(G, Mod, CP, spy). + CP is '$last_choice_pt', + '$debugger_input', + '$spycall'(G, Mod, CP, not_expanded). '$spy'([Mod|G], A1) :- - G =.. L, - lists:append( L, [A1], NL), - NG =.. NL, - '$spy'([Mod|NG]). + G =.. L, + lists:append( L, [A1], NL), + NG =.. NL, + '$spy'([Mod|NG]). '$spy'([Mod|G], A1, A2) :- - G =.. L, - lists:append( L, [A1, A2], NL), - NG =.. NL, - '$spy'([Mod|NG]). + G =.. L, + lists:append( L, [A1, A2], NL), + NG =.. NL, + '$spy'([Mod|NG]). '$spy'([Mod|G], A1, A2, A3) :- - G =.. L, - lists:append( L, [A1, A2, A3], NL), - NG =.. NL, - '$spy'([Mod|NG]). + G =.. L, + lists:append( L, [A1, A2, A3], NL), + NG =.. NL, + '$spy'([Mod|NG]). '$spy'([Mod|G], A1, A2, A3, A4) :- - G =.. L, - lists:append( L, [A1,A2,A3,A4], NL), - NG =.. NL, - '$spy'([Mod|NG]). + G =.. L, + lists:append( L, [A1,A2,A3,A4], NL), + NG =.. NL, + '$spy'([Mod|NG]). '$spy'([Mod|G], A1, A2, A3, A4, A5) :- - G =.. L, - lists:append( L, [A1, A2, A3, A4, A5], NL), - NG =.. NL, - '$spy'([Mod|NG]). + G =.. L, + lists:append( L, [A1, A2, A3, A4, A5], NL), + NG =.. NL, + '$spy'([Mod|NG]). '$spy'([Mod|G], A1, A2, A3, A4, A5, A6) :- G =.. L, @@ -343,134 +344,167 @@ be lost. '$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 -% is required to know whether we are controlled by the debugger. -%'$do_spy'(V, M, CP, Flag) :- -% writeln('$do_spy'(V, M, CP, Flag)), fail. -'$do_spy'(V, M, CP, Flag) :- - '$stop_creeping'(_), +%% @pred '$spycall'( +G, +M, +CP, Expanded) +% +%% debug a complex query +'$spycall'(V, M, CP, _) :- var(V), !, - '$do_spy'(call(V), M, CP, Flag). -'$do_spy'(!, _, CP, _) :- + '$spycall'(call(V), M, CP, _). +'$spycall'(!, _, CP, _) :- !, '$$cut_by'(CP). -'$do_spy'('$cut_by'(M), _, _, _) :- +'$spycall'('$cut_by'(M), _, _, _) :- !, '$$cut_by'(M). -'$do_spy'('$$cut_by'(M), _, _, _) :- +'$spycall'('$$cut_by'(M), _, _, _) :- !, '$$cut_by'(M). -'$do_spy'(true, _, _, _) :- !. -%'$do_spy'(fail, _, _, _) :- !, fail. -'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !, - '$do_spy'(G, M, CP, CalledFromDebugger). -'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !, - '$do_spy'(A, M, CP, debugger), - '$do_spy'(B, M, CP, CalledFromDebugger). -'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !, - ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) +'$spycall'(true, _, _, _) :- !. +%'$spycall'(fail, _, _, _) :- !, fail. +'$spycall'(M:G, _, CP, Expanded) :- + !, + '$yap_strip_module'(M:G, G0, M0), + '$spycall'(G0, M0, CP, Expanded ). +'$spycall'((A,B), M, CP, Expanded) :- !, + '$spycall'(A, M, CP, Expanded), + '$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'(_), - '$do_spy'(B, M, CP, CalledFromDebugger) + '$spycall'(B, M, CP, Expanded) ). -'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !, - ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ). -'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !, +'$spycall'((T->A), M, CP, Expanded) :- !, + ( '$spycall'(T, M, CP, Expanded) -> '$spycall'(A, M, CP, Expanded) ). +'$spycall'((A;B), M, CP, Expanded) :- !, ( - '$do_spy'(A, M, CP, CalledFromDebugger) + '$spycall'(A, M, CP, Expanded) ; - '$stop_creeping'(_), - '$do_spy'(B, M, CP, CalledFromDebugger) + '$spycall'(B, 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'(_) , - '$do_spy'(B, M, CP, CalledFromDebugger ) + '$spycall'(B, M, CP, Expanded ) ). -'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !, - \+ '$do_spy'(G, M, CP, CalledFromDebugger). -'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !, - \+ '$do_spy'(G, M, CP, CalledFromDebugger). -'$do_spy'(once(G), M, CP, CalledFromDebugger) :- !, - once( '$do_spy'(G, M, CP, CalledFromDebugger) ). -'$do_spy'(ignore(G), M, CP, CalledFromDebugger) :- !, - ignore( '$do_spy'(G, M, CP, CalledFromDebugger) ). -'$do_spy'(G, Module, _, CalledFromDebugger) :- - '$loop_spy'(G, Module, CalledFromDebugger). +'$spycall'((\+G), M, CP, Expanded) :- !, + \+ '$spycall'(G, M, CP, Expanded). +'$spycall'((not(G)), M, CP, Expanded) :- !, + \+ '$spycall'(G, M, CP, Expanded). +'$spycall'(once(G), M, CP, Expanded) :- !, + once( '$spycall'(G, M, CP, Expanded) ). +'$spycall'(ignore(G), M, CP, Expanded) :- !, + ignore( '$spycall'(G, M, CP, Expanded) ). +'$spycall'(G, M, CP, not_expanded) :- + '$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, -% while leaving the minimal structure in place. -'$loop_spy'(G, Module, CalledFromDebugger) :- - catch( - gated_call( - '$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H), - '$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger), - Port, - '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)), - E, - '$redo_spy'( E, G, Module, CalledFromDebugger, GoalNumber, H) - ). +'$spygoal'(G, M, GoalNumber, H) :- + '$is_source'( G, M ), % use the interpreter + !, + gated_call( + '$enter_spy'(GoalNumber, G, M, true, H), + '$spy_go'(G, M), + Port, + '$spy_port'(Port, GoalNumber, G, M, true, H) + ). +'$spygoal'(G, M, _, 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. -'$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, !, fail. -'$redo_spy'('$forward'('$retry_spy',G0), G, Module, CalledFromDebugger, GoalNumber, H) :- +'$re_spycall'(forward(redo,G0), G, M, GoalNumber, H) :- GoalNumber =< G0, !, catch( - gated_call( - '$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H), - '$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger), - Port, - '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)), - E, - throw(E) - ). -'$redo_spy'('$forward'(C,G0), G, _Module, _CalledFromDebugger, _GoalNumber, _H) :- - throw(C,G0). + '$spygoal'(G, M, GoalNumber, H), + E, + '$re_spycall'(E, G,M, GoalNumber, H) + ). +'$re_spycall'(forward(C,G0), _G, _Module, _GoalNumber, _H) :- + throw(forward(C,G0)). -'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H) :- - '__NB_getval__'('$spy_gn',L,fail), /* get goal no. */ - L1 is L+1, /* bump it */ - '__NB_setval__'('$spy_gn',L1), /* and save it globaly */ - '__NB_getval__'('$spy_glist',History,true), /* get goal list */ - H = [info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History], - '__B_setval__'('$spy_glist',H). - /* and update it */ +'$enter_spy'(L, G, Module, _CalledFromDebugger, Info) :- + /* get goal list */ + '__NB_getval__'('$spy_glist',History,true), + H = [Info|History], + Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers), + '__B_setval__'('$spy_glist',H), + /* and update it */ + % %'$spy_port_'(call, L, G, Module, CalledFromDebugger, Info). + '$enter_goal'(L, G, Module). '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :- '$stop_creeping'(_) , '$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) :- nb_setarg(6, Info, true), - '$show_trace'(exit,G,Module,GoalNumber,true), + '$show_trace'(exit,G,Module,GoalNumber,deterministic), '$continue_debugging'(exit, CalledFromDebugger). -'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, Info) :- - '$show_trace'(exit,G,Module,GoalNumber,false), +'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, _Info) :- + '$show_trace'(exit,G,Module,GoalNumber,nondeterministic), '$continue_debugging'(exit, CalledFromDebugger). -'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, Info) :- - '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ +'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, _Info) :- + '$show_trace'(redo,G,Module,GoalNumber,nondeterministic), /* inform user_error v */ '$continue_debugging'(fail, CalledFromDebugger). -'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, Info) :- - '$show_trace'(fail,G,Module,GoalNumber,_), /* inform user_error */ +'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, _Info) :- + '$show_trace'(fail,G,Module,GoalNumber,deterministic), /* inform user_error */ '$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) :- '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger). @@ -480,13 +514,13 @@ be lost. %%% - retry: forward throw while the call is newer than goal '$TraceError'( abort, _, _, _, _). -'$TraceError'('$forward'('$retry_spy'(_G0)), _, _, _, _). +'$TraceError'(forward(redo,_G0), _, _, _, _). %%% - backtrack long distance -'$TraceError'('$forward'('$fail_spy'(_G0)),GoalNumber, _, _, _) :- !, - throw(error('$fail_spy'(GoalNumber))). +'$TraceError'(forward(fail,_G0),GoalNumber, _, _, _) :- !, + throw(error(fail(GoalNumber))). %%% %%% - forward through the debugger -'$TraceError'('$forward'('$wrapper'(Event)), _, _, _, _) :- +'$TraceError'(forward('$wrapper',Event), _, _, _, _) :- !, throw(Event). %%% - anything else, leave to the user and restore the catch @@ -515,7 +549,7 @@ be lost. '$enter_goal'(GoalNumber, G, Module) :- '$zip'(GoalNumber, G, Module), !. '$enter_goal'(GoalNumber, G, Module) :- - '$trace'(call, G, Module, GoalNumber, _). + '$trace'(call, G, Module, GoalNumber, deterministic). '$show_trace'(_, G, Module, GoalNumber,_) :- '$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) :- % at this point we are done with leap or skip '__NB_setval__'('$debug_run',off), @@ -675,7 +593,9 @@ be lost. '$action'(10,P,L,G,Module,Debug), 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) ), /* (Debug = on @@ -694,7 +614,7 @@ be lost. flush_output(user_output), flush_output(user_error), functor(P,P0,_), - (P = exit, Deterministic \= true -> Det = '?' ; Det = ' '), + (P = exit, Deterministic \= deterministic -> Det = '?' ; Det = ' '), ('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '), % vsc: fix this % ( SL = L -> SLL = '>' ; SLL = ' '), @@ -714,7 +634,7 @@ be lost. '$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %' '$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %' % 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) :- current_prolog_flag( debugger_print_options, OUT ), !, @@ -775,7 +695,7 @@ be lost. halt. '$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail '$scan_number'(0'f, CallId, GoalId), %'f - throw('$forward'('$fail_spy'(GoalId))). + throw(forward(fail,GoalId)). '$action'(0'h,_,_,_,_,_) :- !, % 'h help '$action_help', '$skipeol'(104), @@ -822,14 +742,10 @@ be lost. '__NB_setval__'('$debug_run', -1), '__NB_setval__'('$debug_jump',true), 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 '$scan_number'(0'r,CallId,ScanNumber), % ' % set_prolog_flag(debug, true), - throw('$forward'('$wrapper'(ScanNumber))). + throw(forward(redo,ScanNumber)). '$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip '$skipeol'(0's), % ' ( @@ -861,7 +777,7 @@ be lost. '$show_ancestors'(HowMany), fail. '$action'(0'T,exception(G),_,_,_,_) :- !, % 'T throw - throw( '$forward'('$wrapper'(G))). + throw( forward('$wrapper',G)). '$action'(C,_,_,_,_,_) :- '$skipeol'(C), '$ilgl'(C), @@ -900,18 +816,6 @@ be lost. '$continue_debugging_goal'(_,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) :- '__NB_getval__'('$spy_glist',[_|History], fail), ( @@ -1046,14 +950,11 @@ be lost. '$delete_if_there'([Q|L], T, TN, [Q|LN]) :- '$delete_if_there'(L, T, TN, LN). -'$debugger_deterministic_goal'(G) :- - yap_hacks:current_choicepoints(CPs0), -% $cps(CPs0), - '$debugger_skip_traces'(CPs0,CPs1), - '$debugger_skip_loop_spy2'(CPs1,CPs2), - '$debugger_skip_spycall'(CPs2,CPs3), - '$debugger_skip_loop_spy2'(CPs3,[Catch|_]), - yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$TraceError'(_,_,G,_,_),_),_). + '$debugger_deterministic_goal'(exit). + '$debugger_deterministic_goal'(fail). + '$debugger_deterministic_goal'(!). + '$debugger_deterministic_goal'(exception(_)). + '$debugger_deterministic_goal'(external_exception(_)). '$cps'([CP|CPs]) :-