diff --git a/C/exec.c b/C/exec.c index dc140e02e..4bc84231d 100755 --- a/C/exec.c +++ b/C/exec.c @@ -765,22 +765,13 @@ static void complete_inner_computation(choiceptr old_B) { ENV = myB->cp_env; } -static Int Yap_ignore(Term t USES_REGS) { +static Int Yap_ignore(Term t, bool fail USES_REGS) { yamop *oP = P, *oCP = CP; Int oENV = LCL0 - ENV; Int oYENV = LCL0 - YENV; Int oB = LCL0 - (CELL *)B; bool rc = Yap_RunTopGoal(t, false); - if (Yap_RaiseException()) { - P = oP; - CP = oCP; - ENV = LCL0 - oENV; - YENV = LCL0 - oYENV; - B = (choiceptr)(LCL0 - oB); - return false; - } - if (!rc) { complete_inner_computation((choiceptr)(LCL0 - oB)); // We'll pass it through @@ -816,15 +807,18 @@ static bool watch_cut(Term ext USES_REGS) { // Term task = TailOfTerm(ext); Term cleanup = ArgOfTerm(3, task); - bool complete = !IsVarTerm(Deref(ArgOfTerm(4, task))); + Term e = 0; + bool complete = IsNonVarTerm(Deref(ArgOfTerm(4, task))); bool active = ArgOfTerm(5, task) == TermTrue; - + bool ex_mode = false; + if (complete) { return true; } CELL *port_pt = deref_ptr(RepAppl(task) + 2); - if (Yap_HasException()) { - Term e = Yap_GetException(); + CELL *completion_pt = deref_ptr(RepAppl(task) + 4); + if ((ex_mode = Yap_HasException())) { + e = Yap_GetException(); Term t; if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); @@ -832,12 +826,17 @@ static bool watch_cut(Term ext USES_REGS) { t = Yap_MkApplTerm(FunctorExternalException, 1, &e); } port_pt[0] = t; + completion_pt[0] = TermException; } else { - port_pt[0] = TermCut; + completion_pt[0] = port_pt[0] = TermCut; } - Yap_ignore(cleanup); + Yap_ignore(cleanup, false); CELL *complete_pt = deref_ptr(RepAppl(task) + 4); complete_pt[0] = TermTrue; + if (ex_mode) { + Yap_PutException(e); + return true; + } if (Yap_RaiseException()) return false; return true; @@ -854,31 +853,34 @@ static bool watch_cut(Term ext USES_REGS) { static bool watch_retry(Term d0 USES_REGS) { // called after backtracking.. // - CELL d = ((CELL *)Yap_blob_info(HeadOfTerm(d0)))[0]; - - choiceptr B0 = (choiceptr)(LCL0 - d); Term task = TailOfTerm(d0); bool box = ArgOfTerm(1, task) == TermTrue; Term cleanup = ArgOfTerm(3, task); bool complete = !IsVarTerm(ArgOfTerm(4, task)); bool active = ArgOfTerm(5, task) == TermTrue; + choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task))); - if ( complete) + if (complete) return true; - CELL *port_pt= deref_ptr(RepAppl(Deref(task))+ 2); - CELL *complete_pt= deref_ptr(RepAppl(Deref(task))+ 4); - Term t; + CELL *port_pt = deref_ptr(RepAppl(Deref(task)) + 2); + CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4); + Term t, e = 0; + bool ex_mode = false; while (B->cp_ap->opc == FAIL_OPCODE) B = B->cp_b; - if (Yap_HasException()) { - Term e = Yap_GetException(); + + // just do the frrpest + if (B >= B0 && !ex_mode && !active) + return true; + if ((ex_mode = Yap_HasException())) { + e = Yap_GetException(); if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); } else { t = Yap_MkApplTerm(FunctorExternalException, 1, &e); } - complete_pt[0] = t; + complete_pt[0] = TermException; } else if (B >= B0) { t = TermFail; complete_pt[0] = t; @@ -889,8 +891,12 @@ static bool watch_retry(Term d0 USES_REGS) { return true; } port_pt[0] = t; - Yap_ignore(cleanup); - if ( Yap_RaiseException()) + Yap_ignore(cleanup, true); + if (ex_mode) { + Yap_PutException(e); + return true; + } + if (Yap_RaiseException()) return false; return true; } @@ -947,27 +953,30 @@ static Int cleanup_on_exit(USES_REGS1) { bool box = ArgOfTerm(1, task) == TermTrue; Term cleanup = ArgOfTerm(3, task); Term catcher = ArgOfTerm(2, task); - Term complete = !IsVarTerm( ArgOfTerm(4, task)); + Term complete = IsNonVarTerm(ArgOfTerm(4, task)); while (B->cp_ap->opc == FAIL_OPCODE) B = B->cp_b; - if (complete ) + if (complete) { return true; - CELL *catcher_p = deref_ptr(RepAppl(Deref(task))+2); - if (B < B0) - { + } + CELL *catcher_pt = deref_ptr(RepAppl(Deref(task)) + 2); + CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4); + if (B < B0) { // non-deterministic set_watch(LCL0 - (CELL *)B, task); - catcher_p[0] = TermAnswer; if (!box) { return true; } + catcher_pt[0] = TermAnswer; } else { - catcher_p[0] = TermExit; - CELL *complete_p = deref_ptr(RepAppl(Deref(task))+4); - complete_p[0] = TermExit; + catcher_pt[0] = TermExit; + complete_pt[0] = TermExit; + } + Yap_ignore(cleanup, false); + if (Yap_RaiseException()) { + return false; } - Yap_ignore(cleanup); return true; } diff --git a/pl/boot.yap b/pl/boot.yap index 30c413d74..a2a1d9ebf 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1091,23 +1091,19 @@ incore(G) :- '$execute'(G). '$call'(G, CP, G, M). '$user_call'(G, M) :- - ( - '$$save_by'(CP), - '$enable_debugging', - '$call'(G, CP, M:G, M), - '$$save_by'(CP2), - ( - CP == CP2 - -> - ! - ; - ( true ; '$enable_debugging', fail ) - ), - '$disable_debugging' - ; - '$disable_debugging', - fail - ). + '$gated_call'( + ('$$save_by'(CP), + '$enable_debugging'), + '$call'(G, CP, M:G, M), + Port, + '$disable_debugging_on_port'(Port) + ). + +'$disable_debugging_on_port'(retry) :- + !, + '$enable_debugging'. +'$disable_debugging_on_port'(_Port) :- + '$disable_debugging'. @@ -1433,6 +1429,19 @@ Command = (H --> B) -> '$head_and_body'((H:-B),H,B) :- !. '$head_and_body'(H,H,true). + +gated_call(Setup, 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), + TaskF = cleanup( All, Catcher, Cleanup, Tag, false, CP0), + '$tag_cleanup'(CP0, Task0), + call( Goal ), + '$cleanup_on_exit'(CP0, TaskF). + + % % split head and body, generate an error if body is unbound. % diff --git a/pl/control.yap b/pl/control.yap index 9bb2d23f6..8a63d41fc 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -262,12 +262,10 @@ This is similar to call_cleanup/1 but with an additional */ call_cleanup(Goal, Cleanup) :- - call_cleanup(Goal, _Catcher, Cleanup). +'$gated_call'( false , Goal,_Catcher, Cleanup) . call_cleanup(Goal, Catcher, Cleanup) :- - '$tag_cleanup'(CP0, cleanup( false, Catcher, Cleanup, Tag, 0, Done)), - call( Goal ), - '$cleanup_on_exit'(CP0, cleanup( false, Catcher, Cleanup, Tag, 1, Done )). +'$gated_call'( false , Goal, Catcher, Cleanup) . /** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_) @@ -291,15 +289,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :- '$setup_call_catcher_cleanup'(Setup), call_cleanup(Goal, Catcher, Cleanup). -gated_call(Setup, Goal, Catcher, Cleanup) :- - Task0 = cleanup( true, Catcher, Cleanup, Tag, true, Done), - TaskF = cleanup( true, Catcher, Cleanup, Tag, false, Done), - '$setup_call_catcher_cleanup'(Setup), - '$tag_cleanup'(CP0, Task0), - call( Goal ), - '$cleanup_on_exit'(CP0, TaskF). - - /** @pred call_with_args(+ _Name_,...,? _Ai_,...) diff --git a/pl/debug.yap b/pl/debug.yap index 610daf279..9d1d22641 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -406,45 +406,83 @@ be lost. '$do_spy'(ignore(G), M, CP, CalledFromDebugger) :- !, ignore( '$do_spy'(G, M, CP, CalledFromDebugger) ). '$do_spy'(G, Module, _, CalledFromDebugger) :- + '$loop_spy'(G, Module, CalledFromDebugger). + +% 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) + ). + +%%% fail just fails. +'$redo_spy'(abort, _G, _Module, _CalledFromDebugger, _GoalNumber, _H) :- + z + abort. +'$redo_spy'('$forward'('$wrapper'(E),G0), _G, _Module, _CalledFromDebugger, _ z'$redo_spy'('$forward'('$fail_spy',G0), __G, __Module, __CalledFromDebugger, GoalNumber, _H) :- + GoalNumber =< G0, + !, + fail. +'$redo_spy'('$forward'('$retry_spy',G0), G, Module, CalledFromDebugger, 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, + '$redo_spy'( G, Module, CalledFromDebugger, H) + ). +'$redo_spy'('$forward'(C,G0), G, Module, CalledFromDebugger, GoalNumber, H) :- + throw(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 */ - '__B_setval__'('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), + H = [info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History], + '__B_setval__'('$spy_glist',H). /* and update it */ - '$loop_spy'(L, G, Module, CalledFromDebugger). -% we are skipping, so we can just call the goal, -% while leaving the minimal structure in place. -'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :- - '$current_choice_point'(CP), - '$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP), - Module, Error, - '$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger)). +'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :- + '$stop_creeping'(_) , + '$spy_port_'(Port, GoalNumber, G, Module, CalledFromDebugger, Info). + +'$spy_port_'(exit, GoalNumber, G, Module, CalledFromDebugger, Info) :- + nb_setarg(6, Info, true), + '$show_trace'(exit,G,Module,GoalNumber,true), + '$continue_debugging'(exit, CalledFromDebugger). +'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, Info) :- + '$show_trace'(exit,G,Module,GoalNumber,false), + '$continue_debugging'(exit, CalledFromDebugger). +'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, Info) :- + '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ + '$continue_debugging'(fail, CalledFromDebugger). +'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, Info) :- + '$show_trace'(fail,G,Module,GoalNumber,_), /* inform user_error */ + '$continue_debugging'(fail, CalledFromDebugger). +'$spy_port_'(! ,G,Module,GoalNumber,_) :- /* inform user_error */ + !. +'$spy_port_'(exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :- + '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger). +'$spy_port_'(external_exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :- + '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger). + -/** - * @pred '$TraceError'(+Exception, +CurrentGoalId, +CurrentGoal, +Module, +Status) - * - * forward exception until leaving the debugger or - * finding a matching frame: - * -*/ %%% - retry: forward throw while the call is newer than goal -'$TraceError'( abort, _, _, _, _) :- - '$stop_creeping'(_), - abort. -'$TraceError'('$forward'('$retry_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :- - ( G0 >= GoalNumber - -> - '$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) -; - throw('$forward'('$retry_spy'(G0))) - ). +'$TraceError'( abort, _, _, _, _). +'$TraceError'('$forward'('$retry_spy'(G0)), _, _, _, _). %%% - backtrack long distance -'$TraceError'('$forward'('$fail_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :- - G0 >= GoalNumber, !, - '$loop_fail'(GoalNumber, G, Module, CalledFromDebugger). -'$TraceError'('$forward'('$fail_spy'(GoalNumber)), _, _, _, _) :- !, +'$TraceError'('$forward'('$fail_spy'(G0)), _, _, _, _) :- !, throw(error('$fail_spy'(GoalNumber))). %%% %%% - forward through the debugger @@ -473,75 +511,6 @@ be lost. '$continue_debugging'(fail, CalledFromDebugger), fail. -/** - * core routine for the debugger - * - * @param _ GoalNumbera id - * @param _ S9c - * @param _ - * @param Retry - * @param Det - * @param false - * - * @return -*/ -'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :- -/* the following choice point is where the predicate is called */ - '__NB_getval__'('$spy_glist',[Info|_],true), /* get goal list */ - Info = info(_,_,_,Retry,Det,false), - ( - /* call port */ - '$enter_goal'(GoalNumber, G, Module), - '$spycall'(G, Module, CalledFromDebugger, Retry), - '$stop_creeping'(_) , - % make sure we are in system mode when running the debugger. - ( - '$debugger_deterministic_goal'(G) -> - Det=true - ; - Det=false - ), - /* go execute the continuation */ - ( - /* exit port */ - Retry = false, - /* found an answer, so it can redo */ - nb_setarg(6, Info, true), - '$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */ - /* exit port */ - /* get rid of deterministic computations */ - ( - Det == true - -> - '$$cut_by'(CP) - ; - true - ), - '$continue_debugging'(exit, CalledFromDebugger) - ; - /* make sure we are in system mode when running the debugger. */ - /* backtracking from exit */ - /* we get here when we want to redo a goal */ - /* redo port */ - ( - arg(6, Info, true) - -> - '$stop_creeping'(_) , - '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ - nb_setarg(6, Info, false) - ; - true - ), - '$continue_debugging'(fail, CalledFromDebugger), - fail /* to backtrack to spycall */ - ) - ; - '$stop_creeping'(_) , - '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ - '$continue_debugging'(fail, CalledFromDebugger), - /* fail port */ - fail - ). '$enter_goal'(GoalNumber, G, Module) :- '$zip'(GoalNumber, G, Module), !.