From 6046f9f9133813f47fa1543ff414e5f6a09383ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 2 Sep 2008 03:48:02 +0100 Subject: [PATCH] more fixes to debugger: make l and s option do what they are supposed to do. fix k and t, they had been broken. Ideas: DebugOn is now in the system and can disable spypoints. Have an extra flag to distinguish fast (t,z,k) and slow(l,s) jumping. --- C/absmi.c | 12 +++- C/cdmgr.c | 8 +-- C/exec.c | 32 ++++++++++- C/tracer.c | 4 ++ H/Heap.h | 2 + pl/boot.yap | 11 ++-- pl/debug.yap | 143 ++++++++++++++++++++++++++-------------------- pl/directives.yap | 11 +++- pl/signals.yap | 2 +- 9 files changed, 147 insertions(+), 78 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 302bf0257..1fbc3a572 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -2691,8 +2691,8 @@ Yap_absmi(int inp) don't do a creep here; also, if our instruction is followed by a execute_c, just wait a bit more */ if (ActiveSignals & YAP_CREEP_SIGNAL && - Yap_op_from_opcode(PREG->opc) != Yap_opcode(_procceed) && - Yap_op_from_opcode(PREG->opc) != Yap_opcode(_cut_e)) { + PREG->opc != Yap_opcode(_procceed) && + PREG->opc != Yap_opcode(_cut_e)) { GONext(); } PP = PREG->u.p.p; @@ -7975,7 +7975,13 @@ Yap_absmi(int inp) /* IPred can generate errors, it thus must get rid of the lock itself */ setregs(); } + if (!DebugOn) { + PREG = pe->cs.p_code.TrueCodeOfPred; + UNLOCK(pe->PELock); + JMPNext(); + } UNLOCK(pe->PELock); + d0 = pe->ArityOfPE; /* save S for ModuleName */ if (d0 == 0) { @@ -9450,6 +9456,7 @@ Yap_absmi(int inp) #ifdef TABLING abolish_incomplete_subgoals(B); #endif /* TABLING */ + PREG = NEXTOP(PREG, xl); goto trim_trail; } PREG = NEXTOP(PREG, xl); @@ -9508,6 +9515,7 @@ Yap_absmi(int inp) #ifdef TABLING abolish_incomplete_subgoals(B); #endif /* TABLING */ + PREG = NEXTOP(PREG, xl); goto trim_trail; } PREG = NEXTOP(PREG, yl); diff --git a/C/cdmgr.c b/C/cdmgr.c index ae9180113..a5f2bc3cb 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -5008,7 +5008,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya } } else { Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 7, YENV, gc_P(P,CP))) { + if (!Yap_gcl(Yap_Error_Size, 7, ENV, gc_P(P,CP))) { UNLOCK(pe->PELock); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; @@ -5150,7 +5150,7 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term } } else { Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 7, YENV, gc_P(P,CP))) { + if (!Yap_gcl(Yap_Error_Size, 7, ENV, gc_P(P,CP))) { UNLOCK(pe->PELock); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; @@ -5276,7 +5276,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ } } else { Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(Yap_Error_Size, 4, YENV, gc_P(P,CP))) { + if (!Yap_gcl(Yap_Error_Size, 4, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; } @@ -5590,7 +5590,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr ARG5 = th; ARG6 = tb; ARG7 = tr; - if (!Yap_gc(7, YENV, gc_P(P,CP))) { + if (!Yap_gc(7, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; } diff --git a/C/exec.c b/C/exec.c index 30335a1f0..1ba47f3e9 100644 --- a/C/exec.c +++ b/C/exec.c @@ -2054,7 +2054,36 @@ p_uncaught_throw(void) static Int p_creep_allowed(void) { - return (PP != NULL); + if (PP != NULL) { + LOCK(SignalLock); + if (ActiveSignals & YAP_CREEP_SIGNAL) { + ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (!ActiveSignals) + CreepFlag = CalculateStackGap(); + UNLOCK(SignalLock); + } else { + UNLOCK(SignalLock); + } + return TRUE; + } + return FALSE; +} + +static Int +p_debug_on(void) +{ + Term t = Deref(ARG1); + if (IsVarTerm(t)) { + if (DebugOn) + return Yap_unify(MkAtomTerm(AtomTrue),ARG1); + else + return Yap_unify(MkAtomTerm(AtomFalse),ARG1); + } + if (t == MkAtomTerm(AtomTrue)) + DebugOn = TRUE; + else + DebugOn = FALSE; + return TRUE; } void @@ -2087,6 +2116,7 @@ Yap_InitExecFs(void) Yap_InitCPred("$call_with_args", 10, p_execute_8, HiddenPredFlag); Yap_InitCPred("$call_with_args", 11, p_execute_9, HiddenPredFlag); Yap_InitCPred("$call_with_args", 12, p_execute_10, HiddenPredFlag); + Yap_InitCPred("$debug_on", 1, p_debug_on, HiddenPredFlag); #ifdef DEPTH_LIMIT Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, HiddenPredFlag); #endif diff --git a/C/tracer.c b/C/tracer.c index a0496a460..6ce81cbe3 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -164,6 +164,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; + if (vsc_count < 88000) + return; + if (vsc_count == 88483LL) + jmp_deb(1); #ifdef THREADS Yap_heap_regs->thread_handle[worker_id].thread_inst_count++; #endif diff --git a/H/Heap.h b/H/Heap.h index d5bea8205..e15c1559c 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -117,6 +117,7 @@ typedef struct worker_local_struct { union CONSULT_OBJ *consultsp; union CONSULT_OBJ *consultbase; union CONSULT_OBJ *consultlow; + int debug_on; UInt consultcapacity; UInt active_signals; UInt i_pred_arity; @@ -932,6 +933,7 @@ extern struct various_codes *Yap_heap_regs; #define ConsultLow Yap_heap_regs->WL.consultlow /* current maximum number of cells in consult stack */ #define ConsultCapacity Yap_heap_regs->WL.consultcapacity +#define DebugOn Yap_heap_regs->WL.debug_on #define FormatInfo Yap_heap_regs->WL.f_info #define ScannerStack Yap_heap_regs->WL.scanner_stack #define ScannerExtraBlocks Yap_heap_regs->WL.scanner_extra_blocks diff --git a/pl/boot.yap b/pl/boot.yap index a9b769144..91f0be98c 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -74,7 +74,7 @@ true :- true. nb_setval('$break',0), % '$set_read_error_handler'(error), let the user do that nb_setval('$open_expands_filename',true), - nb_setval('$debug',off), + '$debug_on'(false), nb_setval('$trace',off), b_setval('$spy_glist',[]), % simple trick to find out if this is we are booting from Prolog. @@ -142,12 +142,13 @@ true :- true. fail. '$enter_top_level' :- nb_getval('$break',BreakLevel), + '$debug_on'(DBON), ( nb_getval('$trace',on) -> TraceDebug = trace ; - nb_getval('$debug', on) + DBON == true -> TraceDebug = debug ; @@ -933,8 +934,8 @@ not(G) :- \+ '$execute'(G). break :- nb_getval('$trace',Trace), nb_setval('$trace',off), - nb_getval('$debug',Debug), - nb_setval('$debug',off), + '$debug_on'(Debug), + '$debug_on'(false), nb_getval('$break',BL), NBL is BL+1, nb_getval('$spy_gn',SPY_GN), b_getval('$spy_glist',GList), @@ -948,7 +949,7 @@ break :- b_setval('$spy_glist',GList), nb_setval('$spy_gn',SPY_GN), '$set_input'(InpStream), '$set_output'(OutStream), - nb_setval('$debug',Debug), + '$debug_on'(Debug), nb_setval('$trace',Trace), nb_setval('$break',BL). diff --git a/pl/debug.yap b/pl/debug.yap index 338f79607..8acfdf391 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -149,11 +149,16 @@ debug :- print_message(informational,debug(debug)). '$start_debugging'(Mode) :- - nb_setval('$debug',Mode), - nb_setval('$debug_run',off). + (Mode == on -> + '$debug_on'(true) + ; + '$debug_on'(false) + ), + nb_setval('$debug_run',off), + nb_setval('$debug_jump',false). nodebug :- - nb_setval('$debug',off), + '$debug_on'(false), nb_setval('$trace',off), print_message(informational,debug(off)). @@ -231,7 +236,7 @@ leash(X) :- debugging :- prolog:debug_action_hook(nospyall), !. debugging :- - ( nb_getval('$debug',on) -> + ( '$debug_on'(true) -> print_message(help,debug(debug)) ; print_message(help,debug(off)) @@ -274,7 +279,7 @@ debugging :- % % $spy may be called from user code, so be careful. '$spy'([Mod|G]) :- - nb_getval('$debug',off), !, + '$debug_on'(F), F = false, !, '$execute'(G,Mod). '$spy'([Mod|G]) :- nb_getval('$system_mode',on), !, @@ -453,10 +458,9 @@ debugging :- % '$spycall'(G, M, _, _) :- - nb_getval('$debug_run',StopPoint), - StopPoint \= off, + nb_getval('$debug_jump',true), !, - '$execute'(M:G). + '$execute_nonstop'(G,M). '$spycall'(G, M, _, _) :- '$system_predicate'(G,M), \+ '$is_metapredicate'(G,M), @@ -502,7 +506,7 @@ debugging :- % at this point we are done with leap or skip nb_setval('$debug_run',off), % make sure we run this code outside debugging mode. - nb_setval('$debug', off), + '$debug_on'(false), repeat, '$trace_msg'(P,G,Module,L,Deterministic), ( @@ -512,8 +516,17 @@ debugging :- ; write(user_error,' ? '), get0(user_input,C), '$action'(C,P,L,G,Module,Debug) - ), - nb_setval('$debug', Debug), + ), + (Debug = on + -> + '$debug_on'(true) + ; + Debug = zip + -> + '$debug_on'(true) + ; + '$debug_on'(false) + ), !. '$trace_msg'(P,G,Module,L,Deterministic) :- @@ -532,12 +545,12 @@ debugging :- ), '$debugger_write'(user_error,G). -'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. -'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. -'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. -'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. +'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. %' +'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. %' +'$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'0001 =:= 0. %' '$debugger_write'(Stream, G) :- recorded('$print_options','$debugger'(OUT),_), !, @@ -546,51 +559,51 @@ debugging :- writeq(Stream, G). '$action'(10,_,_,_,_,on). % newline creep -'$action'(0'!,_,_,_,_,_) :- !, % ! g execute +'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute read(user,G), % don't allow yourself to be caught by creep. - nb_getval('$debug',OldDeb), - nb_setval('$debug',off), + '$debug_on'(OldDeb), + '$debug_on'(false), ( '$execute'(G) -> true ; true), - nb_setval('$debug',OldDeb), -% '$skipeol'(0'!), + '$debug_on'(OldDeb), +% '$skipeol'(0'!), % ' fail. -'$action'(0'<,_,_,_,_,_) :- !, % print(user_error,G), nl(user_error) ; @@ -598,7 +611,7 @@ debugging :- ), '$skipeol'(0'p), fail. -'$action'(0'd,_,_,G,Module,_) :- !, % d display +'$action'(0'd,_,_,G,Module,_) :- !, % 'd display ((Module = prolog ; Module = user) -> display(user_error,G), nl(user_error) ; @@ -606,52 +619,58 @@ debugging :- ), '$skipeol'(0'd), fail. -'$action'(0'l,_,_,_,_,on) :- !, % l leap +'$action'(0'l,_,_,_,_,on) :- !, % 'l leap '$skipeol'(0'l), - nb_setval('$debug_run',spy). -'$action'(0'z,_,_,_,_,zip) :- !, % k zip, fast leap - '$skipeol'(0'z), - nb_setval('$debug_run',spy). + nb_setval('$debug_run',spy), + nb_setval('$debug_jump',false). +'$action'(0'z,_,_,_,_,zip) :- !, % 'z zip, fast leap + '$skipeol'(0'z), % 'z + nb_setval('$debug_run',spy), + nb_setval('$debug_jump',true). % skip first call (for current goal), % stop next time. -'$action'(0'k,_,_,_,_,zip) :- !, % k zip, fast leap - '$skipeol'(0'k), - nb_setval('$debug_run',spy). +'$action'(0'k,_,_,_,_,zip) :- !, % 'k zip, fast leap + '$skipeol'(0'k), % ' + nb_setval('$debug_run',spy), + nb_setval('$debug_jump',true). % skip first call (for current goal), % stop next time. -'$action'(0'n,_,_,_,_,off) :- !, % n nodebug - '$skipeol'(0'n), +'$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug + '$skipeol'(0'n), % ' % tell debugger never to stop. nb_setval('$debug_run', -1), + nb_setval('$debug_jump',true), nodebug. -'$action'(0'r,_,CallId,_,_,_) :- !, % r retry - '$scan_number'(0'r,CallId,ScanNumber), - nb_setval('$debug',on), +'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry + '$scan_number'(0'r,CallId,ScanNumber), % ' + '$debug_on'(true), throw('$retry_spy'(ScanNumber)). -'$action'(0's,P,CallNumber,_,_,on) :- !, % s skip - '$skipeol'(0's), +'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip + '$skipeol'(0's), % ' ( (P=call; P=redo) -> - nb_setval('$debug_run',CallNumber) + nb_setval('$debug_run',CallNumber), + nb_setval('$debug_jump',false) ; - '$ilgl'(0's) + '$ilgl'(0's) % ' ). -'$action'(0't,P,CallNumber,_,_,zip) :- !, % t fast skip - '$skipeol'(0't), +'$action'(0't,P,CallNumber,_,_,zip) :- !, % 't fast skip + '$skipeol'(0't), % ' ( (P=call; P=redo) -> - nb_setval('$debug_run',CallNumber) + nb_setval('$debug_run',CallNumber), + nb_setval('$debug_jump',true) ; - '$ilgl'(0't) + '$ilgl'(0't) % ' ). -'$action'(0'+,_,_,G,M,_) :- !, % + spy this +'$action'(0'+,_,_,G,M,_) :- !, % '+ spy this functor(G,F,N), spy(M:(F/N)), - '$skipeol'(0'+), + '$skipeol'(0'+), % ' fail. -'$action'(0'-,_,_,G,M,_) :- !, % - nospy this +'$action'(0'-,_,_,G,M,_) :- !, % '- nospy this functor(G,F,N), nospy(M:(F/N)), - '$skipeol'(0'-), + '$skipeol'(0'-), % ' fail. -'$action'(0'g,_,_,_,_,_) :- !, % g ancestors - '$scan_number'(0'g,-1,HowMany), +'$action'(0'g,_,_,_,_,_) :- !, % 'g ancestors + '$scan_number'(0'g,-1,HowMany), % ' '$show_ancestors'(HowMany), fail. '$action'(C,_,_,_,_,_) :- @@ -746,10 +765,10 @@ debugging :- '$scan_number'(_, CallId, CallId). '$scan_number2'(10, _) :- !, fail. -'$scan_number2'(0' , Nb) :- !, +'$scan_number2'(0' , Nb) :- !, % ' get0(user,C), '$scan_number2'(C , Nb). -'$scan_number2'(0' , Nb) :- !, +'$scan_number2'(0' , Nb) :- !, %' get0(user,C), '$scan_number2'(C, Nb). '$scan_number2'(C, Nb) :- diff --git a/pl/directives.yap b/pl/directives.yap index 2b3c2e01e..3e2555488 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -376,7 +376,7 @@ yap_flag(version_data,X) :- '$get_version_codes'(Major,Minor,Patch) :- get_value('$version_name',X), - atom_codes(X,[0'Y,0'a,0'p,0'-|VersionTag]), + atom_codes(X,[0'Y,0'a,0'p,0'-|VersionTag]), %' '$fetch_num_code'(VersionTag,0,Major,L1), '$fetch_num_code'(L1,0,Minor,L2), '$fetch_num_code'(L2,0,Patch,[]). @@ -384,7 +384,7 @@ yap_flag(version_data,X) :- '$fetch_num_code'([],Code,Code,[]). '$fetch_num_code'([C|Cs],Code0,CodeF,L) :- C >= 0'0, C =< 0'9, !, - CodeI is Code0*10+(C-0'0), + CodeI is Code0*10+(C-0'0), %' '$fetch_num_code'(Cs,CodeI,CodeF,L). '$fetch_num_code'([_|Cs],Code,Code,Cs). @@ -547,7 +547,12 @@ yap_flag(language,X) :- yap_flag(debug,X) :- var(X), !, - nb_getval('$debug',X). + ('$debug_on'(true) + -> + X = on + ; + X = true + ). yap_flag(debug,X) :- '$transl_to_on_off'(_,X), !, (X = on -> debug ; nodebug). diff --git a/pl/signals.yap b/pl/signals.yap index 2821fcb51..cbc5ac923 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -89,7 +89,7 @@ % do not debug if we are not in debug mode. '$start_creep'([Mod|G]) :- - nb_getval('$debug',off), !, + '$debug_on'(DBON), DBON = false, !, '$execute_nonstop'(G,Mod). '$start_creep'([Mod|G]) :- nb_getval('$system_mode',on), !,