diff --git a/C/cdmgr.c b/C/cdmgr.c index e880251b7..024d4e617 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2036,7 +2036,7 @@ static Int p_sys_export(USES_REGS1) { /* '$set_spy'(+Fun,+M) */ ******************************************************************/ -static Int p_is_no_trace(USES_REGS1) { /* '$undefined'(P,Mod) */ +static Int p_is_private(USES_REGS1) { /* '$undefined'(P,Mod) */ PredEntry *pe; pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); @@ -2051,7 +2051,7 @@ static Int p_is_no_trace(USES_REGS1) { /* '$undefined'(P,Mod) */ return false; } -static Int p_set_no_trace(USES_REGS1) { /* '$set_no_trace'(+Fun,+M) */ +static Int p_set_private(USES_REGS1) { /* '$set_private'(+Fun,+M) */ PredEntry *pe; pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); @@ -2067,7 +2067,7 @@ int Yap_SetNoTrace(char *name, arity_t arity, Term tmod) { PredEntry *pe; if (arity == 0) { - pe = Yap_get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace"); + pe = Yap_get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "private"); } else { pe = RepPredProp( PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity), tmod)); @@ -4252,7 +4252,7 @@ static Int init_pred_flag_vals(USES_REGS1) { ModuleTransparentPredFlag PASS_REGS); pred_flag_clause(f, mod, "multi", MultiFileFlag PASS_REGS); pred_flag_clause(f, mod, "no_spy", NoSpyPredFlag PASS_REGS); - pred_flag_clause(f, mod, "no_trace", NoTracePredFlag PASS_REGS); + pred_flag_clause(f, mod, "private", NoTracePredFlag PASS_REGS); pred_flag_clause(f, mod, "number_db", NumberDBPredFlag PASS_REGS); pred_flag_clause(f, mod, "profiled", ProfiledPredFlag PASS_REGS); pred_flag_clause(f, mod, "quasi_quotation", QuasiQuotationPredFlag PASS_REGS); @@ -4331,9 +4331,9 @@ void Yap_InitCdMgr(void) { SafePredFlag | SyncPredFlag); Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous, TestPredFlag | SafePredFlag); - Yap_InitCPred("$is_no_trace", 2, p_is_no_trace, TestPredFlag | SafePredFlag); - Yap_InitCPred("$set_no_trace", 2, p_set_no_trace, - TestPredFlag | SafePredFlag); + Yap_InitCPred("$is_private", 2, p_is_private, TestPredFlag | SafePredFlag); + Yap_InitCPred("$set_private", 2, p_set_private, + SyncPredFlag | SafePredFlag); Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag | SyncPredFlag); Yap_InitCPred("$profile_info", 3, p_profile_info, SafePredFlag | SyncPredFlag); diff --git a/C/exec.c b/C/exec.c index de50c122e..4db48eb05 100755 --- a/C/exec.c +++ b/C/exec.c @@ -792,6 +792,14 @@ restart_exec: return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); } +static Int creep_clause(USES_REGS1) { /* '$execute_clause'(Goal) */ + Int rc = execute_clause( PASS_REGS1 ); + if (!LOCAL_InterruptsDisabled) { + Yap_signal(YAP_CREEP_SIGNAL); + } + return rc; +} + static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */ return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS); } @@ -898,6 +906,10 @@ static bool watch_cut(Term ext USES_REGS) { bool active = ArgOfTerm(5, task) == TermTrue; bool ex_mode = false; + LOCAL_Signals = 0; + CalculateStackGap(PASS_REGS1); + LOCAL_PrologMode = UserMode; + if (complete) { return true; } @@ -945,6 +957,9 @@ static bool watch_retry(Term d0 USES_REGS) { bool complete = !IsVarTerm(ArgOfTerm(4, task)); bool active = ArgOfTerm(5, task) == TermTrue; choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task))); + LOCAL_Signals = 0; + CalculateStackGap(PASS_REGS1); + LOCAL_PrologMode = UserMode; if (complete) return true; @@ -1003,6 +1018,9 @@ static Int setup_call_catcher_cleanup(USES_REGS1) { Int oENV = LCL0 - ENV; Int oYENV = LCL0 - YENV; bool rc; + LOCAL_Signals = 0; + CalculateStackGap(PASS_REGS1); + LOCAL_PrologMode = UserMode; Yap_DisableInterrupts(worker_id); rc = Yap_RunTopGoal(Setup, false); Yap_EnableInterrupts(worker_id); @@ -1038,6 +1056,9 @@ static Int cleanup_on_exit(USES_REGS1) { bool box = ArgOfTerm(1, task) == TermTrue; Term cleanup = ArgOfTerm(3, task); Term complete = IsNonVarTerm(ArgOfTerm(4, task)); + LOCAL_Signals = 0; + CalculateStackGap(PASS_REGS1); + LOCAL_PrologMode = UserMode; while (B->cp_ap->opc == FAIL_OPCODE) B = B->cp_b; @@ -2376,6 +2397,7 @@ void Yap_InitExecFs(void) { Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag); Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); + Yap_InitCPred("$creep_clause", 4,creep_clause, NoTracePredFlag); Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0); CurrentModule = HACKS_MODULE; diff --git a/C/globals.c b/C/globals.c index 637066b64..e1c128900 100644 --- a/C/globals.c +++ b/C/globals.c @@ -212,7 +212,7 @@ static Term NewArena(UInt size, int wid, UInt arity, CELL *where, struct cell_sp WORKER_REGS(wid) exit_cell_space(cellSpace); // make sure we have enough room - while (HR + size > ASP - MIN_ARENA_SIZE) { + while (HR + size > ASP - 2*MIN_ARENA_SIZE) { if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return TermNil; diff --git a/library/rbtrees.yap b/library/rbtrees.yap index d78dace0c..bef880120 100644 --- a/library/rbtrees.yap +++ b/library/rbtrees.yap @@ -76,7 +76,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or rb_partial_map(+,+,2,-), rb_apply(+,+,2,-). - +/* :- use_module(library(type_check)). :- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)). @@ -97,7 +97,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or :- pred max(tree(K,V),K,V). :- pred rb_next(rbtree(K,V),K,pair(K,V),V). :- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)). - +*/ %% @pred rb_new(-T) is det. % create an empty tree. @@ -1455,4 +1455,4 @@ with _NewVal_. Fails if it cannot find _Key_ in _T_. */ -%%! @} \ No newline at end of file +%%! @} diff --git a/pl/debug.yap b/pl/debug.yap index e387ddb5f..cf5992193 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -296,27 +296,10 @@ be lost. * @param _Mod_:_Goal_ is the goal to be examined. * @return `call(Goal)` */ -'$trace'(Mod:G) :- - '$creep_is_off'(Mod:G,_GN0), - !, - gated_call( - true, - Mod:G, - E, - '$reenter_debugger'(E) - ). +%%! The first case matches system_predicates or zip '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_query'(G, Mod, CP, G, EG), - gated_call( - '$debugger_io', - ( '$enter_debugging'(G,Mod), EG ), - E, - '$continue_debugging'(E) - ). - - - + '$trace_query'(G, Mod, CP, _G). '$trace'(Mod:G, A1) :- @@ -408,100 +391,133 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_query'(G, M, CP, G, EG ), - call(EG). + '$trace_query'(G, M, CP, _G ). %% @pred '$trace_query'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_query'(V, M, _CP, _, call(M:V)) :- - var(V), !. -'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- - !. -'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- - !. -'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- - !. -'$trace_query'(true, _, _, _, true) :- !. -'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_query'(M:G, _, CP,S, Expanded) :- +'$trace_query'(V, M, _CP, _) :- + var(V), !, call(M:V). +'$trace_query'(!, _, CP, _) :- + !, '$$cut_by'(CP). +'$trace_query'('$cut_by'(M), _, _, _) :- + !, '$$cut_by'(M). +'$trace_query'('$$cut_by'(M), _, _, _) :- + !, '$$cut_by'(M). +'$trace_query'(M:G, _, CP,S) :- !, '$yap_strip_module'(M:G, M0, G0), - '$trace_query'(G0, M0, CP,S, Expanded ). -'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, - '$trace_query'(A, M, CP, S, EA). -'$trace_query'(G, M, _CP, _, ( + '$trace_query'(G0, M0, CP,S ). +'$trace_query'((A,B), M, CP, S) :- !, + '$trace_query'(A, M, CP, S), + '$trace_query'(B, M, CP, S). +'$trace_query'((A->B), M, CP, S) :- !, + '$trace_query'(A, M, CP, S) -> + '$trace_query'(B, M, CP, S). +'$trace_query'((A;B), M, CP, S) :- !, + '$trace_query'(A, M, CP, S); + '$trace_query'(B, M, CP, S). +'$trace_query'((A|B), M, CP, S) :- !, + '$trace_query'(A, M, CP, S); + '$trace_query'(B, M, CP, S). +'$trace_query'((\+ A), M, CP, S) :- !, + '$trace_query'(A, M, CP, S). +'$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) %% %% Actually debugs a %% goal! +'$trace_goal'(G,M, _GoalNumber, _H) :- + ( + '$is_private'(G, M) + ; + current_prolog_flag(debug,false) + ), + !, + gated_call( + '$start_user_code', + % try creeping + '$execute_nonstop'(G,M), + Port, + '$reenter_debugger'(Port) + ). +'$trace_goal'(G,M, GoalNumber, H) :- + '$enter_trace'(GoalNumber, G, M, H), + '$creep_is_off'(M:G, GoalNumber), + !, + gated_call( + '$start_user_code', + % try creeping + '$execute_nonstop'(G,M), + Port, + '$trace_port_'( Port, GoalNumber, G, M, H) + ). '$trace_goal'(G,M, GoalNumber, H) :- '$is_source'(G,M), - '$current_choice_point'(CP), !, - '$enter_trace'(GoalNumber, G, M, H), + '$current_choice_point'(CP), + %clause generator: it controls fail, redo gated_call( true, - ( '$enter_debugging'(G,M,GoalNumber) - -> - % source mode - clause(M:G, B), '$trace_query'(B,M,CP,B,H) - ; - '$execute_nonstop'(G,M) - ), + clause(M:G, B), + Port0, + '$trace_port'(pred,Port0, GoalNumber, G, M, H) + ), + gated_call( + true,% source mode + '$trace'(B,M,CP,H), Port, ( - '$reenter_debugging'(Port,G,M,GoalNumber), - '$trace_port'(Port, GoalNumber, G, M, true, H) + '$trace_port'(clause,Port, GoalNumber, G, M, H) ) ). +'$trace_goal'(G,M, GoalNumber, H) :- + !, + '$current_choice_point'(CP), + %clause generator: it controls fail, redo + gated_call( + true, + '$static_clause'(G,M,_,Ref), + Port0, + '$trace_port'(pred,Port0, GoalNumber, G, M, H) + ), + gated_call( + '$start_user_code', + % source mode + '$creep_clause'(G,M,Ref,CP), + Port, + '$trace_port'(clause, Port, GoalNumber, G, M, H) + ). '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), - strip_module(G1, MF, NG), - '$trace_goal__'(NG,MF, GoalNumber, H). -'$trace_goal'(G, M, GoalNumber, H) :- - '$trace_goal__'(G,M, GoalNumber, H). - -'$trace_goal__'(G,M, _GoalNumber, _H) :- '$undefined'(G,M), !, - '$undefp'([M|G], _). + '$undefp'([M|G], G1), + strip_module(G1, MF, NG), + '$trace_goal'(NG,MF, GoalNumber, H). + % system_ -'$trace_goal__'(G,M, GoalNumber, H) :- - '$enter_trace'(GoalNumber, G, M, H), - gated_call( - true, - ( - % try creeping - ( '$enter_debugging'(G,M,GoalNumber) -> '$creep' ; true ), - '$execute_nonstop'(G,M) - ), - Port, - '$trace_port'(Port, GoalNumber, G, M, true, H) - ). /** @@ -515,22 +531,12 @@ be lost. * */ '$enter_trace'(L, G, Module, Info) :- - /* get goal no. */ - ( var(L) -> - '__NB_getval__'('$spy_gn',L,fail), - /* bump it */ - L1 is L+1, - /* and save it globaly */ - '__NB_setval__'('$spy_gn',L1) - ; - true - ), + '$id_goal'(L), /* get goal no. */ /* get goal list */ '__NB_getval__'('$spy_glist',History,History=[]), H = [Info|History], Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers), - b_setval('$spy_glist',H), - /* and update it */ + b_setval('$spy_glist',H), /* and update it */ '$port'(call,G,Module,L,deterministic, Info). '$id_goal'(L) :- @@ -556,58 +562,44 @@ be lost. * @parameter _Info_ describes the goal * */ -'$trace_go'(GoalNumber, G, M, Info) :- - X=marker(_,M,G), - '$$save_by'(CP), - clause(M:G, Cl, _), - '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_query'(Cl, M, CP, Cl, ECl), - '$execute0'(ECl,M). +'$trace_port'(_, _, _GoalNumber, _G, _Module, _Info) :- + '$stop_creeping'(_), + fail. -'$creep_step'(GoalNumber, G, M, Info) :- - X=marker(_,M,G), - '$$save_by'(CP), - '$static_clause'(G,M,_,Ref), - '$retry_clause'(GoalNumber, G, M, Info, X), - '$creep', - '$execute_clause'(G,M,Ref,CP). - -'$retry_clause'(_GoalNumber, _G, _M, _Info, MarkerV) :- - arg(1, MarkerV, V), - var(V), +'$trace_port'(pred, fail, GoalNumber, G, Module, Info) :- + !, + '$trace_port_'(fail, GoalNumber, G, Module, Info). +'$trace_port'(pred, call, GoalNumber, G, Module, Info) :- + !, + '$trace_port_'(call, GoalNumber, G, Module, Info). +'$trace_port'(pred, redo, GoalNumber, G, Module, Info) :- !, - nb_setarg(1,MarkerV, visited). -'$retry_clause'(GoalNumber, G, Module, Info, _X) :- '$trace_port_'(redo, GoalNumber, G, Module, Info). +'$trace_port'(pred, _Port, _GoalNumber, _G, _Module, _Info). + -'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- - '$trace_off', +'$trace_port'(clause, call, _GoalNumber, _G, _Module, _Info). +'$trace_port'(clause, fail, _GoalNumber, _G, _Module, _Info) :- + fail. +'$trace_port'(clause, Port, GoalNumber, G, Module, Info) :- !, - '$trace_port_'(Port, GoalNumber, G, Module, Info), - '$continue_debugging'(Port). -'$trace_port'(Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info) :- - '$continue_debugging'(Port). + '$trace_port_'(Port, GoalNumber, G, Module, Info). '$trace_port_'(call, GoalNumber, G, Module, Info) :- '$port'(call,G,Module,GoalNumber,deterministic, Info). '$trace_port_'(exit, GoalNumber, G, Module, Info) :- - nb_setarg(6, Info, true), '$port'(exit,G,Module,GoalNumber,deterministic, Info). '$trace_port_'(answer, GoalNumber, G, Module, Info) :- '$port'(exit,G,Module,GoalNumber,nondeterministic, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info) :- - '$stop_creeping'(_ ), '$port'(redo,G,Module,GoalNumber,nondeterministic, Info). /* inform user_error */ '$trace_port_'(fail, GoalNumber, G, Module, Info) :- - '$stop_creeping'(_ ), '$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */ '$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */ !. '$trace_port_'(exception(E), GoalNumber, G, Module, Info) :- - '$stop_creeping'(_ ), '$TraceError'(E, GoalNumber, G, Module, Info). '$trace_port_'(external_exception(E), GoalNumber, G, Module, Info) :- - '$stop_creeping'(_ ), '$TraceError'(E, GoalNumber, G, Module, Info). @@ -731,7 +723,7 @@ be lost. '__NB_getval__'('$trace',Trace,fail), '__NB_setval__'('$debug_status', state(creep, 0, stop, Trace)). '$action'(!,_,_,_,_,_) :- !, % ! 'g execute - read(debugger_input, G), + read(debugger_input, G), % don't allow yourself to be caught by creep. ignore( G ), skip( debugger_input, 10), % ' @@ -753,7 +745,6 @@ be lost. fail. '$action'(a,_,_,_,_,_) :- !, % 'a abort skip( debugger_input, 10), - '$stop_creeping'(_), nodebug, abort. '$action'(b,_,_,_,_,_) :- !, % 'b break diff --git a/pl/signals.yap b/pl/signals.yap index 4a0cb7242..215697084 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -295,18 +295,18 @@ read_sig. % % % make thes predicates non-traceable. % -:- '$set_no_trace'(current_choicepoint(_DCP), yap_hacks). -:- '$set_no_trace'('$current_choice_point'(_DCP), _). -:- '$set_no_trace'('$$cut_by'(_DCP), prolog). -:- '$set_no_trace'(true, yap_hacks). -:- '$set_no_trace'(true, prolog). -:- '$set_no_trace'('$call'(_,_,_,_), prolog). -:- '$set_no_trace'('$execute_nonstop'(_,_), prolog). -:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog). -:- '$set_no_trace'('$restore_regs'(_,_), prolog). -:- '$set_no_trace'('$undefp'(_,_), prolog). -:- '$set_no_trace'('$Error'(_), prolog). -:- '$set_no_trace'('$LoopError'(_,_), prolog). -:- '$set_no_trace'('$TraceError'(_,_,_,_,_), prolog). +:- '$set_private'(current_choicepoint(_DCP), yap_hacks). +:- '$set_private'('$current_choice_point'(_DCP), _). +:- '$set_private'('$$cut_by'(_DCP), prolog). +:- '$set_private'(true, yap_hacks). +:- '$set_private'(true, prolog). +:- '$set_private'('$call'(_,_,_,_), prolog). +:- '$set_private'('$execute_nonstop'(_,_), prolog). +:- '$set_private'('$execute_clause'(_,_,_,_), prolog). +:- '$set_private'('$restore_regs'(_,_), prolog). +:- '$set_private'('$undefp'(_,_), prolog). +:- '$set_private'('$Error'(_), prolog). +:- '$set_private'('$LoopError'(_,_), prolog). +:- '$set_private'('$TraceError'(_,_,_,_,_), prolog). %%! @} diff --git a/pl/spy.yap b/pl/spy.yap index 2d7305b3c..a6b734db5 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -200,13 +200,15 @@ nospyall. debug :- '$init_debugger', ( '__NB_getval__'('$spy_gn',_, fail) -> true ; '__NB_setval__'('$spy_gn',1) ), - '$start_debugging'(on), + set_prolog_flag(debug,true), + '$start_user_code', print_message(informational,debug(debug)). -'$start_debugging'(_Mode) :- - '__NB_setval__'(debug, false), +'$start_user_code' :- + yap_flag(debug, Can), + '__NB_setval__'(debug, Can), '__NB_getval__'('$trace',Trace, fail), - ( Trace == on -> Creep = crep; Creep = zip ), + ( Trace == on -> Creep = creep; Creep = zip ), '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). nodebug :- @@ -228,13 +230,10 @@ Switches on the debugger and enters tracing mode. */ trace :- - '$init_debugger', - fail. -trace :- - '__NB_setval__'('$trace',on), - '$start_debugging'(on), print_message(informational,debug(trace)), - '$creep'. + set_prolog_flag(debug,true), + '__NB_setval__'('$trace',on), + '$init_debugger'. /** @pred notrace @@ -392,16 +391,18 @@ notrace(G) :- '$enable_debugging'. '$init_debugger' :- - '$init_debugger_trace', + '$debugger_io', + '$init_debugger_trace', '__NB_setval__'('$if_skip_mode',no_skip), '__NB_setval__'('$spy_glist',[]), '__NB_setval__'('$spy_gn',1). '$init_debugger_trace' :- '__NB_getval__'('$trace',on,fail), - !, - nb_setval('$debug_status', state(creep, 0, stop, on)). + !, + nb_setval('$debug_status', state(creep, 0, stop, on)). '$init_debugger_trace' :- + '__NB_setval__'('$trace',off), nb_setval('$debug_status', state(zip, 0, stop, off)). %% @pred $enter_debugging(G,Mod,CP,G0,NG) @@ -409,14 +410,27 @@ notrace(G) :- %% Internal predicate called by top-level; %% enable creeping on a goal by just switching execution to debugger. %% -'$enter_debugging'(G,Mod,CP,G0,NG) :- +'$enter_debugging'(G,Mod,_CP,_G0,_NG) :- '$creepcalls'(G,Mod), - !, - '$trace_query'(G,Mod,CP,G0,NG). + !. '$enter_debugging'(G,_Mod,_CP,_G0,G). '$enter_debugging'(G,Mod,GN) :- - çurrent_prolog_flag( debug, Deb ), + current_prolog_flag( debug, Deb ), + '__NB_set_value__'( debug, Deb ), + ( Deb = false + -> + true + ; + '$creep_is_on_at_entry'(G,Mod,GN) + -> + '$creep' + ; + true + ). + +'$exit_debugger'(Mod:G, GN) :- + current_prolog_flag( debug, Deb ), '__NB_set_value__'( debug, Deb ), ( Deb = false -> @@ -431,7 +445,7 @@ notrace(G) :- %% we're coming back from external code to a debugger call. %% -'$reenter_debugger'(retry) :- +'$reenter_debugger'(fail) :- '$re_enter_creep_mode'. '$reenter_debugger'(_) :- '__NB_setval__'(debug, false). @@ -442,10 +456,15 @@ notrace(G) :- '$re_enter_creep_mode'. '$continue_debugging'(answer) :- !, - '$re_enter_creep_mode'. + '$re_enter_creep_mode'. '$continue_debugging'(fail) :- !, '$re_enter_creep_mode', + fail. +'$continue_debugging'(redo) :- + !, + '$re_enter_creep_mode', + fail. '$continue_debugging'(_). '$enable_debugging' :- @@ -458,33 +477,37 @@ notrace(G) :- %% enable creeping on the next goal. %% '$re_enter_creep_mode' :- - !, - '$creep'. -'$re_enter_creep_mode'. + current_prolog_flag( debug, Deb ), + '__NB_setval__'( debug, Deb ). -'$creep_is_off'(Module:G, GN0) :- - '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail), - ( - + +'$creep_is_off'(Module:G, GoalNo) :- + ( + current_prolog_flag( debug, false ) + -> true + ; + '$system_predicate'(G,Module) + -> true + ; + '$is_private'(G,Module) + -> true + ; + '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail) + -> + true + ; '$pred_being_spied'(G,Module) -> Spy == ignore ; - var(GN0) + var(GN) -> - true + false ; - GN > GN0 - ). - -%% -% -'$creep_is_on' :- - '__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail), - Step \= zip. - -'$creep_is_on_at_entry'(G,M,GoalNo) :- - \+ '$system_predicate'(G,M), + GN > GoalNo + ). +'$creep_is_on_at_entry'(G,M,_GoalNo) :- + \+ '$system_predicate'(G,M), '__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail), ( Step \= zip @@ -496,7 +519,7 @@ notrace(G) :- '$trace_on' :- '__NB_getval__'('$debug_status', state(_Creep, GN, Spy,Trace), fail), - nb_getval('$trace',on), + nb_setval('$trace',on), nb_setval('$debug_status', state(creep, GN, Spy, Trace)). '$trace_off' :- diff --git a/pl/top.yap b/pl/top.yap index 9a3db0b30..117b4cd2a 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -93,16 +93,6 @@ live :- ; '$halt'(0) ). -'$init_debug' :- - nb_setval('$spy_gn', 1), - % stop at spy-points if debugging is on. - nb_setval('$debug_run', off), - nb_setval('$debug_jump', off), - '__NB_getval__'('$trace', Trace, fail), - ( Trace==on - -> nb_setval('$debug_status', state(creep, 0, stop, on)) - ; nb_setval('$debug_status', state(zip, 0, stop, off)) - ). '$erase_sets' :- eraseall($), @@ -587,21 +577,10 @@ write_query_answer( Bindings ) :- '$call'(G, CP, G, M). '$user_call'(G, CP, G0, M) :- - gated_call( - '$enable_debugging', - '$call'(G, CP, G0, M), - Port, - '$reenter_debugger'(Port) - ). - + '$trace_query'(G, M, CP, G0). '$user_call'(G, M) :- - gated_call( - '$enable_debugging', - M:G, - Port, - '$reenter_debugger'(Port) - ). + '$trace'(M:G). '$cut_by'(CP) :- '$$cut_by'(CP).