[m-rev.] for review: exception events for ssdebug
Peter Wang
novalazy at gmail.com
Tue Jun 1 11:22:37 AEST 2010
Branches: main, 10.04
Add a form of exception events in the source-to-source debugger for Java
grades. This could be implemented for other backends later.
Unlike in mdb, where throwing an exception will generate EXCP events for all
calls on the stack up to enclosing exception handler, we only generate a single
EXCP event for the call to `exception.throw_impl'. The next event will be the
EXIT of the procedure which caught the exception, i.e. exception.try*.
library/exception.m:
Add hooks in the Java implementations of throw_impl and catch_impl.
These do nothing until overridden by ssdb.m.
Replace an unused mode of catch_impl by a stub.
ssdb/ssdb.m:
Install the hooks in the exception module.
When exception.throw_impl is called, emulate an exception event.
Remember the CSN at the start of a call to exception.catch_impl.
When an exception is caught, pop off any shadow stack frames between
the throw and the catch.
Add an `exception' command that stops at the next exception event.
Make the `finish' command handle exceptions. When an exception is
thrown, stop immediately unless we know that further up the stack is an
exception handler which will handle the exception before we reach the
final port that we wish to stop at.
diff --git a/library/exception.m b/library/exception.m
index d33cdd0..d83ad5a 100644
--- a/library/exception.m
+++ b/library/exception.m
@@ -1641,82 +1641,100 @@ call_handler(Handler, Exception, Result) :- Handler(Exception, Result).
:- pragma foreign_export("Java", call_handler(pred(in, out) is det, in, out),
"ML_call_handler_det").
+:- pragma foreign_code("Java", "
+/*
+ * The ssdb module may supply its implementation of these methods at runtime.
+ */
+public static class SsdbHooks {
+ public void on_throw_impl(univ.Univ_0 univ) {}
+ public int on_catch_impl() { return 0; }
+ public void on_catch_impl_exception(int CSN) {}
+}
+
+public static SsdbHooks ssdb_hooks;
+static {
+ if (ssdb_hooks == null) {
+ ssdb_hooks = new SsdbHooks();
+ }
+}
+").
+
:- pragma foreign_proc("Java",
throw_impl(T::in),
- [will_not_call_mercury, promise_pure],
+ [may_call_mercury, promise_pure],
"
+ exception.ssdb_hooks.on_throw_impl(T);
throw new jmercury.runtime.Exception(T);
").
:- pragma foreign_proc("Java",
catch_impl(Pred::pred(out) is det, Handler::in(handler), T::out),
- [will_not_call_mercury, promise_pure],
+ [may_call_mercury, promise_pure],
"
+ int CSN = ssdb_hooks.on_catch_impl();
try {
- T = exception.ML_call_goal_det(TypeInfo_for_T, (Object[]) Pred);
+ T = exception.ML_call_goal_det(TypeInfo_for_T, Pred);
}
catch (jmercury.runtime.Exception ex) {
- T = exception.ML_call_handler_det(TypeInfo_for_T, (Object[]) Handler,
+ exception.ssdb_hooks.on_catch_impl_exception(CSN);
+ T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
(univ.Univ_0) ex.exception);
}
").
+
:- pragma foreign_proc("Java",
- catch_impl(Pred::pred(out) is semidet, Handler::in(handler), T::out),
+ catch_impl(_Pred::pred(out) is semidet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure, may_not_duplicate],
"
- try {
- jmercury.runtime.Ref<Object> ref =
- new jmercury.runtime.Ref<Object>();
- SUCCESS_INDICATOR = exception.ML_call_goal_semidet(TypeInfo_for_T,
- (Object[]) Pred, ref);
- T = ref.val;
- }
- catch (jmercury.runtime.Exception ex) {
- T = exception.ML_call_handler_det(TypeInfo_for_T, (Object[]) Handler,
- (univ.Univ_0) ex.exception);
- SUCCESS_INDICATOR = true;
+ // This predicate isn't called anywhere.
+ if (1 == 1) {
+ throw new java.lang.Error(
+ ""catch_impl (semidet) not yet implemented"");
}
+ T = null;
+ SUCCESS_INDICATOR = false;
").
+
:- pragma foreign_proc("Java",
catch_impl(Pred::pred(out) is cc_multi, Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
+ int CSN = ssdb_hooks.on_catch_impl();
try {
- T = exception.ML_call_goal_det(TypeInfo_for_T, (Object[]) Pred);
+ T = exception.ML_call_goal_det(TypeInfo_for_T, Pred);
}
catch (jmercury.runtime.Exception ex) {
- T = exception.ML_call_handler_det(TypeInfo_for_T, (Object[]) Handler,
+ exception.ssdb_hooks.on_catch_impl_exception(CSN);
+ T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
(univ.Univ_0) ex.exception);
}
").
+
:- pragma foreign_proc("Java",
catch_impl(_Pred::pred(out) is cc_nondet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
// This predicate isn't called anywhere.
- // The shenanigans with `if (always)' are to avoid errors from
- // the Java compiler about unreachable code.
- boolean always = true;
- if (always) {
+ if (1 == 1) {
throw new java.lang.Error(
""catch_impl (cc_nondet) not yet implemented"");
}
T = null;
SUCCESS_INDICATOR = false;
").
+
:- pragma foreign_proc("Java",
- catch_impl(Pred0::pred(out) is multi, Handler0::in(handler), _T::out),
+ catch_impl(Pred::pred(out) is multi, Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
"
- Object[] Pred = (Object[]) Pred0;
- Object[] Handler = (Object[]) Handler0;
-
+ int CSN = ssdb_hooks.on_catch_impl();
try {
jmercury.runtime.MethodPtr3 pred =
(jmercury.runtime.MethodPtr3) Pred[1];
pred.call___0_0(Pred, cont, cont_env_ptr);
}
catch (jmercury.runtime.Exception ex) {
+ ssdb_hooks.on_catch_impl_exception(CSN);
Object T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
(univ.Univ_0) ex.exception);
((jmercury.runtime.MethodPtr2) cont).call___0_0(T, cont_env_ptr);
@@ -1725,19 +1743,19 @@ call_handler(Handler, Exception, Result) :- Handler(Exception, Result).
// Not really used.
SUCCESS_INDICATOR = false;
").
+
:- pragma foreign_proc("Java",
- catch_impl(Pred0::pred(out) is nondet, Handler0::in(handler), _T::out),
+ catch_impl(Pred::pred(out) is nondet, Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
"
- Object[] Pred = (Object[]) Pred0;
- Object[] Handler = (Object[]) Handler0;
-
+ int CSN = ssdb_hooks.on_catch_impl();
try {
jmercury.runtime.MethodPtr3 pred =
(jmercury.runtime.MethodPtr3) Pred[1];
pred.call___0_0(Pred, cont, cont_env_ptr);
}
catch (jmercury.runtime.Exception ex) {
+ ssdb_hooks.on_catch_impl_exception(CSN);
Object T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
(univ.Univ_0) ex.exception);
((jmercury.runtime.MethodPtr2) cont).call___0_0(T, cont_env_ptr);
diff --git a/ssdb/ssdb.m b/ssdb/ssdb.m
index 98074ef..65f9d1e 100755
--- a/ssdb/ssdb.m
+++ b/ssdb/ssdb.m
@@ -35,7 +35,8 @@
; ssdb_call_nondet
; ssdb_exit_nondet
; ssdb_redo_nondet
- ; ssdb_fail_nondet.
+ ; ssdb_fail_nondet
+ ; ssdb_excp.
% Type to determine if it is necessary to do a retry.
%
@@ -168,17 +169,11 @@
; wn_next
; wn_continue
; wn_finish(int)
+ ; wn_exception
; wn_retry(int)
; wn_retry_nondet(int)
; wn_goto(int).
-:- inst what_next_no_retry
- ---> wn_step
- ; wn_next
- ; wn_continue
- ; wn_finish(ground)
- ; wn_goto(ground).
-
% Type used by the handle_event predicate to determine the next stop of
% the read_and_execute_cmd predicate.
%
@@ -201,9 +196,12 @@
% As above for nondet procedures.
% Stop at the final port (fail) of the given CSN.
- ; ns_goto(int).
+ ; ns_goto(int)
% Stop at the given event number.
+ ; ns_exception.
+ % Stop at the next exception.
+
% A breakpoint is represented by his module and procedure name.
%
:- type breakpoint
@@ -304,7 +302,8 @@ init_debugger_state = DebuggerState :-
;
MaybeTTY = no
),
- install_sigint_handler(!IO)
+ install_sigint_handler(!IO),
+ install_exception_hooks(!IO)
;
DebuggerState = debugger_off
),
@@ -627,14 +626,91 @@ search_nondet_stack_frame_2(ProcId, Depth, N, StackDepth, MaybeStackFrame,
).
%----------------------------------------------------------------------------%
+%
+% Support for exception events (Java only currently)
+%
- % IsSame is 'yes' iff the two call sequence numbers are equal,
- % 'no' otherwise.
- %
-:- pred is_same_int(int::in, int::in, bool::out) is det.
+:- pred install_exception_hooks(io::di, io::uo) is det.
-is_same_int(IntA, IntB, IsSame) :-
- IsSame = (IntA = IntB -> yes ; no).
+install_exception_hooks(!IO).
+
+:- pragma foreign_proc("Java",
+ install_exception_hooks(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+ exception.ssdb_hooks = new ssdb.SsdbHooks();
+").
+
+:- pragma foreign_code("Java", "
+private static class SsdbHooks extends exception.SsdbHooks {
+ @Override
+ public void on_throw_impl(univ.Univ_0 univ) {
+ ssdb.SSDB_handle_event_excp(""exception"", ""throw_impl"", univ);
+ }
+
+ @Override
+ public int on_catch_impl() {
+ return ssdb.SSDB_get_cur_ssdb_csn();
+ }
+
+ @Override
+ public void on_catch_impl_exception(int CSN) {
+ ssdb.SSDB_rollback_stack(CSN);
+ ssdb.SSDB_rollback_nondet_stack(CSN);
+ }
+}
+").
+
+:- impure pred handle_event_excp(string::in, string::in, univ::in) is det.
+:- pragma foreign_export("Java", handle_event_excp(in, in, in),
+ "SSDB_handle_event_excp").
+
+handle_event_excp(ModuleName, ProcName, Univ) :-
+ some [!IO] (
+ impure invent_io(!:IO),
+ get_debugger_state(DebuggerState, !IO),
+ (
+ DebuggerState = debugger_on,
+ ProcId = ssdb_proc_id(ModuleName, ProcName),
+ VarDescs = ['new bound_head_var'("Univ", 1, Univ)],
+ handle_event_excp_2(ProcId, VarDescs, !IO)
+ ;
+ DebuggerState = debugger_off
+ ),
+ impure consume_io(!.IO)
+ ).
+
+:- pred handle_event_excp_2(ssdb_proc_id::in, list(var_value)::in,
+ io::di, io::uo) is det.
+
+handle_event_excp_2(ProcId, ListVarValue, !IO) :-
+ get_ssdb_event_number_inc(EventNum, !IO),
+ get_ssdb_csn_inc(CSN, !IO),
+ stack_depth(OldDepth, !IO),
+ Depth = OldDepth + 1,
+
+ % Push the new stack frame on top of the shadow stack(s).
+ StackFrame = stack_frame(EventNum, CSN, Depth, ProcId, ListVarValue),
+ stack_push(StackFrame, !IO),
+
+ Event = ssdb_excp,
+ should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop, _AutoRetry,
+ !IO),
+ (
+ Stop = yes,
+ save_streams(!IO),
+ print_event_info(Event, EventNum, !IO),
+ read_and_execute_cmd(Event, 0, WhatNext, !IO),
+ update_next_stop(EventNum, CSN, WhatNext, _Retry, !IO),
+ restore_streams(!IO)
+ ;
+ Stop = no
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pragma foreign_export("Java", get_cur_ssdb_csn(out),
+ "SSDB_get_cur_ssdb_csn").
% Increment the CSN and return the new value.
%
@@ -756,6 +832,37 @@ nondet_stack_pop(!IO) :-
set_nondet_shadow_stack_depth(Depth - 1, !IO)
).
+:- pred rollback_stack(int::in, io::di, io::uo) is det.
+:- pragma foreign_export("Java", rollback_stack(in, di, uo),
+ "SSDB_rollback_stack").
+
+rollback_stack(TargetCSN, !IO) :-
+ stack_top(StackFrame, !IO),
+ ( StackFrame ^ sf_csn =< TargetCSN ->
+ set_cur_ssdb_csn(StackFrame ^ sf_csn, !IO)
+ ;
+ stack_pop(!IO),
+ rollback_stack(TargetCSN, !IO)
+ ).
+
+:- pred rollback_nondet_stack(int::in, io::di, io::uo) is det.
+:- pragma foreign_export("Java", rollback_nondet_stack(in, di, uo),
+ "SSDB_rollback_nondet_stack").
+
+rollback_nondet_stack(TargetCSN, !IO) :-
+ nondet_stack_depth(StackDepth, !IO),
+ ( StackDepth = 0 ->
+ true
+ ;
+ nondet_stack_index(0, StackFrame, !IO),
+ ( StackFrame ^ sf_csn =< TargetCSN ->
+ true
+ ;
+ nondet_stack_pop(!IO),
+ rollback_nondet_stack(TargetCSN, !IO)
+ )
+ ).
+
%-----------------------------------------------------------------------------%
% should_stop_at_the_event(Event, CSN, EventNum, ProcId, Stop, AutoRetry).
@@ -800,7 +907,7 @@ should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
),
AutoRetry = do_not_retry
;
- NextStop = ns_final_port(StopCSN, AutoRetry),
+ NextStop = ns_final_port(StopCSN, AutoRetry0),
(
( Event = ssdb_exit
; Event = ssdb_exit_nondet
@@ -808,6 +915,8 @@ should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
; Event = ssdb_fail_nondet
),
( StopCSN = CSN ->
+ ShouldStopAtEvent = yes,
+ AutoRetry = AutoRetry0,
(
AutoRetry = do_retry,
% NOTE: The event number and CSN used to be reset at the
@@ -820,23 +929,37 @@ should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
reset_counters_for_retry(Frame, !IO)
;
AutoRetry = do_not_retry
- ),
- ShouldStopAtEvent = yes
+ )
;
- ShouldStopAtEvent = no
+ ShouldStopAtEvent = no,
+ AutoRetry = do_not_retry
)
;
+ Event = ssdb_excp,
+ % Stop immediately, unless there is an exception handler which will
+ % catch the exception before we reach the final port of StopCSN.
+ get_shadow_stack(Stack, !IO),
+ ( exception_handler_exists(StopCSN, Stack) ->
+ ShouldStopAtEvent = no
+ ;
+ ShouldStopAtEvent = yes
+ ),
+ AutoRetry = do_not_retry
+ ;
( Event = ssdb_call
; Event = ssdb_call_nondet
; Event = ssdb_redo_nondet
),
- ShouldStopAtEvent = no
+ ShouldStopAtEvent = no,
+ AutoRetry = do_not_retry
)
;
- NextStop = ns_final_port_nondet(StopCSN, AutoRetry),
+ NextStop = ns_final_port_nondet(StopCSN, AutoRetry0),
(
Event = ssdb_fail_nondet,
( StopCSN = CSN ->
+ ShouldStopAtEvent = yes,
+ AutoRetry = AutoRetry0,
(
AutoRetry = do_retry,
nondet_stack_index(0, Frame, !IO),
@@ -848,12 +971,21 @@ should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
)
;
AutoRetry = do_not_retry
- ),
- ShouldStopAtEvent = yes
+ )
;
- ShouldStopAtEvent = no
+ ShouldStopAtEvent = no,
+ AutoRetry = do_not_retry
)
;
+ Event = ssdb_excp,
+ get_shadow_stack(Stack, !IO),
+ ( exception_handler_exists(StopCSN, Stack) ->
+ ShouldStopAtEvent = no
+ ;
+ ShouldStopAtEvent = yes
+ ),
+ AutoRetry = do_not_retry
+ ;
( Event = ssdb_call
; Event = ssdb_exit
; Event = ssdb_fail
@@ -861,14 +993,37 @@ should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
; Event = ssdb_exit_nondet
; Event = ssdb_redo_nondet
),
- ShouldStopAtEvent = no
+ ShouldStopAtEvent = no,
+ AutoRetry = do_not_retry
)
;
NextStop = ns_goto(EventNumToGo),
is_same_int(EventNumToGo, EventNum, ShouldStopAtEvent),
AutoRetry = do_not_retry
+ ;
+ NextStop = ns_exception,
+ (
+ Event = ssdb_excp,
+ ShouldStopAtEvent = yes
+ ;
+ ( Event = ssdb_call
+ ; Event = ssdb_exit
+ ; Event = ssdb_fail
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_exit_nondet
+ ; Event = ssdb_redo_nondet
+ ; Event = ssdb_fail_nondet
+ ),
+ ShouldStopAtEvent = no
+ ),
+ AutoRetry = do_not_retry
).
+:- pred is_same_int(int::in, int::in, bool::out) is det.
+
+is_same_int(IntA, IntB, IsSame) :-
+ IsSame = (IntA = IntB -> yes ; no).
+
% update_next_stop(EventNum, CSN, WhatNext, Retry).
%
% Set the NextStop and the Retry variable according to the WhatNext value.
@@ -896,6 +1051,10 @@ update_next_stop(EventNum, CSN, WhatNext, Retry, !IO) :-
NextStop = ns_final_port(EndCSN, do_not_retry),
Retry = do_not_retry
;
+ WhatNext = wn_exception,
+ NextStop = ns_exception,
+ Retry = do_not_retry
+ ;
WhatNext = wn_retry(RetryCSN),
( RetryCSN = CSN ->
NextStop = ns_step,
@@ -931,6 +1090,26 @@ reset_counters_for_retry(Frame, !IO) :-
set_cur_ssdb_event_number(Frame ^ sf_event_number - 1, !IO),
set_cur_ssdb_csn(Frame ^ sf_csn - 1, !IO).
+:- pred exception_handler_exists(int::in, list(stack_frame)::in) is semidet.
+
+exception_handler_exists(CSN, StackFrames) :-
+ list.member(StackFrame, StackFrames),
+ StackFrame ^ sf_csn >= CSN,
+ pred_catches_exceptions(StackFrame ^ sf_proc_id).
+
+ % Succeed if the given procedure is one which catches exceptions.
+ %
+:- pred pred_catches_exceptions(ssdb_proc_id::in) is semidet.
+
+pred_catches_exceptions(ProcId) :-
+ ProcId = ssdb_proc_id("exception", Name),
+ ( Name = "try"
+ ; Name = "try_io"
+ ; Name = "try_store"
+ ; Name = "try_all"
+ ; Name = "incremental_try_all"
+ ).
+
%----------------------------------------------------------------------------%
% h :: help
@@ -956,6 +1135,7 @@ reset_counters_for_retry(Frame, !IO) :-
; ssdb_goto
; ssdb_continue
; ssdb_finish
+ ; ssdb_exception
; ssdb_retry
@@ -988,6 +1168,9 @@ ssdb_cmd_name("c", ssdb_continue).
ssdb_cmd_name("continue", ssdb_continue).
ssdb_cmd_name("f", ssdb_finish).
ssdb_cmd_name("finish", ssdb_finish).
+ssdb_cmd_name("e", ssdb_exception).
+ssdb_cmd_name("ex", ssdb_exception).
+ssdb_cmd_name("exception", ssdb_exception).
ssdb_cmd_name("r", ssdb_retry).
ssdb_cmd_name("retry", ssdb_retry).
@@ -1087,6 +1270,9 @@ execute_cmd(Cmd, Args, Event, Depth, WhatNext, !IO) :-
Cmd = ssdb_finish,
execute_ssdb_finish(Args, Event, Depth, WhatNext, !IO)
;
+ Cmd = ssdb_exception,
+ execute_ssdb_exception(Args, Event, Depth, WhatNext, !IO)
+ ;
Cmd = ssdb_retry,
execute_ssdb_retry(Args, Event, Depth, WhatNext, !IO)
;
@@ -1273,6 +1459,19 @@ execute_ssdb_finish(Args, Event, Depth, WhatNext, !IO) :-
read_and_execute_cmd(Event, Depth, WhatNext, !IO)
).
+:- pred execute_ssdb_exception(list(string)::in, ssdb_event_type::in,
+ int::in, what_next::out, io::di, io::uo) is det.
+
+execute_ssdb_exception(Args, Event, Depth, WhatNext, !IO) :-
+ (
+ Args = [],
+ WhatNext = wn_exception
+ ;
+ Args = [_ | _],
+ io.write_string("The exception command accepts no arguments.\n", !IO),
+ read_and_execute_cmd(Event, Depth, WhatNext, !IO)
+ ).
+
:- pred execute_ssdb_retry(list(string)::in, ssdb_event_type::in,
int::in, what_next::out, io::di, io::uo) is det.
@@ -1333,6 +1532,7 @@ execute_ssdb_retry_2(Num, Event, Depth, WhatNext, !IO) :-
( Event = ssdb_call
; Event = ssdb_call_nondet
; Event = ssdb_redo_nondet
+ ; Event = ssdb_excp
),
io.write_string("Cannot retry at call or redo port.\n", !IO),
read_and_execute_cmd(Event, Depth, WhatNext, !IO)
@@ -1746,6 +1946,9 @@ print_event_info(Event, EventNum, !IO) :-
;
Event = ssdb_redo_nondet,
io.write_string("REDO", !IO)
+ ;
+ Event = ssdb_excp,
+ io.write_string("EXCP", !IO)
),
io.write_string(" ", !IO),
% mdb writes pred/func here.
@@ -1781,6 +1984,7 @@ print_help(!IO) :-
io.write_string("\n<next> or <n>", !IO),
io.write_string("\n<continue> or <c>", !IO),
io.write_string("\n<finish> or <f>", !IO),
+ io.write_string("\n<exception> or <e>", !IO),
io.write_string("\n<retry> or <r>", !IO),
io.write_string("\n<break X Y> or <b X Y>", !IO),
io.write_string("\n<break info> or <b info>", !IO),
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list