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

debugger cleanup - I

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-05-15 18:51:50 +01:00
parent babf3dd77d
commit ef3d435dec
8 changed files with 229 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
C/cdmgr.c
View File

@ -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; PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); 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; 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; PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); 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; PredEntry *pe;
if (arity == 0) { 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 { } else {
pe = RepPredProp( pe = RepPredProp(
PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity), tmod)); PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity), tmod));
@ -4252,7 +4252,7 @@ static Int init_pred_flag_vals(USES_REGS1) {
ModuleTransparentPredFlag PASS_REGS); ModuleTransparentPredFlag PASS_REGS);
pred_flag_clause(f, mod, "multi", MultiFileFlag 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_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, "number_db", NumberDBPredFlag PASS_REGS);
pred_flag_clause(f, mod, "profiled", ProfiledPredFlag PASS_REGS); pred_flag_clause(f, mod, "profiled", ProfiledPredFlag PASS_REGS);
pred_flag_clause(f, mod, "quasi_quotation", QuasiQuotationPredFlag PASS_REGS); pred_flag_clause(f, mod, "quasi_quotation", QuasiQuotationPredFlag PASS_REGS);
@ -4331,9 +4331,9 @@ void Yap_InitCdMgr(void) {
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous, Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous,
TestPredFlag | SafePredFlag); TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_no_trace", 2, p_is_no_trace, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_private", 2, p_is_private, TestPredFlag | SafePredFlag);
Yap_InitCPred("$set_no_trace", 2, p_set_no_trace, Yap_InitCPred("$set_private", 2, p_set_private,
TestPredFlag | SafePredFlag); SyncPredFlag | SafePredFlag);
Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag | SyncPredFlag); Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$profile_info", 3, p_profile_info, Yap_InitCPred("$profile_info", 3, p_profile_info,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);

22
C/exec.c
View File

@ -792,6 +792,14 @@ restart_exec:
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); 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) */ static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */
return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS); 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 active = ArgOfTerm(5, task) == TermTrue;
bool ex_mode = false; bool ex_mode = false;
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
if (complete) { if (complete) {
return true; return true;
} }
@ -945,6 +957,9 @@ static bool watch_retry(Term d0 USES_REGS) {
bool complete = !IsVarTerm(ArgOfTerm(4, task)); bool complete = !IsVarTerm(ArgOfTerm(4, task));
bool active = ArgOfTerm(5, task) == TermTrue; bool active = ArgOfTerm(5, task) == TermTrue;
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task))); choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
if (complete) if (complete)
return true; return true;
@ -1003,6 +1018,9 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
Int oENV = LCL0 - ENV; Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV; Int oYENV = LCL0 - YENV;
bool rc; bool rc;
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
Yap_DisableInterrupts(worker_id); Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, false); rc = Yap_RunTopGoal(Setup, false);
Yap_EnableInterrupts(worker_id); Yap_EnableInterrupts(worker_id);
@ -1038,6 +1056,9 @@ static Int cleanup_on_exit(USES_REGS1) {
bool box = ArgOfTerm(1, task) == TermTrue; bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task); Term cleanup = ArgOfTerm(3, task);
Term complete = IsNonVarTerm(ArgOfTerm(4, task)); Term complete = IsNonVarTerm(ArgOfTerm(4, task));
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
while (B->cp_ap->opc == FAIL_OPCODE) while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b; B = B->cp_b;
@ -2376,6 +2397,7 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag); Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag);
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
Yap_InitCPred("$creep_clause", 4,creep_clause, NoTracePredFlag);
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0);
CurrentModule = HACKS_MODULE; CurrentModule = HACKS_MODULE;

2
C/globals.c
View File

@ -212,7 +212,7 @@ static Term NewArena(UInt size, int wid, UInt arity, CELL *where, struct cell_sp
WORKER_REGS(wid) WORKER_REGS(wid)
exit_cell_space(cellSpace); exit_cell_space(cellSpace);
// make sure we have enough room // 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)) { if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) {
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return TermNil; return TermNil;

6
library/rbtrees.yap
View File

@ -76,7 +76,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or
rb_partial_map(+,+,2,-), rb_partial_map(+,+,2,-),
rb_apply(+,+,2,-). rb_apply(+,+,2,-).
/*
:- use_module(library(type_check)). :- use_module(library(type_check)).
:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)). :- 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 max(tree(K,V),K,V).
:- pred rb_next(rbtree(K,V),K,pair(K,V),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 next(tree(K,V),K,pair(K,V),V,tree(K,V)).
*/
%% @pred rb_new(-T) is det. %% @pred rb_new(-T) is det.
% create an empty tree. % create an empty tree.
@ -1455,4 +1455,4 @@ with _NewVal_. Fails if it cannot find _Key_ in _T_.
*/ */
%%! @} %%! @}

245
pl/debug.yap
View File

@ -296,27 +296,10 @@ be lost.
* @param _Mod_:_Goal_ is the goal to be examined. * @param _Mod_:_Goal_ is the goal to be examined.
* @return `call(Goal)` * @return `call(Goal)`
*/ */
'$trace'(Mod:G) :- %%! The first case matches system_predicates or zip
'$creep_is_off'(Mod:G,_GN0),
!,
gated_call(
true,
Mod:G,
E,
'$reenter_debugger'(E)
).
'$trace'(Mod:G) :- '$trace'(Mod:G) :-
'$$save_by'(CP), '$$save_by'(CP),
'$trace_query'(G, Mod, CP, G, EG), '$trace_query'(G, Mod, CP, _G).
gated_call(
'$debugger_io',
( '$enter_debugging'(G,Mod), EG ),
E,
'$continue_debugging'(E)
).
'$trace'(Mod:G, A1) :- '$trace'(Mod:G, A1) :-
@ -408,100 +391,133 @@ be lost.
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, G, EG ), '$trace_query'(G, M, CP, _G ).
call(EG).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded) %% @pred '$trace_query'( +G, +M, +CP, +Expanded)
% %
% debug a complex query % debug a complex query
% %
'$trace_query'(V, M, _CP, _, call(M:V)) :- '$trace_query'(V, M, _CP, _) :-
var(V), !. var(V), !, call(M:V).
'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- '$trace_query'(!, _, CP, _) :-
!. !, '$$cut_by'(CP).
'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_query'('$cut_by'(M), _, _, _) :-
!. !, '$$cut_by'(M).
'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_query'('$$cut_by'(M), _, _, _) :-
!. !, '$$cut_by'(M).
'$trace_query'(true, _, _, _, true) :- !. '$trace_query'(M:G, _, CP,S) :-
'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :-
!, !,
'$yap_strip_module'(M:G, M0, G0), '$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S, Expanded ). '$trace_query'(G0, M0, CP,S ).
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, '$trace_query'((A,B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S),
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S).
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, '$trace_query'((A->B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S) ->
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S).
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, '$trace_query'((A;B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S).
'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, '$trace_query'((A|B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S).
'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, '$trace_query'((\+ A), M, CP, S) :- !,
'$trace_query'(A, M, CP, S, EA). '$trace_query'(A, M, CP, S).
'$trace_query'(G, M, _CP, _, ( '$trace_query'(G, M,_CP,S) :-
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
strip_module(M:G1, MF, NG),
% spy a literal
'$id_goal'(L),
catch(
'$trace_goal'(NG, MF, L, S),
E,
'$TraceError'(E, G, M, L, S)
).
'$trace_query'(G, M, _CP, H) :-
% spy a literal % spy a literal
'$id_goal'(L), '$id_goal'(L),
catch( catch(
'$trace_goal'(G, M, L, H), '$trace_goal'(G, M, L, H),
E, E,
'$TraceError'(E, G, M, L, H) '$TraceError'(E, G, M, L, H)
))). ).
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
%% %%
%% Actually debugs a %% Actually debugs a
%% goal! %% 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) :- '$trace_goal'(G,M, GoalNumber, H) :-
'$is_source'(G,M), '$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( gated_call(
true, true,
( '$enter_debugging'(G,M,GoalNumber) clause(M:G, B),
-> Port0,
% source mode '$trace_port'(pred,Port0, GoalNumber, G, M, H)
clause(M:G, B), '$trace_query'(B,M,CP,B,H) ),
; gated_call(
'$execute_nonstop'(G,M) true,% source mode
), '$trace'(B,M,CP,H),
Port, Port,
( (
'$reenter_debugging'(Port,G,M,GoalNumber), '$trace_port'(clause,Port, GoalNumber, G, M, H)
'$trace_port'(Port, GoalNumber, G, M, true, 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) :- '$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), '$undefined'(G,M),
!, !,
'$undefp'([M|G], _). '$undefp'([M|G], G1),
strip_module(G1, MF, NG),
'$trace_goal'(NG,MF, GoalNumber, H).
% system_ % 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) :- '$enter_trace'(L, G, Module, Info) :-
/* get goal no. */ '$id_goal'(L), /* 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
),
/* get goal list */ /* get goal list */
'__NB_getval__'('$spy_glist',History,History=[]), '__NB_getval__'('$spy_glist',History,History=[]),
H = [Info|History], H = [Info|History],
Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers), Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers),
b_setval('$spy_glist',H), b_setval('$spy_glist',H), /* and update it */
/* and update it */
'$port'(call,G,Module,L,deterministic, Info). '$port'(call,G,Module,L,deterministic, Info).
'$id_goal'(L) :- '$id_goal'(L) :-
@ -556,58 +562,44 @@ be lost.
* @parameter _Info_ describes the goal * @parameter _Info_ describes the goal
* *
*/ */
'$trace_go'(GoalNumber, G, M, Info) :- '$trace_port'(_, _, _GoalNumber, _G, _Module, _Info) :-
X=marker(_,M,G), '$stop_creeping'(_),
'$$save_by'(CP), fail.
clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_query'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :- '$trace_port'(pred, fail, GoalNumber, G, Module, Info) :-
X=marker(_,M,G), !,
'$$save_by'(CP), '$trace_port_'(fail, GoalNumber, G, Module, Info).
'$static_clause'(G,M,_,Ref), '$trace_port'(pred, call, GoalNumber, G, Module, Info) :-
'$retry_clause'(GoalNumber, G, M, Info, X), !,
'$creep', '$trace_port_'(call, GoalNumber, G, Module, Info).
'$execute_clause'(G,M,Ref,CP). '$trace_port'(pred, redo, GoalNumber, G, Module, Info) :-
'$retry_clause'(_GoalNumber, _G, _M, _Info, MarkerV) :-
arg(1, MarkerV, V),
var(V),
!, !,
nb_setarg(1,MarkerV, visited).
'$retry_clause'(GoalNumber, G, Module, Info, _X) :-
'$trace_port_'(redo, GoalNumber, G, Module, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info).
'$trace_port'(pred, _Port, _GoalNumber, _G, _Module, _Info).
'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$trace_port'(clause, call, _GoalNumber, _G, _Module, _Info).
'$trace_off', '$trace_port'(clause, fail, _GoalNumber, _G, _Module, _Info) :-
fail.
'$trace_port'(clause, Port, GoalNumber, G, Module, Info) :-
!, !,
'$trace_port_'(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_'(call, GoalNumber, G, Module, Info) :- '$trace_port_'(call, GoalNumber, G, Module, Info) :-
'$port'(call,G,Module,GoalNumber,deterministic, Info). '$port'(call,G,Module,GoalNumber,deterministic, Info).
'$trace_port_'(exit, GoalNumber, G, Module, Info) :- '$trace_port_'(exit, GoalNumber, G, Module, Info) :-
nb_setarg(6, Info, true),
'$port'(exit,G,Module,GoalNumber,deterministic, Info). '$port'(exit,G,Module,GoalNumber,deterministic, Info).
'$trace_port_'(answer, GoalNumber, G, Module, Info) :- '$trace_port_'(answer, GoalNumber, G, Module, Info) :-
'$port'(exit,G,Module,GoalNumber,nondeterministic, Info). '$port'(exit,G,Module,GoalNumber,nondeterministic, Info).
'$trace_port_'(redo, GoalNumber, G, Module, Info) :- '$trace_port_'(redo, GoalNumber, G, Module, Info) :-
'$stop_creeping'(_ ),
'$port'(redo,G,Module,GoalNumber,nondeterministic, Info). /* inform user_error */ '$port'(redo,G,Module,GoalNumber,nondeterministic, Info). /* inform user_error */
'$trace_port_'(fail, GoalNumber, G, Module, Info) :- '$trace_port_'(fail, GoalNumber, G, Module, Info) :-
'$stop_creeping'(_ ),
'$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */ '$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */
'$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */ '$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */
!. !.
'$trace_port_'(exception(E), GoalNumber, G, Module, Info) :- '$trace_port_'(exception(E), GoalNumber, G, Module, Info) :-
'$stop_creeping'(_ ),
'$TraceError'(E, GoalNumber, G, Module, Info). '$TraceError'(E, GoalNumber, G, Module, Info).
'$trace_port_'(external_exception(E), GoalNumber, G, Module, Info) :- '$trace_port_'(external_exception(E), GoalNumber, G, Module, Info) :-
'$stop_creeping'(_ ),
'$TraceError'(E, GoalNumber, G, Module, Info). '$TraceError'(E, GoalNumber, G, Module, Info).
@ -731,7 +723,7 @@ be lost.
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_status', state(creep, 0, stop, Trace)). '__NB_setval__'('$debug_status', state(creep, 0, stop, Trace)).
'$action'(!,_,_,_,_,_) :- !, % ! 'g execute '$action'(!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G), read(debugger_input, G),
% don't allow yourself to be caught by creep. % don't allow yourself to be caught by creep.
ignore( G ), ignore( G ),
skip( debugger_input, 10), % ' skip( debugger_input, 10), % '
@ -753,7 +745,6 @@ be lost.
fail. fail.
'$action'(a,_,_,_,_,_) :- !, % 'a abort '$action'(a,_,_,_,_,_) :- !, % 'a abort
skip( debugger_input, 10), skip( debugger_input, 10),
'$stop_creeping'(_),
nodebug, nodebug,
abort. abort.
'$action'(b,_,_,_,_,_) :- !, % 'b break '$action'(b,_,_,_,_,_) :- !, % 'b break

26
pl/signals.yap
View File

@ -295,18 +295,18 @@ read_sig.
% % % %
% make thes predicates non-traceable. % % make thes predicates non-traceable. %
:- '$set_no_trace'(current_choicepoint(_DCP), yap_hacks). :- '$set_private'(current_choicepoint(_DCP), yap_hacks).
:- '$set_no_trace'('$current_choice_point'(_DCP), _). :- '$set_private'('$current_choice_point'(_DCP), _).
:- '$set_no_trace'('$$cut_by'(_DCP), prolog). :- '$set_private'('$$cut_by'(_DCP), prolog).
:- '$set_no_trace'(true, yap_hacks). :- '$set_private'(true, yap_hacks).
:- '$set_no_trace'(true, prolog). :- '$set_private'(true, prolog).
:- '$set_no_trace'('$call'(_,_,_,_), prolog). :- '$set_private'('$call'(_,_,_,_), prolog).
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog). :- '$set_private'('$execute_nonstop'(_,_), prolog).
:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog). :- '$set_private'('$execute_clause'(_,_,_,_), prolog).
:- '$set_no_trace'('$restore_regs'(_,_), prolog). :- '$set_private'('$restore_regs'(_,_), prolog).
:- '$set_no_trace'('$undefp'(_,_), prolog). :- '$set_private'('$undefp'(_,_), prolog).
:- '$set_no_trace'('$Error'(_), prolog). :- '$set_private'('$Error'(_), prolog).
:- '$set_no_trace'('$LoopError'(_,_), prolog). :- '$set_private'('$LoopError'(_,_), prolog).
:- '$set_no_trace'('$TraceError'(_,_,_,_,_), prolog). :- '$set_private'('$TraceError'(_,_,_,_,_), prolog).
%%! @} %%! @}

103
pl/spy.yap
View File

@ -200,13 +200,15 @@ nospyall.
debug :- debug :-
'$init_debugger', '$init_debugger',
( '__NB_getval__'('$spy_gn',_, fail) -> true ; '__NB_setval__'('$spy_gn',1) ), ( '__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)). print_message(informational,debug(debug)).
'$start_debugging'(_Mode) :- '$start_user_code' :-
'__NB_setval__'(debug, false), yap_flag(debug, Can),
'__NB_setval__'(debug, Can),
'__NB_getval__'('$trace',Trace, fail), '__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) ). '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ).
nodebug :- nodebug :-
@ -228,13 +230,10 @@ Switches on the debugger and enters tracing mode.
*/ */
trace :- trace :-
'$init_debugger',
fail.
trace :-
'__NB_setval__'('$trace',on),
'$start_debugging'(on),
print_message(informational,debug(trace)), print_message(informational,debug(trace)),
'$creep'. set_prolog_flag(debug,true),
'__NB_setval__'('$trace',on),
'$init_debugger'.
/** @pred notrace /** @pred notrace
@ -392,16 +391,18 @@ notrace(G) :-
'$enable_debugging'. '$enable_debugging'.
'$init_debugger' :- '$init_debugger' :-
'$init_debugger_trace', '$debugger_io',
'$init_debugger_trace',
'__NB_setval__'('$if_skip_mode',no_skip), '__NB_setval__'('$if_skip_mode',no_skip),
'__NB_setval__'('$spy_glist',[]), '__NB_setval__'('$spy_glist',[]),
'__NB_setval__'('$spy_gn',1). '__NB_setval__'('$spy_gn',1).
'$init_debugger_trace' :- '$init_debugger_trace' :-
'__NB_getval__'('$trace',on,fail), '__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' :- '$init_debugger_trace' :-
'__NB_setval__'('$trace',off),
nb_setval('$debug_status', state(zip, 0, stop, off)). nb_setval('$debug_status', state(zip, 0, stop, off)).
%% @pred $enter_debugging(G,Mod,CP,G0,NG) %% @pred $enter_debugging(G,Mod,CP,G0,NG)
@ -409,14 +410,27 @@ notrace(G) :-
%% Internal predicate called by top-level; %% Internal predicate called by top-level;
%% enable creeping on a goal by just switching execution to debugger. %% 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), '$creepcalls'(G,Mod),
!, !.
'$trace_query'(G,Mod,CP,G0,NG).
'$enter_debugging'(G,_Mod,_CP,_G0,G). '$enter_debugging'(G,_Mod,_CP,_G0,G).
'$enter_debugging'(G,Mod,GN) :- '$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 ), '__NB_set_value__'( debug, Deb ),
( Deb = false ( Deb = false
-> ->
@ -431,7 +445,7 @@ notrace(G) :-
%% we're coming back from external code to a debugger call. %% we're coming back from external code to a debugger call.
%% %%
'$reenter_debugger'(retry) :- '$reenter_debugger'(fail) :-
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$reenter_debugger'(_) :- '$reenter_debugger'(_) :-
'__NB_setval__'(debug, false). '__NB_setval__'(debug, false).
@ -442,10 +456,15 @@ notrace(G) :-
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$continue_debugging'(answer) :- '$continue_debugging'(answer) :-
!, !,
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$continue_debugging'(fail) :- '$continue_debugging'(fail) :-
!, !,
'$re_enter_creep_mode', '$re_enter_creep_mode',
fail.
'$continue_debugging'(redo) :-
!,
'$re_enter_creep_mode',
fail.
'$continue_debugging'(_). '$continue_debugging'(_).
'$enable_debugging' :- '$enable_debugging' :-
@ -458,33 +477,37 @@ notrace(G) :-
%% enable creeping on the next goal. %% enable creeping on the next goal.
%% %%
'$re_enter_creep_mode' :- '$re_enter_creep_mode' :-
!, current_prolog_flag( debug, Deb ),
'$creep'. '__NB_setval__'( debug, Deb ).
'$re_enter_creep_mode'.
'$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) '$pred_being_spied'(G,Module)
-> ->
Spy == ignore Spy == ignore
; ;
var(GN0) var(GN)
-> ->
true false
; ;
GN > GN0 GN > GoalNo
). ).
'$creep_is_on_at_entry'(G,M,_GoalNo) :-
%% \+ '$system_predicate'(G,M),
%
'$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),
'__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail), '__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail),
( (
Step \= zip Step \= zip
@ -496,7 +519,7 @@ notrace(G) :-
'$trace_on' :- '$trace_on' :-
'__NB_getval__'('$debug_status', state(_Creep, GN, Spy,Trace), fail), '__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)). nb_setval('$debug_status', state(creep, GN, Spy, Trace)).
'$trace_off' :- '$trace_off' :-

25
pl/top.yap
View File

@ -93,16 +93,6 @@ live :-
; '$halt'(0) ; '$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' :- '$erase_sets' :-
eraseall($), eraseall($),
@ -587,21 +577,10 @@ write_query_answer( Bindings ) :-
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, CP, G0, M) :- '$user_call'(G, CP, G0, M) :-
gated_call( '$trace_query'(G, M, CP, G0).
'$enable_debugging',
'$call'(G, CP, G0, M),
Port,
'$reenter_debugger'(Port)
).
'$user_call'(G, M) :- '$user_call'(G, M) :-
gated_call( '$trace'(M:G).
'$enable_debugging',
M:G,
Port,
'$reenter_debugger'(Port)
).
'$cut_by'(CP) :- '$$cut_by'(CP). '$cut_by'(CP) :- '$$cut_by'(CP).