[m-dev.] for review: bring DD back end into line with the paper
Mark Anthony BROWN
dougl at cs.mu.OZ.AU
Wed Feb 16 14:07:38 AEDT 2000
Estimated hours taken: 25 (plus ? by zs)
Bring the implementation up to date with the algorithm that is
described in the paper (papers/decl_debug). Add some debugging
infrastructure to the back end, which was used to debug this
change.
browser/declarative_execution.m:
- Store the call sequence number in call nodes.
- Store the previous redo (if there is one) in fail nodes.
- Use a functor specifically for switches.
- Use a pointer to the first disj event, instead of a pointer
to the event before it.
- Export two new predicates for dereferencing disj node ids.
- Export (to C) a procedure for accessing the call sequence number,
and a procedure for getting to the first disj event.
- Split the scan_backwards function into two: step_left_in_context
and find_prev_contour.
browser/declarative_debugger.m:
trace/mercury_trace_declarative.c:
- Use the updated data structure.
runtime/mercury_conf_param.h:
- Add the configuration parameter MR_USE_DECL_STACK_SLOT, which
makes the declarative debugger use stack slots reserved by
the compiler to cache the location of the call node.
trace/mercury_trace_declarative.h:
trace/mercury_trace_declarative.c:
- Use stack slot only if MR_USE_DECL_STACK_SLOT is defined.
- If not using stack slot, use the new algorithm to search
for a matching call or exit event.
- Avoid using a global by passing the previous node to
MR_trace_decl_* and returning the new node.
- Rename MR_trace_call_node_answer to
MR_trace_call_node_last_interface.
- Update comments.
browser/declarative_execution.m:
trace/mercury_trace_declarative.c:
- Added debugging output for various events of interest
in the back end. It is activated when MR_DEBUG_DD_BACK_END
is set.
tests/debugger/declarative/aadebug.m:
tests/debugger/declarative/aadebug.inp:
tests/debugger/declarative/aadebug.exp:
tests/debugger/declarative/aadebug.exp2:
- Update this test to match the example in the paper.
tests/debugger/declarative/propositional.inp:
tests/debugger/declarative/propositional.exp:
tests/debugger/declarative/propositional.exp2:
- Update this test case so it gives a similar result in
debugging grades to non-debugging grades.
tests/debugger/declarative/app.exp2:
tests/debugger/declarative/if_then_else.exp2:
- Update test case results.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/backtrack.m:
tests/debugger/declarative/backtrack.inp:
tests/debugger/declarative/backtrack.exp:
- New test case.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.10
diff -u -r1.10 declarative_debugger.m
--- declarative_debugger.m 2000/02/04 03:45:26 1.10
+++ declarative_debugger.m 2000/02/15 15:27:07
@@ -250,10 +250,10 @@
trace_root(wrap(Store), dynamic(Ref), Root) :-
det_trace_node_from_id(Store, Ref, Node),
(
- Node = fail(_, CallId)
+ Node = fail(_, CallId, RedoId)
->
call_node_from_id(Store, CallId, Call),
- Call = call(_, RedoId, CallAtom),
+ Call = call(_, _, CallAtom, _),
get_answers(Store, RedoId, [], Answers),
Root = missing_answer(CallAtom, Answers)
;
@@ -291,7 +291,7 @@
det_trace_node_from_id(Store, Ref, Node),
(
- Node = fail(PrecId, _)
+ Node = fail(PrecId, _, _)
->
missing_answer_children(Store, PrecId, [], Children)
;
@@ -309,21 +309,21 @@
wrong_answer_children(Store, NodeId, Ns0, Ns) :-
det_trace_node_from_id(Store, NodeId, Node),
(
- Node = call(_, _, _),
+ Node = call(_, _, _, _),
Ns = Ns0
;
Node = neg(_, _, _),
Ns = Ns0
;
Node = exit(_, Call, _, _),
- call_node_from_id(Store, Call, call(Prec, _, _)),
+ call_node_from_id(Store, Call, call(Prec, _, _, _)),
wrong_answer_children(Store, Prec, [dynamic(NodeId) | Ns0], Ns)
;
Node = redo(_, _),
error("wrong_answer_children: unexpected REDO node")
;
- Node = fail(_, Call),
- call_node_from_id(Store, Call, call(Prec, _, _)),
+ Node = fail(_, Call, _),
+ call_node_from_id(Store, Call, call(Prec, _, _, _)),
wrong_answer_children(Store, Prec, [dynamic(NodeId) | Ns0], Ns)
;
Node = cond(Prec, _, Flag),
@@ -335,12 +335,16 @@
Ns = Ns0
)
;
- Node = first_disj(Back, _, _),
+ Node = switch(Back, _),
wrong_answer_children(Store, Back, Ns0, Ns)
;
- Node = later_disj(_, Back, _),
+ Node = first_disj(Back, _),
wrong_answer_children(Store, Back, Ns0, Ns)
;
+ Node = later_disj(_, _, FirstDisj),
+ first_disj_node_from_id(Store, FirstDisj, first_disj(Back, _)),
+ wrong_answer_children(Store, Back, Ns0, Ns)
+ ;
Node = then(Back, _),
wrong_answer_children(Store, Back, Ns0, Ns)
;
@@ -367,7 +371,7 @@
missing_answer_children(Store, NodeId, Ns0, Ns) :-
det_trace_node_from_id(Store, NodeId, Node),
(
- Node = call(_, _, _),
+ Node = call(_, _, _, _),
Ns = Ns0
;
Node = neg(_, _, _),
@@ -379,7 +383,7 @@
->
Prec = Prec0
;
- call_node_from_id(Store, Call, call(Prec, _, _))
+ call_node_from_id(Store, Call, call(Prec, _, _, _))
),
missing_answer_children(Store, Prec, [dynamic(NodeId) | Ns0],
Ns)
@@ -388,13 +392,15 @@
exit_node_from_id(Store, Exit, exit(Prec, _, _, _)),
missing_answer_children(Store, Prec, Ns0, Ns)
;
- Node = fail(_, Call),
- call_node_from_id(Store, Call, call(Back, Answer, _)),
+ Node = fail(_, CallId, MaybeRedo),
(
- maybe_redo_node_from_id(Store, Answer, redo(Prec, _))
+ maybe_redo_node_from_id(Store, MaybeRedo, Redo)
->
+ Redo = redo(Prec, _),
Next = Prec
;
+ call_node_from_id(Store, CallId, Call),
+ Call = call(Back, _, _, _),
Next = Back
),
missing_answer_children(Store, Next, [dynamic(NodeId) | Ns0],
@@ -409,9 +415,12 @@
Ns = Ns0
)
;
- Node = first_disj(Prec, _, _),
+ Node = switch(Prec, _),
missing_answer_children(Store, Prec, Ns0, Ns)
;
+ Node = first_disj(Prec, _),
+ missing_answer_children(Store, Prec, Ns0, Ns)
+ ;
Node = later_disj(Prec, _, _),
missing_answer_children(Store, Prec, Ns0, Ns)
;
@@ -433,4 +442,3 @@
neg_node_from_id(Store, Neg, neg(Back, _, _)),
missing_answer_children(Store, Back, Ns1, Ns)
).
-
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.2
diff -u -r1.2 declarative_execution.m
--- declarative_execution.m 2000/02/04 03:45:27 1.2
+++ declarative_execution.m 2000/02/15 03:58:38
@@ -7,17 +7,19 @@
% Author: Mark Brown
%
% This module defines a Mercury representation of Mercury program
-% execution. The declarative debugging infrastructure in the trace
-% directory builds such a representation, using predicates exported
-% from this module. The debugging front end analyses the structure
+% execution, the annotated trace. This structure is described in
+% papers/decl_debug. The declarative debugging infrastructure in the
+% trace directory builds an annotated trace, using predicates exported
+% from this module. Once built, the structure is passed to the front
+% end (in browser/declarative_debugger.m) where it is analysed
% to produce a bug diagnosis.
:- module mdb__declarative_execution.
:- interface.
-:- import_module bool, list, std_util, string, io.
+:- import_module list, std_util, string, io.
:- import_module mdb__util.
- % This type represents a port in a stored event trace.
+ % This type represents a port in the annotated trace.
% The type R is the type of references to other nodes
% in the store.
%
@@ -29,12 +31,13 @@
---> call(
R, % Preceding event.
R, % Last EXIT or REDO event.
- trace_atom % Atom that was called.
+ trace_atom, % Atom that was called.
+ sequence_number % Call sequence number.
)
; exit(
R, % Preceding event.
R, % CALL event.
- R, % Previous REDO event.
+ R, % Previous REDO event, if any.
trace_atom % Atom in its final state.
)
; redo(
@@ -43,17 +46,21 @@
)
; fail(
R, % Preceding event.
- R % CALL event.
+ R, % CALL event.
+ R % Previous REDO event, if any.
+ )
+ ; switch(
+ R, % Preceding event.
+ goal_path % Path for this event.
)
; first_disj(
R, % Preceding event.
- goal_path, % Path for this event.
- bool % Was this a switch?
+ goal_path % Path for this event.
)
; later_disj(
R, % Preceding event.
- R, % Event before the first DISJ.
- goal_path % Path for this event.
+ goal_path, % Path for this event.
+ R % Event of the first DISJ.
)
; cond(
R, % Preceding event.
@@ -106,8 +113,10 @@
:- type goal_path == goal_path_string.
- % Members of this typeclass represent an entire stored
- % event trace. The second parameter is the type of identifiers
+:- type sequence_number == int.
+
+ % Members of this typeclass represent an entire annotated
+ % trace. The second parameter is the type of identifiers
% for trace nodes, and the first parameter is the type of
% an abstract mapping from the identfiers to the nodes they
% identify.
@@ -129,7 +138,7 @@
:- pred det_trace_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
:- mode det_trace_node_from_id(in, in, out) is det.
-:- inst trace_node_call = bound(call(ground, ground, ground)).
+:- inst trace_node_call = bound(call(ground, ground, ground, ground)).
:- pred call_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
:- mode call_node_from_id(in, in, out(trace_node_call)) is det.
@@ -157,6 +166,17 @@
:- pred neg_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
:- mode neg_node_from_id(in, in, out(trace_node_neg)) is det.
+:- inst trace_node_first_disj = bound(first_disj(ground, ground)).
+
+:- pred first_disj_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
+:- mode first_disj_node_from_id(in, in, out(trace_node_first_disj)) is det.
+
+:- inst trace_node_disj = bound(first_disj(ground, ground);
+ later_disj(ground, ground, ground)).
+
+:- pred disj_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
+:- mode disj_node_from_id(in, in, out(trace_node_disj)) is det.
+
% Load an execution tree which was previously saved by
% the back end.
%
@@ -207,7 +227,7 @@
call_node_from_id(Store, NodeId, Node) :-
(
trace_node_from_id(Store, NodeId, Node0),
- Node0 = call(_, _, _)
+ Node0 = call(_, _, _, _)
->
Node = Node0
;
@@ -254,6 +274,28 @@
error("neg_node_from_id: not a NEG node")
).
+first_disj_node_from_id(Store, NodeId, Node) :-
+ (
+ trace_node_from_id(Store, NodeId, Node0),
+ Node0 = first_disj(_, _)
+ ->
+ Node = Node0
+ ;
+ error("first_disj_node_from_id: not a first DISJ node")
+ ).
+
+disj_node_from_id(Store, NodeId, Node) :-
+ (
+ trace_node_from_id(Store, NodeId, Node0),
+ ( Node0 = first_disj(_, _)
+ ; Node0 = later_disj(_, _, _)
+ )
+ ->
+ Node = Node0
+ ;
+ error("disj_node_from_id: not a DISJ node")
+ ).
+
%-----------------------------------------------------------------------------%
:- instance execution_tree(trace_node_store, trace_node_id) where [
@@ -296,12 +338,12 @@
:- pragma export(trace_node_port(in) = out,
"MR_DD_trace_node_port").
-trace_node_port(call(_, _, _)) = call.
+trace_node_port(call(_, _, _, _)) = call.
trace_node_port(exit(_, _, _, _)) = exit.
trace_node_port(redo(_, _)) = redo.
-trace_node_port(fail(_, _)) = fail.
-trace_node_port(first_disj(_, _, yes)) = switch.
-trace_node_port(first_disj(_, _, no)) = disj.
+trace_node_port(fail(_, _, _)) = fail.
+trace_node_port(switch(_, _)) = switch.
+trace_node_port(first_disj(_, _)) = disj.
trace_node_port(later_disj(_, _, _)) = disj.
trace_node_port(cond(_, _, _)) = ite_cond.
trace_node_port(then(_, _)) = ite_then.
@@ -315,12 +357,13 @@
:- pragma export(trace_node_path(in, in) = out,
"MR_DD_trace_node_path").
-trace_node_path(_, call(_, _, _)) = "".
+trace_node_path(_, call(_, _, _, _)) = "".
trace_node_path(_, exit(_, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
-trace_node_path(_, fail(_, _)) = "".
-trace_node_path(_, first_disj(_, P, _)) = P.
-trace_node_path(_, later_disj(_, _, P)) = P.
+trace_node_path(_, fail(_, _, _)) = "".
+trace_node_path(_, switch(_, P)) = P.
+trace_node_path(_, first_disj(_, P)) = P.
+trace_node_path(_, later_disj(_, P, _)) = P.
trace_node_path(_, cond(_, P, _)) = P.
trace_node_path(S, then(_, Cond)) = P :-
cond_node_from_id(S, Cond, cond(_, P, _)).
@@ -331,54 +374,149 @@
neg_node_from_id(S, Neg, neg(_, P, _)).
trace_node_path(S, neg_fail(_, Neg)) = P :-
neg_node_from_id(S, Neg, neg(_, P, _)).
+
+:- pred trace_node_seqno(trace_node_store, trace_node(trace_node_id),
+ sequence_number).
+:- mode trace_node_seqno(in, in, out) is semidet.
+
+:- pragma export(trace_node_seqno(in, in, out), "MR_DD_trace_node_seqno").
+
+trace_node_seqno(S, Node, SeqNo) :-
+ (
+ Node = call(_, _, _, SeqNo0)
+ ->
+ SeqNo = SeqNo0
+ ;
+ trace_node_call(S, Node, Call),
+ call_node_from_id(S, Call, call(_, _, _, SeqNo))
+ ).
+
+:- pred trace_node_call(trace_node_store, trace_node(trace_node_id),
+ trace_node_id).
+:- mode trace_node_call(in, in, out) is semidet.
+
+:- pragma export(trace_node_call(in, in, out), "MR_DD_trace_node_call").
+
+trace_node_call(_, exit(_, Call, _, _), Call).
+trace_node_call(S, redo(_, Exit), Call) :-
+ exit_node_from_id(S, Exit, exit(_, Call, _, _)).
+trace_node_call(_, fail(_, Call, _), Call).
+
+:- pred trace_node_first_disj(trace_node(trace_node_id), trace_node_id).
+:- mode trace_node_first_disj(in, out) is semidet.
- % Given any node in a stored event trace, find the most recent
+:- pragma export(trace_node_first_disj(in, out),
+ "MR_DD_trace_node_first_disj").
+
+trace_node_first_disj(first_disj(_, _), NULL) :-
+ null_trace_node_id(NULL).
+trace_node_first_disj(later_disj(_, _, FirstDisj), FirstDisj).
+
+ % Given any node in an annotated trace, find the most recent
% node in the same context which has not been backtracked over,
% skipping negations, conditions, the bodies of calls, and
% alternative disjuncts. Return the NULL reference if there
% is no such node (eg. if we are at the start of a negation,
% condition, or call).
%
-:- func scan_backwards(trace_node_store, trace_node(trace_node_id))
+:- func step_left_in_context(trace_node_store, trace_node(trace_node_id))
= trace_node_id.
-:- pragma export(scan_backwards(in, in) = out,
- "MR_DD_scan_backwards").
+:- pragma export(step_left_in_context(in, in) = out,
+ "MR_DD_step_left_in_context").
-scan_backwards(_, call(_, _, _)) = NULL :-
- null_trace_node_id(NULL).
-scan_backwards(_, cond(_, _, _)) = NULL :-
- null_trace_node_id(NULL).
-scan_backwards(_, neg(_, _, _)) = NULL :-
- null_trace_node_id(NULL).
-scan_backwards(Store, exit(_, Call, _, _)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _)).
-scan_backwards(Store, fail(_, Call)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _)).
-scan_backwards(Store, redo(_, Exit)) = Prec :-
- exit_node_from_id(Store, Exit, exit(Prec, _, _, _)).
-scan_backwards(_, first_disj(Prec, _, _)) = Prec.
-scan_backwards(_, later_disj(_, Back, _)) = Back.
-scan_backwards(Store, then(_, Cond)) = Prec :-
- cond_node_from_id(Store, Cond, cond(Prec, _, _)).
-scan_backwards(Store, else(_, Cond)) = Prec :-
+step_left_in_context(_, call(_, _, _, _)) = _ :-
+ error("step_left_in_context: unexpected CALL node").
+step_left_in_context(_, cond(Prec, _, Status)) = Node :-
+ (
+ Status = succeeded
+ ->
+ Node = Prec
+ ;
+ null_trace_node_id(Node)
+ ).
+step_left_in_context(_, neg(_, _, _)) = _ :-
+ error("step_left_in_context: unexpected NEGE node").
+step_left_in_context(Store, exit(_, Call, _, _)) = Prec :-
+ call_node_from_id(Store, Call, call(Prec, _, _, _)).
+step_left_in_context(Store, fail(_, Call, _)) = Prec :-
+ call_node_from_id(Store, Call, call(Prec, _, _, _)).
+step_left_in_context(_, redo(_, _)) = _ :-
+ error("step_left_in_context: unexpected REDO node").
+step_left_in_context(_, switch(Prec, _)) = Prec.
+step_left_in_context(_, first_disj(Prec, _)) = Prec.
+step_left_in_context(Store, later_disj(_, _, FirstDisj)) = Prec :-
+ first_disj_node_from_id(Store, FirstDisj, first_disj(Prec, _)).
+step_left_in_context(_, then(Prec, _)) = Prec.
+step_left_in_context(Store, else(_, Cond)) = Prec :-
cond_node_from_id(Store, Cond, cond(Prec, _, _)).
-scan_backwards(Store, neg_succ(_, Neg)) = Prec :-
+step_left_in_context(Store, neg_succ(_, Neg)) = Prec :-
neg_node_from_id(Store, Neg, neg(Prec, _, _)).
-scan_backwards(Store, neg_fail(_, Neg)) = Prec :-
+step_left_in_context(Store, neg_fail(_, Neg)) = Prec :-
neg_node_from_id(Store, Neg, neg(Prec, _, _)).
+ % Given any node in an annotated trace, find a node in
+ % the previous contour.
%
+:- func find_prev_contour(trace_node_store, trace_node_id)
+ = trace_node_id.
+:- pragma export(find_prev_contour(in, in) = out,
+ "MR_DD_find_prev_contour").
+
+find_prev_contour(Store, NodeId) = OnContour :-
+ det_trace_node_from_id(Store, NodeId, Node),
+ find_prev_contour_1(Store, NodeId, Node, OnContour).
+
+:- pred find_prev_contour_1(trace_node_store, trace_node_id,
+ trace_node(trace_node_id), trace_node_id).
+:- mode find_prev_contour_1(in, in, in, out) is det.
+
+find_prev_contour_1(_, _, call(_, _, _, _), _) :-
+ error("find_prev_contour: reached CALL node").
+find_prev_contour_1(_, Exit, exit(_, _, _, _), Exit).
+find_prev_contour_1(Store, _, redo(_, Exit), OnContour) :-
+ exit_node_from_id(Store, Exit, exit(OnContour, _, _, _)).
+find_prev_contour_1(Store, _, fail(_, Call, _), OnContour) :-
+ call_node_from_id(Store, Call, call(OnContour, _, _, _)).
+find_prev_contour_1(_, _, cond(_, _, _), _) :-
+ error("find_prev_contour: reached COND node").
+find_prev_contour_1(_, Then, then(_, _), Then).
+find_prev_contour_1(_, Else, else(_, _), Else).
+find_prev_contour_1(_, _, neg(_, _, _), _) :-
+ error("find_prev_contour: reached NEGE node").
+find_prev_contour_1(_, NegS, neg_succ(_, _), NegS).
+find_prev_contour_1(Store, _, neg_fail(_, Neg), OnContour) :-
+ neg_node_from_id(Store, Neg, neg(OnContour, _, _)).
+find_prev_contour_1(_, Swtc, switch(_, _), Swtc).
+find_prev_contour_1(_, FirstDisj, first_disj(_, _), FirstDisj).
+find_prev_contour_1(_, LaterDisj, later_disj(_, _, _), LaterDisj).
+
+ % Print a text representation of a trace node, useful
+ % for debugging purposes.
+ %
+:- pred print_trace_node(io__output_stream, trace_node(trace_node_id),
+ io__state, io__state).
+:- mode print_trace_node(in, in, di, uo) is det.
+:- pragma export(print_trace_node(in, in, di, uo), "MR_DD_print_trace_node").
+
+print_trace_node(OutStr, Node) -->
+ { convert_node(Node, CNode) },
+ io__write(OutStr, CNode).
+
+%-----------------------------------------------------------------------------%
+
+ %
% Each node type has a Mercury function which constructs
% a node of that type. The functions are exported to C so
% that the back end can build an execution tree.
%
-:- func construct_call_node(trace_node_id, trace_atom)
+:- func construct_call_node(trace_node_id, trace_atom, sequence_number)
= trace_node(trace_node_id).
-:- pragma export(construct_call_node(in, in) = out,
+:- pragma export(construct_call_node(in, in, in) = out,
"MR_DD_construct_call_node").
-construct_call_node(Preceding, Atom) = call(Preceding, Answer, Atom) :-
+construct_call_node(Preceding, Atom, SeqNo) = Call :-
+ Call = call(Preceding, Answer, Atom, SeqNo),
null_trace_node_id(Answer).
@@ -387,8 +525,8 @@
:- pragma export(construct_exit_node(in, in, in, in) = out,
"MR_DD_construct_exit_node").
-construct_exit_node(Preceding, Call, Previous, Atom)
- = exit(Preceding, Call, Previous, Atom).
+construct_exit_node(Preceding, Call, MaybeRedo, Atom)
+ = exit(Preceding, Call, MaybeRedo, Atom).
:- func construct_redo_node(trace_node_id, trace_node_id)
@@ -399,30 +537,45 @@
construct_redo_node(Preceding, Exit) = redo(Preceding, Exit).
-:- func construct_fail_node(trace_node_id, trace_node_id)
+:- func construct_fail_node(trace_node_id, trace_node_id, trace_node_id)
= trace_node(trace_node_id).
-:- pragma export(construct_fail_node(in, in) = out,
+:- pragma export(construct_fail_node(in, in, in) = out,
"MR_DD_construct_fail_node").
+
+construct_fail_node(Preceding, Call, Redo) = fail(Preceding, Call, Redo).
-construct_fail_node(Preceding, Call) = fail(Preceding, Call).
+:- func construct_switch_node(trace_node_id, goal_path_string)
+ = trace_node(trace_node_id).
+:- pragma export(construct_switch_node(in, in) = out,
+ "MR_DD_construct_switch_node").
+
+construct_switch_node(Preceding, Path) =
+ switch(Preceding, Path).
-:- func construct_first_disj_node(trace_node_id, goal_path_string, bool)
+:- func construct_first_disj_node(trace_node_id, goal_path_string)
= trace_node(trace_node_id).
-:- pragma export(construct_first_disj_node(in, in, in) = out,
+:- pragma export(construct_first_disj_node(in, in) = out,
"MR_DD_construct_first_disj_node").
-construct_first_disj_node(Preceding, Path, Flag) =
- first_disj(Preceding, Path, Flag).
+construct_first_disj_node(Preceding, Path) =
+ first_disj(Preceding, Path).
-:- func construct_later_disj_node(trace_node_id, trace_node_id,
- goal_path_string) = trace_node(trace_node_id).
-:- pragma export(construct_later_disj_node(in, in, in) = out,
+:- func construct_later_disj_node(trace_node_store, trace_node_id,
+ goal_path_string, trace_node_id) = trace_node(trace_node_id).
+:- pragma export(construct_later_disj_node(in, in, in, in) = out,
"MR_DD_construct_later_disj_node").
-construct_later_disj_node(Preceding, Back, Path)
- = later_disj(Preceding, Back, Path).
+construct_later_disj_node(Store, Preceding, Path, PrevDisj)
+ = later_disj(Preceding, Path, FirstDisj) :-
+ disj_node_from_id(Store, PrevDisj, PrevDisjNode),
+ (
+ PrevDisjNode = first_disj(_, _),
+ FirstDisj = PrevDisj
+ ;
+ PrevDisjNode = later_disj(_, _, FirstDisj)
+ ).
:- func construct_cond_node(trace_node_id, goal_path_string)
@@ -574,17 +727,18 @@
[will_not_call_mercury, thread_safe],
"N2 = N1;").
- % Given a node in a stored trace, return a reference to
+ % Given a node in an annotated trace, return a reference to
% the preceding node in the trace, or a NULL reference if
% it is the first.
%
:- func preceding_node(trace_node(T)) = T.
-preceding_node(call(P, _, _)) = P.
+preceding_node(call(P, _, _, _)) = P.
preceding_node(exit(P, _, _, _)) = P.
preceding_node(redo(P, _)) = P.
-preceding_node(fail(P, _)) = P.
-preceding_node(first_disj(P, _, _)) = P.
+preceding_node(fail(P, _, _)) = P.
+preceding_node(switch(P, _)) = P.
+preceding_node(first_disj(P, _)) = P.
preceding_node(later_disj(P, _, _)) = P.
preceding_node(cond(P, _, _)) = P.
preceding_node(then(P, _)) = P.
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.33
diff -u -r1.33 mercury_conf_param.h
--- mercury_conf_param.h 2000/01/11 00:10:15 1.33
+++ mercury_conf_param.h 2000/02/15 16:18:12
@@ -322,6 +322,10 @@
/*
** MR_USE_DECLARATIVE_DEBUGGER -- include support for declarative
** debugging in the internal debugger.
+**
+** MR_USE_DECL_STACK_SLOT -- reserve a stack slot for use by the
+** declarative debugger. Requires programs
+** to be compiled with the flag `--trace-decl'.
*/
#if defined(CONSERVATIVE_GC) && !defined(MR_DISABLE_DECLARATIVE_DEBUGGER)
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- Mmakefile 2000/01/21 02:44:26 1.10
+++ Mmakefile 2000/02/15 17:26:21
@@ -19,6 +19,7 @@
DECLARATIVE_PROGS= \
aadebug \
app \
+ backtrack \
big \
gcf \
if_then_else \
@@ -36,7 +37,6 @@
ite_2 \
solutions
-
MCFLAGS = --trace deep --trace-decl
MLFLAGS = --trace
C2INITFLAGS = --trace
@@ -74,6 +74,9 @@
app.out: app app.inp
$(MDB) ./app < app.inp > app.out 2>&1
+
+backtrack.out: backtrack backtrack.inp
+ $(MDB) ./backtrack < backtrack.inp > backtrack.out 2>&1
big.out: big big.inp
$(MDB) ./big < big.inp > big.out 2>&1
Index: tests/debugger/declarative/aadebug.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.exp,v
retrieving revision 1.1
diff -u -r1.1 aadebug.exp
--- aadebug.exp 2000/01/21 02:44:27 1.1
+++ aadebug.exp 2000/02/14 14:35:50
@@ -5,55 +5,67 @@
mdb> break p
0: + stop interface pred aadebug:p/2-0 (nondet)
mdb> continue
- 3: 2 2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 3: 2 2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
- 15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
-atom("p", [univ(1 : int), univ(27 : int)])
+atom("p", [univ('a' : character), univ(30 : int)])
Valid? no
-atom("q", [univ(1 : int), univ(1 : int)])
+atom("q", [univ('a' : character), univ('a' : character)])
Valid? yes
-atom("r", [univ(1 : int), univ(9 : int)])
+atom("r", [univ('a' : character), univ(10 : int)])
Valid? yes
-atom("s", [univ(9 : int), univ(27 : int)])
+atom("s", [univ(10 : int), univ(30 : int)])
Valid? yes
Incorrect node found:
-wrong_answer(atom("p", [univ(1 : int), univ(27 : int)]))
- 15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+wrong_answer(atom("p", [univ('a' : character), univ(30 : int)]))
+ 15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
- 16: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 18: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
- 18: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 20: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
-atom("p", [univ(1 : int), univ(1 : int)])
+atom("p", [univ('a' : character), univ(31 : int)])
Valid? no
Incorrect node found:
-wrong_answer(atom("p", [univ(1 : int), univ(1 : int)]))
- 18: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+wrong_answer(atom("p", [univ('a' : character), univ(31 : int)]))
+ 20: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
- 19: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 23: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
- 34: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+ 35: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
-Call atom("p", [univ(1 : int)])
-Solutions:
- atom("p", [univ(1 : int), univ(27 : int)])
- atom("p", [univ(1 : int), univ(1 : int)])
-Complete? no
-atom("q", [univ(1 : int), univ(2 : int)])
+atom("p", [univ('a' : character), univ(32 : int)])
+Valid? no
+atom("q", [univ('a' : character), univ('b' : character)])
Valid? yes
-Call atom("r", [univ(2 : int)])
+Call atom("r", [univ('b' : character)])
Solutions:
Complete? yes
-atom("q", [univ(2 : int), univ(4 : int)])
-Valid? yes
-Call atom("q", [univ(1 : int)])
+Call atom("q", [univ('b' : character)])
+Solutions:
+Complete? yes
+Incorrect node found:
+wrong_answer(atom("p", [univ('a' : character), univ(32 : int)]))
+ 35: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> continue
+ 38: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> finish
+ 41: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> dd
+Call atom("p", [univ('a' : character)])
+Solutions:
+ atom("p", [univ('a' : character), univ(30 : int)])
+ atom("p", [univ('a' : character), univ(31 : int)])
+ atom("p", [univ('a' : character), univ(32 : int)])
+Complete? no
+Call atom("q", [univ('a' : character)])
Solutions:
- atom("q", [univ(1 : int), univ(1 : int)])
- atom("q", [univ(1 : int), univ(2 : int)])
+ atom("q", [univ('a' : character), univ('a' : character)])
+ atom("q", [univ('a' : character), univ('b' : character)])
Complete? yes
Incorrect node found:
-missing_answer(atom("p", [univ(1 : int)]), [atom("p", [univ(1 : int), univ(27 : int)]), atom("p", [univ(1 : int), univ(1 : int)])])
- 34: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+missing_answer(atom("p", [univ('a' : character)]), [atom("p", [univ('a' : character), univ(30 : int)]), atom("p", [univ('a' : character), univ(31 : int)]), atom("p", [univ('a' : character), univ(32 : int)])])
+ 41: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
no
Index: tests/debugger/declarative/aadebug.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.inp,v
retrieving revision 1.1
diff -u -r1.1 aadebug.inp
--- aadebug.inp 2000/01/21 02:44:27 1.1
+++ aadebug.inp 2000/02/15 04:28:21
@@ -19,6 +19,10 @@
yes
yes
yes
+continue
+finish
+dd
+no
yes
continue
Index: tests/debugger/declarative/aadebug.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.m,v
retrieving revision 1.1
diff -u -r1.1 aadebug.m
--- aadebug.m 2000/01/21 02:44:27 1.1
+++ aadebug.m 2000/02/15 04:23:48
@@ -3,16 +3,22 @@
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module int.
+:- import_module int, std_util.
main -->
- ( { p(1, -1) } ->
+ ( { p('a', X), test(X) } ->
io__write_string("yes\n")
;
io__write_string("no\n")
).
-:- pred p(int, int).
+:- pred test(int).
+:- mode test(in) is semidet.
+
+test(_) :-
+ semidet_fail.
+
+:- pred p(character, int).
:- mode p(in, out) is nondet.
p(A, D) :-
@@ -23,28 +29,29 @@
(
s(C, D)
;
- D = 1
+ D = 31
)
;
- not q(B, _),
- D = 2
+ not(
+ q(B, _)
+ ),
+ D = 32
).
-:- pred q(int, int).
+:- pred q(character, character).
:- mode q(in, out) is nondet.
-q(1, 1).
-q(1, 2).
-q(2, 4).
+q('a', 'a').
+q('a', 'b').
+q('c', 'c').
-:- pred r(int, int).
+:- pred r(character, int).
:- mode r(in, out) is semidet.
-r(1, 9).
+r('a', 10).
:- pred s(int, int).
:- mode s(in, out) is det.
-s(A, B) :-
- B = A * 3.
+s(N, 3 * N).
Index: tests/debugger/declarative/app.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/app.exp2,v
retrieving revision 1.2
diff -u -r1.2 app.exp2
--- app.exp2 2000/01/21 02:44:28 1.2
+++ app.exp2 2000/02/15 16:34:44
@@ -36,9 +36,9 @@
19: 2 2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:13)
mdb> continue
append([1, 2, 3, 4, 5], [6, 7, 8], [1, 2, 3, 4, 5, 6, 7, 8]).
- 24: 347 2 CALL pred app:app/3-0 (det) app.m:26 (app.m:18)
+ 24: 395 2 CALL pred app:app/3-0 (det) app.m:26 (app.m:18)
mdb> finish -n
- 71: 347 2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
+ 71: 395 2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
mdb> dd
atom("app", [univ([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5] : list:list(int)), univ([6, 7, 8] : list:list(int)), univ([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8] : list:list(int)), univ(int : private_builtin:type_info(int))])
Valid? no
@@ -62,6 +62,6 @@
Valid? no
Incorrect node found:
wrong_answer(atom("app", [univ([3, 4, 5] : list:list(int)), univ([6, 7, 8] : list:list(int)), univ([3, 4, 5, 6, 7, 8] : list:list(int)), univ(int : private_builtin:type_info(int))]))
- 71: 347 2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
+ 71: 395 2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
mdb> continue
append([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5], [6, 7, 8], [1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8]).
Index: tests/debugger/declarative/if_then_else.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/if_then_else.exp2,v
retrieving revision 1.2
diff -u -r1.2 if_then_else.exp2
--- if_then_else.exp2 2000/01/21 02:44:30 1.2
+++ if_then_else.exp2 2000/02/15 16:36:58
@@ -20,9 +20,9 @@
9: 2 2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:8)
mdb> continue
ite(0, 1).
- 16: 261 2 CALL pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+ 16: 280 2 CALL pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
mdb> finish
- 23: 261 2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+ 23: 280 2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
mdb> dd
atom("ite", [univ(1 : int), univ(0 : int)])
Valid? no
@@ -31,6 +31,6 @@
Complete? yes
Incorrect node found:
wrong_answer(atom("ite", [univ(1 : int), univ(0 : int)]))
- 23: 261 2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+ 23: 280 2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
mdb> continue
ite(1, 0).
Index: tests/debugger/declarative/propositional.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.exp,v
retrieving revision 1.4
diff -u -r1.4 propositional.exp
--- propositional.exp 2000/01/21 02:44:33 1.4
+++ propositional.exp 2000/02/15 17:13:57
@@ -14,9 +14,9 @@
atom("a", [])
Valid? no
atom("c", [])
-Valid? no
+Valid? yes
Incorrect node found:
-wrong_answer(atom("c", []))
+wrong_answer(atom("a", []))
11: 2 2 EXIT pred propositional:a/0-0 (semidet) propositional.m:27 (propositional.m:10)
mdb> continue
12: 5 2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
Index: tests/debugger/declarative/propositional.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.exp2,v
retrieving revision 1.2
diff -u -r1.2 propositional.exp2
--- propositional.exp2 2000/01/21 02:44:33 1.2
+++ propositional.exp2 2000/02/15 16:52:05
@@ -14,14 +14,14 @@
atom("a", [])
Valid? no
atom("c", [])
-Valid? no
+Valid? yes
Incorrect node found:
-wrong_answer(atom("c", []))
+wrong_answer(atom("a", []))
15: 2 2 EXIT pred propositional:a/0-0 (semidet) propositional.m:27 (propositional.m:10)
mdb> continue
- 16: 203 2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+ 16: 235 2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
mdb> finish
- 30: 203 2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+ 30: 235 2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
mdb> dd
atom("b", [])
Valid? no
@@ -31,6 +31,6 @@
Valid? yes
Incorrect node found:
wrong_answer(atom("f", []))
- 30: 203 2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+ 30: 235 2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
mdb> continue
yes
Index: tests/debugger/declarative/propositional.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.inp,v
retrieving revision 1.3
diff -u -r1.3 propositional.inp
--- propositional.inp 2000/01/21 02:44:34 1.3
+++ propositional.inp 2000/02/15 16:47:37
@@ -6,7 +6,7 @@
finish
dd
no
-no
+yes
continue
finish
dd
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.15
diff -u -r1.15 mercury_trace_declarative.c
--- mercury_trace_declarative.c 2000/02/04 03:45:42 1.15
+++ mercury_trace_declarative.c 2000/02/15 16:31:07
@@ -9,9 +9,9 @@
**
** This file implements the back end of the declarative debugger. The
** back end is an extension to the internal debugger which collects
-** related trace events and builds them into an execution tree. Once
-** built, the tree is passed to the front end where it can be analysed
-** to find bugs. The front end is implemented in
+** related trace events and builds them into an annotated trace. Once
+** built, the structure is passed to the front end where it can be
+** analysed to find bugs. The front end is implemented in
** browse/declarative_debugger.m.
**
** The interface between the front and back ends is via the
@@ -39,7 +39,9 @@
#include "mercury_trace_util.h"
#include "mercury_layout_util.h"
#include "mercury_deep_copy.h"
+#include "mercury_stack_trace.h"
#include "mercury_string.h"
+#include "mercury_trace_base.h"
#include "mdb.declarative_debugger.h"
#include "mdb.declarative_execution.h"
#include "std_util.h"
@@ -47,13 +49,47 @@
#include <errno.h>
/*
-** We only build the execution tree to a certain depth. The following
-** macro gives the default depth limit (relative to the starting depth).
+** We only build the annotated trace for events down to a certain
+** depth. The following macro gives the default depth limit (relative
+** to the starting depth). In future it would be nice to dynamically
+** adjust this factor based on profiling information.
*/
#define MR_EDT_DEPTH_STEP_SIZE 128
/*
+** These macros are to aid debugging of the code which constructs
+** the annotated trace.
+*/
+
+#ifdef MR_DEBUG_DD_BACK_END
+
+#define MR_decl_checkpoint_event(event_info) \
+ MR_decl_checkpoint_event_imp(event_info)
+
+#define MR_decl_checkpoint_find(location) \
+ MR_decl_checkpoint_loc("FIND", location)
+
+#define MR_decl_checkpoint_step(location) \
+ MR_decl_checkpoint_loc("STEP", location)
+
+#define MR_decl_checkpoint_match(location) \
+ MR_decl_checkpoint_loc("MATCH", location)
+
+#define MR_decl_checkpoint_alloc(location) \
+ MR_decl_checkpoint_loc("ALLOC", location)
+
+#else /* !MR_DEBUG_DD_BACK_END */
+
+#define MR_decl_checkpoint_event(event_info)
+#define MR_decl_checkpoint_find(location)
+#define MR_decl_checkpoint_step(location)
+#define MR_decl_checkpoint_match(location)
+#define MR_decl_checkpoint_alloc(location)
+
+#endif
+
+/*
** The declarative debugger back end is controlled by the
** settings of the following variables. They are set in
** MR_trace_start_decl_debug when the back end is started. They
@@ -101,35 +137,41 @@
static FILE *MR_trace_store_file;
-static void
-MR_trace_decl_call(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_call(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_exit(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_exit(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_redo(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_redo(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_fail(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_fail(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_switch(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_switch(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_disj(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_disj(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_cond(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_cond(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_then_else(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_then(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_enter_neg(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_else(MR_Event_Info *event_info, MR_Trace_Node prev);
-static void
-MR_trace_decl_leave_neg(MR_Event_Info *event_info);
+static MR_Trace_Node
+MR_trace_decl_neg_enter(MR_Event_Info *event_info, MR_Trace_Node prev);
+
+static MR_Trace_Node
+MR_trace_decl_neg_success(MR_Event_Info *event_info, MR_Trace_Node prev);
+
+static MR_Trace_Node
+MR_trace_decl_neg_failure(MR_Event_Info *event_info, MR_Trace_Node prev);
static MR_Trace_Node
MR_trace_decl_get_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs);
@@ -138,6 +180,12 @@
MR_trace_decl_set_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs,
MR_Trace_Node node);
+static MR_Trace_Node
+MR_trace_matching_call(MR_Trace_Node node);
+
+static bool
+MR_trace_first_disjunct(MR_Event_Info *event_info);
+
static bool
MR_trace_matching_cond(const char *path, MR_Trace_Node node);
@@ -171,14 +219,33 @@
static String
MR_trace_node_path(MR_Trace_Node node);
+static MR_Trace_Port
+MR_trace_node_port(MR_Trace_Node node);
+
+static Unsigned
+MR_trace_node_seqno(MR_Trace_Node node);
+
+static MR_Trace_Node
+MR_trace_node_first_disj(MR_Trace_Node node);
+
static MR_Trace_Node
-MR_trace_scan_backwards(MR_Trace_Node node);
+MR_trace_step_left_in_context(MR_Trace_Node node);
+static MR_Trace_Node
+MR_trace_find_prev_contour(MR_Trace_Node node);
+
+static void
+MR_decl_checkpoint_event_imp(MR_Event_Info *event_info);
+
+static void
+MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node);
+
Code *
MR_trace_decl_debug(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
{
MR_Stack_Layout_Entry *entry;
Unsigned depth;
+ MR_Trace_Node trace;
entry = event_info->MR_event_sll->MR_sll_entry;
depth = event_info->MR_call_depth;
@@ -198,66 +265,80 @@
fatal_error("layout has no execution tracing");
}
- if (depth > MR_edt_max_depth ||
- depth < MR_edt_min_depth ||
- entry->MR_sle_maybe_decl_debug < 1 ) {
+ if (depth > MR_edt_max_depth || depth < MR_edt_min_depth) {
/*
- ** We ignore any event for a procedure that does not have
- ** slots reserved for declarative debugging. Such
- ** procedures are assumed to be correct. We also filter
- ** out events with a depth outside the range given by
- ** MR_edt_{min,max}_depth. These events are either
- ** irrelevant, or else implicitly represented in the
- ** structure being built. See comment in
+ ** We filter out events with a depth outside the range
+ ** given by MR_edt_{min,max}_depth. These events are
+ ** either irrelevant, or else implicitly represented in
+ ** the structure being built. See comment in
** trace/mercury_trace_declarative.h.
*/
return NULL;
}
- MR_trace_enabled = FALSE;
+#ifdef MR_USE_DECL_STACK_SLOT
+ if (entry->MR_sle_maybe_decl_debug < 1) {
+ /*
+ ** If using reserved stack slots, we ignore any event
+ ** for a procedure that does not have a slot reserved.
+ ** Such procedures are effectively assumed correct.
+ */
+ return NULL;
+ }
+#endif /* MR_USE_DECL_STACK_SLOT */
+ MR_trace_enabled = FALSE;
+ MR_decl_checkpoint_event(event_info);
+ trace = MR_trace_current_node;
switch (event_info->MR_trace_port) {
case MR_PORT_CALL:
- MR_trace_decl_call(event_info);
+ trace = MR_trace_decl_call(event_info, trace);
break;
case MR_PORT_EXIT:
- MR_trace_decl_exit(event_info);
+ trace = MR_trace_decl_exit(event_info, trace);
break;
case MR_PORT_REDO:
- MR_trace_decl_redo(event_info);
+ trace = MR_trace_decl_redo(event_info, trace);
break;
case MR_PORT_FAIL:
- MR_trace_decl_fail(event_info);
+ trace = MR_trace_decl_fail(event_info, trace);
break;
case MR_PORT_DISJ:
- MR_trace_decl_disj(event_info);
+ trace = MR_trace_decl_disj(event_info, trace);
break;
case MR_PORT_SWITCH:
- MR_trace_decl_switch(event_info);
+ trace = MR_trace_decl_switch(event_info, trace);
break;
case MR_PORT_COND:
- MR_trace_decl_cond(event_info);
+ trace = MR_trace_decl_cond(event_info, trace);
break;
case MR_PORT_THEN:
+ trace = MR_trace_decl_then(event_info, trace);
+ break;
case MR_PORT_ELSE:
- MR_trace_decl_then_else(event_info);
+ trace = MR_trace_decl_else(event_info, trace);
break;
case MR_PORT_NEG_ENTER:
- MR_trace_decl_enter_neg(event_info);
+ trace = MR_trace_decl_neg_enter(event_info, trace);
break;
case MR_PORT_NEG_SUCCESS:
+ trace = MR_trace_decl_neg_success(event_info, trace);
+ break;
case MR_PORT_NEG_FAILURE:
- MR_trace_decl_leave_neg(event_info);
+ trace = MR_trace_decl_neg_failure(event_info, trace);
break;
case MR_PORT_PRAGMA_FIRST:
case MR_PORT_PRAGMA_LATER:
- break;
+ fatal_error("MR_trace_decl_debug: "
+ "foreign language code is not handled (yet)");
case MR_PORT_EXCEPTION:
fatal_error("MR_trace_decl_debug: "
"exceptions are not handled (yet)");
default:
fatal_error("MR_trace_decl_debug: unknown port");
}
+ MR_decl_checkpoint_alloc(trace);
+ MR_trace_current_node = trace;
if (MR_trace_event_number == MR_edt_last_event) {
switch (MR_trace_decl_mode) {
@@ -288,8 +369,8 @@
return NULL;
}
-static void
-MR_trace_decl_call(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_call(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
Word atom;
@@ -298,16 +379,20 @@
atom = MR_decl_make_atom(layout, event_info->MR_saved_regs);
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_call_node(
- (Word) MR_trace_current_node, atom);
+ (Word) prev, atom,
+ (Word) event_info->MR_call_seqno);
);
+
+#ifdef MR_USE_DECL_STACK_SLOT
MR_trace_decl_set_slot(layout->MR_sll_entry,
event_info->MR_saved_regs, node);
+#endif
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_exit(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_exit(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
MR_Trace_Node call;
@@ -315,246 +400,325 @@
atom = MR_decl_make_atom(event_info->MR_event_sll,
event_info->MR_saved_regs);
+
+#ifdef MR_USE_DECL_STACK_SLOT
call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
event_info->MR_saved_regs);
+#else
+ call = MR_trace_matching_call(prev);
+ MR_decl_checkpoint_match(call);
+#endif
+
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_exit_node(
- (Word) MR_trace_current_node,
- (Word) call,
- MR_trace_call_node_answer(call),
- atom);
+ (Word) prev, (Word) call,
+ MR_trace_call_node_last_interface(call),
+ atom);
);
- MR_trace_call_node_answer(call) = (Word) node;
+ MR_trace_call_node_last_interface(call) = (Word) node;
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_redo(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_redo(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
MR_Trace_Node call;
+ MR_Trace_Node next;
+#ifdef MR_USE_DECL_STACK_SLOT
call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
event_info->MR_saved_regs);
+#else
+ /*
+ ** Search through previous contour for a matching EXIT event.
+ */
+ next = MR_trace_find_prev_contour(prev);
+ while (MR_trace_node_port(next) != MR_PORT_EXIT
+ || MR_trace_node_seqno(next) != event_info->MR_call_seqno)
+ {
+ next = MR_trace_step_left_in_context(next);
+ }
+ MR_decl_checkpoint_match(next);
+
+ MR_TRACE_CALL_MERCURY(
+ MR_trace_node_store++;
+ if (!MR_DD_trace_node_call(MR_trace_node_store, (Word) next,
+ (Word *) &call))
+ {
+ fatal_error("MR_trace_decl_redo: no matching EXIT");
+ }
+ );
+#endif /* !MR_USE_DECL_STACK_SLOT */
+
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_redo_node(
- (Word) MR_trace_current_node,
- MR_trace_call_node_answer(call));
+ (Word) prev,
+ MR_trace_call_node_last_interface(call));
);
- MR_trace_call_node_answer(call) = (Word) node;
+ MR_trace_call_node_last_interface(call) = (Word) node;
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_fail(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_fail(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
+ MR_Trace_Node next;
MR_Trace_Node call;
+ MR_Trace_Node redo;
+#ifdef MR_USE_DECL_STACK_SLOT
call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
event_info->MR_saved_regs);
+#else
+ if (MR_trace_node_port(prev) == MR_PORT_CALL)
+ {
+ /*
+ ** We are already at the corresponding call, so there
+ ** is no need to search for it.
+ */
+ call = prev;
+ }
+ else
+ {
+ next = MR_trace_find_prev_contour(prev);
+ call = MR_trace_matching_call(next);
+ }
+ MR_decl_checkpoint_match(call);
+#endif
+
+ redo = MR_trace_call_node_last_interface(call);
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_fail_node(
- (Word) MR_trace_current_node,
- (Word) call);
+ (Word) prev,
+ (Word) call,
+ (Word) redo);
);
- MR_trace_current_node = node;
+ MR_trace_call_node_last_interface(call) = (Word) node;
+ return node;
}
-static void
-MR_trace_decl_cond(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_cond(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_cond_node(
- (Word) MR_trace_current_node,
+ (Word) prev,
(String) event_info->MR_event_path);
);
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_then_else(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_then(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
- MR_Trace_Node prev;
+ MR_Trace_Node next;
+ MR_Trace_Node cond;
+ const char *path = event_info->MR_event_path;
- prev = MR_trace_current_node;
+ /*
+ ** Search through current contour for a matching COND event.
+ */
+ next = prev;
+ while (!MR_trace_matching_cond(path, next))
+ {
+ next = MR_trace_step_left_in_context(next);
+ }
+ cond = next;
+ MR_decl_checkpoint_match(cond);
+
+ MR_trace_cond_node_status(cond) = MR_TRACE_STATUS_SUCCEEDED;
+ MR_TRACE_CALL_MERCURY(
+ node = (MR_Trace_Node) MR_DD_construct_then_node(
+ (Word) prev,
+ (Word) cond);
+ );
+ return node;
+}
+
+static MR_Trace_Node
+MR_trace_decl_else(MR_Event_Info *event_info, MR_Trace_Node prev)
+{
+ MR_Trace_Node node;
+ MR_Trace_Node cond;
+ const char *path = event_info->MR_event_path;
+
/*
- ** Search through previous nodes for a matching COND event.
+ ** Search through previous contour for a matching COND event.
*/
- while (prev != (MR_Trace_Node) NULL)
+ if (MR_trace_matching_cond(path, prev))
+ {
+ cond = prev;
+ }
+ else
{
- if (MR_trace_matching_cond(event_info->MR_event_path, prev))
+ MR_Trace_Node next;
+
+ next = prev;
+ while (!MR_trace_matching_cond(path, next))
{
- break;
+ next = MR_trace_step_left_in_context(next);
}
- prev = MR_trace_scan_backwards(prev);
- }
- if (prev == (MR_Trace_Node) NULL) {
- fatal_error("MR_trace_decl_then_else: no matching COND");
+ cond = next;
}
+ MR_decl_checkpoint_match(cond);
- switch (event_info->MR_trace_port) {
- case MR_PORT_THEN:
- MR_trace_cond_node_status(prev) =
- MR_TRACE_STATUS_SUCCEEDED;
- MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node)
- MR_DD_construct_then_node(
- (Word) MR_trace_current_node,
- (Word) prev);
- );
- break;
- case MR_PORT_ELSE:
- MR_trace_cond_node_status(prev) =
- MR_TRACE_STATUS_FAILED;
- MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node)
- MR_DD_construct_else_node(
- (Word) MR_trace_current_node,
- (Word) prev);
- );
- break;
- default:
- fatal_error("MR_trace_decl_then_else: invalid node");
- break;
- }
-
- MR_trace_current_node = node;
+ MR_trace_cond_node_status(cond) = MR_TRACE_STATUS_FAILED;
+ MR_TRACE_CALL_MERCURY(
+ node = (MR_Trace_Node) MR_DD_construct_else_node(
+ (Word) prev,
+ (Word) cond);
+ );
+ return node;
}
-static void
-MR_trace_decl_enter_neg(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_neg_enter(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_neg_node(
- (Word) MR_trace_current_node,
+ (Word) prev,
(String) event_info->MR_event_path);
);
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_leave_neg(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_neg_success(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
- MR_Trace_Node prev;
+ MR_Trace_Node nege;
+ const char *path = event_info->MR_event_path;
- prev = MR_trace_current_node;
-
/*
- ** Search through previous nodes for a matching NEGE event.
+ ** Search through previous contour for a matching NEGE event.
*/
- while (prev != (MR_Trace_Node) NULL)
+ if (MR_trace_matching_neg(path, prev))
+ {
+ nege = MR_trace_current_node;
+ }
+ else
{
- if (MR_trace_matching_neg(event_info->MR_event_path, prev))
+ MR_Trace_Node next;
+
+ next = prev;
+ while (!MR_trace_matching_neg(path, next))
{
- break;
+ next = MR_trace_step_left_in_context(next);
}
- prev = MR_trace_scan_backwards(prev);
- }
- if (prev == (MR_Trace_Node) NULL) {
- fatal_error("MR_trace_decl_leave_neg: no matching NEGE");
+ nege = next;
}
+ MR_decl_checkpoint_match(nege);
- switch (event_info->MR_trace_port) {
- case MR_PORT_NEG_SUCCESS:
- MR_trace_neg_node_status(prev) =
- MR_TRACE_STATUS_SUCCEEDED;
- MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node)
- MR_DD_construct_neg_succ_node(
- (Word) MR_trace_current_node,
- (Word) prev);
- );
- break;
- case MR_PORT_NEG_FAILURE:
- MR_trace_neg_node_status(prev) =
- MR_TRACE_STATUS_FAILED;
- MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node)
- MR_DD_construct_neg_fail_node(
- (Word) MR_trace_current_node,
- (Word) prev);
- );
- break;
- default:
- fatal_error("MR_trace_decl_leave_neg: invalid node");
- break;
- }
-
- MR_trace_current_node = node;
+ MR_trace_neg_node_status(nege) = MR_TRACE_STATUS_SUCCEEDED;
+ MR_TRACE_CALL_MERCURY(
+ node = (MR_Trace_Node) MR_DD_construct_neg_succ_node(
+ (Word) prev,
+ (Word) nege);
+ );
+ return node;
}
-static void
-MR_trace_decl_switch(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_neg_failure(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
+ MR_Trace_Node next;
+ /*
+ ** Search through current context for a matching NEGE event.
+ */
+ next = prev;
+ while (!MR_trace_matching_neg(event_info->MR_event_path, next))
+ {
+ next = MR_trace_step_left_in_context(next);
+ }
+ MR_decl_checkpoint_match(next);
+
+ MR_trace_neg_node_status(next) = MR_TRACE_STATUS_FAILED;
MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
- (Word) MR_trace_current_node,
- (String) event_info->MR_event_path,
- (Word) TRUE);
+ node = (MR_Trace_Node) MR_DD_construct_neg_fail_node(
+ (Word) prev,
+ (Word) next);
);
- MR_trace_current_node = node;
+ return node;
}
-static void
-MR_trace_decl_disj(MR_Event_Info *event_info)
+static MR_Trace_Node
+MR_trace_decl_switch(MR_Event_Info *event_info, MR_Trace_Node prev)
{
MR_Trace_Node node;
- MR_Trace_Node prev;
- MR_Trace_Node back;
- prev = MR_trace_current_node;
+ MR_TRACE_CALL_MERCURY(
+ node = (MR_Trace_Node) MR_DD_construct_switch_node(
+ (Word) prev,
+ (String) event_info->MR_event_path);
+ );
+ return node;
+}
- /*
- ** Search through previous nodes for a matching DISJ event.
- */
- while (prev != (MR_Trace_Node) NULL)
+static MR_Trace_Node
+MR_trace_decl_disj(MR_Event_Info *event_info, MR_Trace_Node prev)
+{
+ MR_Trace_Node node;
+ const char *path = event_info->MR_event_path;
+
+ if (MR_trace_first_disjunct(event_info))
{
- if (MR_trace_matching_disj(event_info->MR_event_path, prev))
- {
- break;
- }
- prev = MR_trace_scan_backwards(prev);
+ MR_TRACE_CALL_MERCURY(
+ node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
+ (Word) prev,
+ (String) path);
+ );
}
+ else
+ {
+ MR_Trace_Node next;
+ MR_Trace_Node first;
- if (prev == (MR_Trace_Node) NULL) {
/*
- ** This is a first_disj.
+ ** Search through previous nodes for a matching DISJ event.
*/
- MR_TRACE_CALL_MERCURY(
- node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
- (Word) MR_trace_current_node,
- (String) event_info->MR_event_path,
- (Word) FALSE);
- );
- } else {
+ next = MR_trace_find_prev_contour(prev);
+ while (!MR_trace_matching_disj(path, next))
+ {
+ next = MR_trace_step_left_in_context(next);
+ }
+ MR_decl_checkpoint_match(next);
+
/*
- ** This is a later_disj.
+ ** Find the first disj event of this disjunction.
*/
- back = MR_trace_scan_backwards(prev);
+ first = MR_trace_node_first_disj(next);
+ if (first == (MR_Trace_Node) NULL)
+ {
+ first = next;
+ }
+
MR_TRACE_CALL_MERCURY(
node = (MR_Trace_Node) MR_DD_construct_later_disj_node(
- (Word) MR_trace_current_node,
- (Word) back,
- (String) event_info->MR_event_path);
+ MR_trace_node_store,
+ (Word) prev,
+ (String) path,
+ (Word) first);
);
}
- MR_trace_current_node = node;
+ return node;
}
+#ifdef MR_USE_DECL_STACK_SLOT
+
static MR_Trace_Node
MR_trace_decl_get_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs)
{
@@ -596,6 +760,47 @@
}
}
+#endif /* MR_USE_DECL_STACK_SLOT */
+
+static MR_Trace_Node
+MR_trace_matching_call(MR_Trace_Node node)
+{
+ MR_Trace_Node next;
+
+ /*
+ ** Search through contour for any CALL event. Since there
+ ** is only one CALL event which can be reached, we assume it
+ ** is the correct one.
+ */
+ next = node;
+ while (MR_trace_node_port(next) != MR_PORT_CALL)
+ {
+ next = MR_trace_step_left_in_context(next);
+ }
+ return next;
+}
+
+static bool
+MR_trace_first_disjunct(MR_Event_Info *event_info)
+{
+ const char *path;
+
+ /*
+ ** Return TRUE iff the last component of the path is "d1;".
+ */
+ path = event_info->MR_event_path;
+ while (*path)
+ {
+ if (MR_string_equal(path, "d1;"))
+ {
+ return TRUE;
+ }
+ path++;
+ }
+
+ return FALSE;
+}
+
static bool
MR_trace_matching_cond(const char *path, MR_Trace_Node node)
{
@@ -640,7 +845,7 @@
MR_TRACE_CALL_MERCURY(
port = (MR_Trace_Port) MR_DD_trace_node_port(node);
);
- if (port == MR_PORT_DISJ || port == MR_PORT_SWITCH) {
+ if (port == MR_PORT_DISJ) {
node_path = MR_trace_node_path(node);
return MR_trace_same_construct(path, node_path);
} else {
@@ -812,7 +1017,6 @@
Code **jumpaddr)
{
MR_Stack_Layout_Entry *entry;
- int decl_slot;
const char *message;
FILE *out;
@@ -821,11 +1025,12 @@
return FALSE;
}
- decl_slot = entry->MR_sle_maybe_decl_debug;
- if (decl_slot < 1) {
+#ifdef MR_USE_DECL_STACK_SLOT
+ if (entry->MR_sle_maybe_decl_debug < 1) {
/* No slots are reserved for declarative debugging */
return FALSE;
}
+#endif /* MR_USE_DECL_STACK_SLOT */
message = MR_trace_retry(event_info, event_details, jumpaddr);
if (message != NULL) {
@@ -871,6 +1076,13 @@
{
Word response;
+#if 0
+ /*
+ ** This is a quick and dirty way to debug the front end.
+ */
+ MR_trace_enabled = TRUE;
+#endif
+
MR_TRACE_CALL_MERCURY(
MR_DD_decl_diagnosis(MR_trace_node_store, root, &response,
MR_trace_front_end_state,
@@ -912,17 +1124,109 @@
return path;
}
+static MR_Trace_Port
+MR_trace_node_port(MR_Trace_Node node)
+{
+ MR_Trace_Port port;
+
+ MR_TRACE_CALL_MERCURY(
+ port = (MR_Trace_Port) MR_DD_trace_node_port((Word) node);
+ );
+ return port;
+}
+
+static Unsigned
+MR_trace_node_seqno(MR_Trace_Node node)
+{
+ Unsigned seqno;
+
+ MR_trace_node_store++;
+ MR_TRACE_CALL_MERCURY(
+ if (!MR_DD_trace_node_seqno(MR_trace_node_store,
+ (Word) node,
+ (Word *) &seqno))
+ {
+ fatal_error("MR_trace_node_seqno: "
+ "not an interface event");
+ }
+ );
+ return seqno;
+}
+
static MR_Trace_Node
-MR_trace_scan_backwards(MR_Trace_Node node)
+MR_trace_node_first_disj(MR_Trace_Node node)
{
- MR_Trace_Node prev;
+ MR_Trace_Node first;
+ MR_TRACE_CALL_MERCURY(
+ if (!MR_DD_trace_node_first_disj((Word) node, (Word *) &first))
+ {
+ fatal_error("MR_trace_node_first_disj: "
+ "not a DISJ event");
+ }
+ );
+ return first;
+}
+
+static MR_Trace_Node
+MR_trace_step_left_in_context(MR_Trace_Node node)
+{
+ MR_Trace_Node next;
+
+ MR_decl_checkpoint_step(node);
+
+ MR_trace_node_store++;
+ MR_TRACE_CALL_MERCURY(
+ next = (MR_Trace_Node) MR_DD_step_left_in_context(
+ MR_trace_node_store, node);
+ );
+ return next;
+}
+
+static MR_Trace_Node
+MR_trace_find_prev_contour(MR_Trace_Node node)
+{
+ MR_Trace_Node next;
+
+ MR_decl_checkpoint_find(node);
+
MR_trace_node_store++;
MR_TRACE_CALL_MERCURY(
- prev = (MR_Trace_Node) MR_DD_scan_backwards(
+ next = (MR_Trace_Node) MR_DD_find_prev_contour(
MR_trace_node_store, node);
);
- return prev;
+ return next;
}
+
+#ifdef MR_DEBUG_DD_BACK_END
+
+static void
+MR_decl_checkpoint_event_imp(MR_Event_Info *event_info)
+{
+ fprintf(MR_mdb_out, "DD EVENT %ld: #%ld %ld %s ",
+ (long) event_info->MR_event_number,
+ (long) event_info->MR_call_seqno,
+ (long) event_info->MR_call_depth,
+ MR_port_names[event_info->MR_trace_port]);
+ MR_print_proc_id(MR_mdb_out, event_info->MR_event_sll->MR_sll_entry);
+ fprintf(MR_mdb_out, "\n");
+}
+
+static void
+MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node)
+{
+ MercuryFile mdb_out;
+
+ mdb_out.file = MR_mdb_out;
+ mdb_out.line_number = 1;
+
+ fprintf(MR_mdb_out, "DD %s: %ld ", str, (long) node);
+ MR_TRACE_CALL_MERCURY(
+ MR_DD_print_trace_node((Word) &mdb_out, (Word) node);
+ );
+ fprintf(MR_mdb_out, "\n");
+}
+
+#endif /* MR_DEBUG_DD_BACK_END */
#endif /* defined(MR_USE_DECLARATIVE_DEBUGGER) */
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace_declarative.h
--- mercury_trace_declarative.h 2000/01/03 02:23:04 1.6
+++ mercury_trace_declarative.h 2000/02/07 01:13:24
@@ -37,7 +37,7 @@
typedef Word MR_Trace_Node;
-#define MR_trace_call_node_answer(node) \
+#define MR_trace_call_node_last_interface(node) \
MR_field(MR_mktag(0), (node), (Integer) 1)
#define MR_trace_cond_node_status(node) \
New file tests/debugger/declarative/backtrack.exp:
1: 1 1 CALL pred backtrack:main/2-0 (det) backtrack.m:8
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
0: + stop interface pred backtrack:p/2-0 (det)
mdb> continue
2: 2 2 CALL pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> finish
17: 2 2 EXIT pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> dd
atom("p", [univ(1 : int), univ(no : bool:bool)])
Valid? no
atom("q", [univ(1 : int), univ(1 : int)])
Valid? yes
atom("q", [univ(1 : int), univ(2 : int)])
Valid? yes
atom("q", [univ(1 : int), univ(3 : int)])
Valid? yes
Call atom("q", [univ(1 : int)])
Solutions:
atom("q", [univ(1 : int), univ(1 : int)])
atom("q", [univ(1 : int), univ(2 : int)])
atom("q", [univ(1 : int), univ(3 : int)])
Complete? yes
Incorrect node found:
wrong_answer(atom("p", [univ(1 : int), univ(no : bool:bool)]))
17: 2 2 EXIT pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> continue
no
New file tests/debugger/declarative/backtrack.inp:
echo on
register --quiet
break p
continue
finish
dd
no
yes
yes
yes
yes
continue
New file tests/debugger/declarative/backtrack.m:
:- module backtrack.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module std_util, int, bool.
main -->
{ p(1, R) },
io__write(R),
io__nl.
:- pred p(int::in, bool::out) is det.
p(N, R) :-
(
% some [M] (
M > 5,
q(N, M)
% )
->
R = yes
;
R = no
).
:- pred q(int::in, int::out) is nondet.
q(0, 0).
q(1, 1).
q(1, 2).
q(1, 3).
q(2, 2).
q(2, 4).
New file tests/debugger/declarative/aadebug.exp2:
1: 1 1 CALL pred aadebug:main/2-0 (det) aadebug.m:11
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
0: + stop interface pred aadebug:p/2-0 (nondet)
mdb> continue
3: 2 2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(30 : int)])
Valid? no
atom("q", [univ('a' : character), univ('a' : character)])
Valid? yes
atom("r", [univ('a' : character), univ(10 : int)])
Valid? yes
atom("s", [univ(10 : int), univ(30 : int)])
Valid? yes
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(30 : int)]))
15: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
20: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
22: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(31 : int)])
Valid? no
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(31 : int)]))
22: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
27: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
39: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(32 : int)])
Valid? no
atom("q", [univ('a' : character), univ('b' : character)])
Valid? yes
Call atom("r", [univ('b' : character)])
Solutions:
Complete? yes
Call atom("q", [univ('b' : character)])
Solutions:
Complete? yes
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(32 : int)]))
39: 2 2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
44: 2 2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
47: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
Call atom("p", [univ('a' : character)])
Solutions:
atom("p", [univ('a' : character), univ(30 : int)])
atom("p", [univ('a' : character), univ(31 : int)])
atom("p", [univ('a' : character), univ(32 : int)])
Complete? no
Call atom("q", [univ('a' : character)])
Solutions:
atom("q", [univ('a' : character), univ('a' : character)])
atom("q", [univ('a' : character), univ('b' : character)])
Complete? yes
Incorrect node found:
missing_answer(atom("p", [univ('a' : character)]), [atom("p", [univ('a' : character), univ(30 : int)]), atom("p", [univ('a' : character), univ(31 : int)]), atom("p", [univ('a' : character), univ(32 : int)])])
47: 2 2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
no
--
Mark Brown, PhD student )O+ | "Another of Fortran's breakthroughs
(m.brown at cs.mu.oz.au) | was the GOTO statement, which was...
Dept. of Computer Science and Software | uniquely simple and understandable"
Engineering, University of Melbourne | -- IEEE, 1994
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list