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

fix error handling in debugger (first try).

Browse Source 
add extra argument to handle.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@284 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-01-10 18:01:14 +00:00
parent ea45ad8f3d
commit bd28a74d45
4 changed files with 53 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/errors.c
View File

@ -315,6 +315,13 @@ Error (yap_error_number type, Term where, char *format,...)
/* disallow recursive error handling */ /* disallow recursive error handling */
if (PrologMode & InErrorMode) if (PrologMode & InErrorMode)
return(P); return(P);
where = Deref(where);
if (IsVarTerm(where)) {
/* we must be careful someone gave us a copy to a local variable */
Term t = MkVarTerm();
unify(t, where);
where = Deref(where);
}
PrologMode |= InErrorMode; PrologMode |= InErrorMode;
va_start (ap, format); va_start (ap, format);
/* now build the error string */ /* now build the error string */

5
pl/boot.yap
View File

@ -1193,10 +1193,13 @@ throw(Ball) :-
copy_term(Ball,NewBall), copy_term(Ball,NewBall),
% get current jump point % get current jump point
array_element('$catch', 0, Env), array_element('$catch', 0, Env),
'$do_throw'(NewBall, Env).
'$do_throw'(NewBall,Env) :-
% jump % jump
'$jump_env_and_store_ball'(Env, '$ball'(NewBall)). '$jump_env_and_store_ball'(Env, '$ball'(NewBall)).
% restore bindings. % restore bindings.
throw(_). '$do_throw'(_,_).
'$init_catch' :- '$init_catch' :-
'$create_array'('$catch', 1). '$create_array'('$catch', 1).

96
pl/debug.yap
View File

@ -298,9 +298,16 @@ debugging :-
'$trace'(call,G,Module,L), /* inform about call port */ '$trace'(call,G,Module,L), /* inform about call port */
/* the following choice point is where the predicate is called */ /* the following choice point is where the predicate is called */
( '$get_value'(spy_sp,0), /* make sure we are not skipping*/ ( '$get_value'(spy_sp,0), /* make sure we are not skipping*/
'$spycalls'(G,Module,Res) /* go execute the predicate */ '$system_catch'('$spycalls'(G,Module,Res), Module,
Error,
prolog:'$DebugError'(Error))
/* go execute the predicate */
; /* we get here when the predicate fails */ ; /* we get here when the predicate fails */
'$trace'(fail,G,Module,L), /* inform at fail port */ ( '$get_value'(spy_sl, -1) ->
'$trace'(exception,G,Module,L)
;
'$trace'(fail,G,Module,L) /* inform at fail port */
),
'$get_value'(spy_sl,L2),/* make sure we are not ... */ '$get_value'(spy_sl,L2),/* make sure we are not ... */
L2 \= L, /* ... skiping to this level */ L2 \= L, /* ... skiping to this level */
!, /* if not prepare to exit spy */ !, /* if not prepare to exit spy */
@ -372,7 +379,7 @@ debugging :-
'$flags'(G,M,F,_), '$flags'(G,M,F,_),
F /\ 0xc00000 =:= 0, % but not meta-predicate or cut transparent F /\ 0xc00000 =:= 0, % but not meta-predicate or cut transparent
!, !,
'$catch_spycall_stdpred'(G,M), '$spycall_stdpred'(G,M),
(true; (true;
'$get_value'(spy_sp,P), P \= 0, !, fail), '$get_value'(spy_sp,P), P \= 0, !, fail),
( true; ( true;
@ -438,32 +445,29 @@ debugging :-
'$access_yap_flags'(10,0), '$access_yap_flags'(10,0),
!, !,
'$setflop'(0), '$setflop'(0),
'$call_clause'(G,M,Cl). '$do_execute_clause'(G,M,Cl).
'$spycall'(G,M,Cl) :- '$spycall'(G,M,Cl) :-
'$setflop'(0), '$setflop'(0),
'$creepcallclause'(G,M,Cl). '$do_creep_execute'(G,M,Cl).
'$log_upd_spycall'(G,M,Cl,Index) :- '$log_upd_spycall'(G,M,Cl,Index) :-
'$access_yap_flags'(10,0), '$access_yap_flags'(10,0),
!, !,
'$setflop'(0), '$setflop'(0),
'$call_log_updclause'(G,M,Cl,Index). '$do_execute_log_upd_clause'(G,M,Cl,Index).
'$log_upd_spycall'(G,M,Cl,Index) :- '$log_upd_spycall'(G,M,Cl,Index) :-
'$setflop'(0), '$setflop'(0),
'$creepcall_log_upd_clause'(G,M,Cl,Index). '$do_execute_log_upd_clause'(G,M,Cl,Index).
% this is to be used only for dynamic predicates % this is to be used only for dynamic predicates
'$spycall_dynamic'(G,M,Cl) :- '$spycall_dynamic'(G,M,Cl) :-
'$access_yap_flags'(10,0), '$access_yap_flags'(10,0),
!, !,
'$setflop'(0), '$setflop'(0),
'$call_dynamic_clause'(G,M,Cl). '$do_execute_dynamic_clause'(G,M,Cl).
'$spycall_dynamic'(G,M,Cl) :- '$spycall_dynamic'(G,M,Cl) :-
'$setflop'(0), '$setflop'(0),
'$creepcall_dynamic_clause'(G,M,Cl). '$do_creep_execute_dynamic'(G,M,Cl).
'$catch_spycall_stdpred'(G,M) :-
'$system_catch'('$spycall_stdpred'(G,M), M, Error, user:'$DebugError'(Error)).
'$spycall_stdpred'(G,M) :- '$spycall_stdpred'(G,M) :-
functor(G,F,N), functor(G,F,N),
@ -479,9 +483,6 @@ debugging :-
'$setflop'(0). '$setflop'(0).
'$call_clause'(G,M,Cl) :-
'$system_catch'('$do_execute_clause'(G,M,Cl),M,Error,user:'$DebugError'(Error)).
'$do_execute_clause'(G,M,Cl) :- '$do_execute_clause'(G,M,Cl) :-
'$some_recordedp'(M:G), !, '$some_recordedp'(M:G), !,
'$check_depth_for_interpreter'(D), '$check_depth_for_interpreter'(D),
@ -489,16 +490,13 @@ debugging :-
CP is '$last_choice_pt', CP is '$last_choice_pt',
( (
'$fetch_clause'(G,M,Cl,Clause), '$fetch_clause'(G,M,Cl,Clause),
(Clause = true -> true ; '$debug_catch_call'(Clause,M,CP) ) (Clause = true -> true ; '$call'(Clause,M,CP) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
). ).
'$do_execute_clause'(G,M,Cl) :- '$do_execute_clause'(G,M,Cl) :-
'$execute'(G,M,Cl) ; Next is Cl+1, '$set_value'(spy_cl,Next), fail. '$execute'(G,M,Cl) ; Next is Cl+1, '$set_value'(spy_cl,Next), fail.
'$call_log_updclause'(G,M,Cl,Index) :-
'$system_catch'('$do_execute_log_upd_clause'(G,M,Cl,Index),M,Error,user:'$DebugError'(Error)).
'$do_execute_log_upd_clause'(G,M,Cl,Index) :- '$do_execute_log_upd_clause'(G,M,Cl,Index) :-
'$check_depth_for_interpreter'(D), '$check_depth_for_interpreter'(D),
('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)),
@ -513,7 +511,7 @@ debugging :-
'$fetch_reference_from_index'(Index, Cl1, Ref), '$fetch_reference_from_index'(Index, Cl1, Ref),
instance(Ref, (G :- Clause)) instance(Ref, (G :- Clause))
), ),
(Clause = true -> true ; '$debug_catch_call'(Clause,M,CP) ) (Clause = true -> true ; '$call'(Clause,M,CP) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
). ).
@ -525,12 +523,6 @@ debugging :-
D0 =\= 0, D0 =\= 0,
D1 is D0-1. D1 is D0-1.
'$debug_catch_call'(Clause,M,CP) :-
'$system_catch'('$call'(Clause,CP,Clause,M),M,Error,user:'$DebugError'(Error)).
'$call_dynamic_clause'(G,M,Cl) :-
'$system_catch'('$do_execute_dynamic_clause'(G,M,Cl),M,Error,user:'$DebugError'(Error)).
'$do_execute_dynamic_clause'(G,M,Cl) :- '$do_execute_dynamic_clause'(G,M,Cl) :-
'$check_depth_for_interpreter'(D), '$check_depth_for_interpreter'(D),
('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)),
@ -538,14 +530,11 @@ debugging :-
( (
'$db_nb_to_ref'(Cl,M:G,Ref), '$db_nb_to_ref'(Cl,M:G,Ref),
instance(Ref, (G :- Clause)), instance(Ref, (G :- Clause)),
(Clause = true -> true ; '$debug_catch_call'(Clause,M,CP) ) (Clause = true -> true ; '$call'(Clause,M,CP) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
). ).
'$creepcallclause'(G,M,Cl) :-
'$system_catch'('$do_creep_execute'(G,M,Cl),M,Error,user:'$DebugError'(Error)).
'$do_creep_execute'(G,M,Cl) :- '$do_creep_execute'(G,M,Cl) :-
% fast skip should ignore source mode % fast skip should ignore source mode
'$get_value'(spy_fs,0), '$get_value'(spy_fs,0),
@ -557,7 +546,7 @@ debugging :-
( (
'$fetch_clause'(G,M,Cl,Clause), '$fetch_clause'(G,M,Cl,Clause),
(Clause = true -> true ; (Clause = true -> true ;
'$catch_creep_call'(Clause,M,CP) '$creep_call'(Clause,M,CP)
) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
@ -566,9 +555,6 @@ debugging :-
'$creep_execute'(G,M,Cl) ; '$creep_execute'(G,M,Cl) ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail. Next is Cl+1, '$set_value'(spy_cl,Next), fail.
'$creepcall_log_upd_clause'(G,M,Cl,Index) :-
'$system_catch'('$do_creep_log_upd_execute'(G,M,Cl,Index),M,Error,user:'$DebugError'(Error)).
'$do_creep_log_upd_execute'(G,M,Cl,Index) :- '$do_creep_log_upd_execute'(G,M,Cl,Index) :-
'$check_depth_for_interpreter'(D), '$check_depth_for_interpreter'(D),
('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)),
@ -584,19 +570,13 @@ debugging :-
), ),
(Clause = true -> true ; (Clause = true -> true ;
% otherwise fast skip may try to interpret assembly builtins. % otherwise fast skip may try to interpret assembly builtins.
'$get_value'(spy_fs,1) -> '$debug_catch_call'(Clause,M,CP) ; '$get_value'(spy_fs,1) -> '$call'(Clause,M,CP) ;
'$catch_creep_call'(Clause,M,CP) '$creep_call'(Clause,M,CP)
) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
). ).
'$catch_creep_call'(Clause,M,CP) :-
'$system_catch'('$creep_call'(Clause,M,CP),M,Error,user:'$DebugError'(Error)).
'$creepcall_dynamic_clause'(G,M,Cl) :-
'$system_catch'('$do_creep_execute_dynamic'(G,M,Cl),M,Error,user:'$DebugError'(Error)).
'$do_creep_execute_dynamic'(G,M,Cl) :- '$do_creep_execute_dynamic'(G,M,Cl) :-
'$check_depth_for_interpreter'(D), '$check_depth_for_interpreter'(D),
('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)),
@ -606,8 +586,8 @@ debugging :-
instance(Ref, (G :- Clause)), instance(Ref, (G :- Clause)),
(Clause = true -> true ; (Clause = true -> true ;
% otherwise fast skip may try to interpret assembly builtins. % otherwise fast skip may try to interpret assembly builtins.
'$get_value'(spy_fs,1) -> '$debug_catch_call'(Clause,M,CP) ; '$get_value'(spy_fs,1) -> '$call'(Clause,M,CP) ;
'$catch_creep_call'(Clause,M,CP) '$creep_call'(Clause,M,CP)
) )
; ;
Next is Cl+1, '$set_value'(spy_cl,Next), fail Next is Cl+1, '$set_value'(spy_cl,Next), fail
@ -796,19 +776,13 @@ debugging :-
'$unleashed'(exit) :- '$get_value'('$leash',L), L /\ 2'0100 =:= 0. '$unleashed'(exit) :- '$get_value'('$leash',L), L /\ 2'0100 =:= 0.
'$unleashed'(redo) :- '$get_value'('$leash',L), L /\ 2'0010 =:= 0. '$unleashed'(redo) :- '$get_value'('$leash',L), L /\ 2'0010 =:= 0.
'$unleashed'(fail) :- '$get_value'('$leash',L), L /\ 2'0001 =:= 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.
'$debugger_write'(Stream, G) :- '$debugger_write'(Stream, G) :-
'$recorded'('$debug_depth',D,_), !,
write_depth(OS,OL),
write_depth(D,D),
'$write_deb2'(Stream,G),
write_depth(OS,OL).
'$debugger_write'(Stream,G) :- '$write_deb2'(Stream,G).
'$write_deb2'(Stream, G) :-
'$recorded'('$print_options','$debugger'(OUT),_), !, '$recorded'('$print_options','$debugger'(OUT),_), !,
write_term(Stream, G, OUT). write_term(Stream, G, OUT).
'$write_deb2'(Stream, G) :- '$debugger_write'(Stream, G) :-
writeq(Stream, G). writeq(Stream, G).
/* /*
@ -992,15 +966,15 @@ debugging :-
'$delete_if_there'([Q|L], T, [Q|LN]) :- '$delete_if_there'([Q|L], T, [Q|LN]) :-
'$delete_if_there'(L, T, LN). '$delete_if_there'(L, T, LN).
'$DebugError'(error(Msg, Where )) :- !, %
'$output_error_message'(Msg, Where), !, % catch errors
%
'$DebugError'(error(Msg,Error)) :- !,
'$LoopError'(error(Msg,Error)),
fail. fail.
% % allow abort and user defined exceptions to go through.
% do not try to handle other throws or aborts. '$DebugError'(Ball) :- !,
% throw(Ball).
'$DebugError'(T) :- !,
'$trace'(exception,T),
throw(T).
'$init_spy_cl'(G,M) :- '$init_spy_cl'(G,M) :-
% dynamic, immediate update procedure. % dynamic, immediate update procedure.

8
pl/utils.yap
View File

@ -333,7 +333,9 @@ system_predicate(A,P) :-
'$current_predicate_no_modules'(prolog,A,P), '$current_predicate_no_modules'(prolog,A,P),
\+ '$hidden'(A). \+ '$hidden'(A).
system_predicate(P) :- '$system_predicate'(P). system_predicate(P) :-
'$current_module'(M),
'$system_predicate'(P,M).
'$current_predicate_no_modules'(M,A,T) :- '$current_predicate_no_modules'(M,A,T) :-
'$current_predicate'(M,A,Arity), '$current_predicate'(M,A,Arity),
@ -519,8 +521,8 @@ predicate_property(Pred,Prop) :-
'$predicate_property'(Pred,Mod,Prop), '$predicate_property'(Pred,Mod,Prop),
'$pred_exists'(Pred,Mod). '$pred_exists'(Pred,Mod).
'$predicate_property'(P,_,built_in) :- '$predicate_property'(P,M,built_in) :-
'$system_predicate'(P), !. '$system_predicate'(P,M), !.
'$predicate_property'(P,M,dynamic) :- '$predicate_property'(P,M,dynamic) :-
'$is_dynamic'(P,M). '$is_dynamic'(P,M).
'$predicate_property'(P,M,static) :- '$predicate_property'(P,M,static) :-