[m-rev.] for review: fix two bugs in the management of I/O tabling
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Sep 26 13:43:59 AEST 2007
On 24-Sep-2007, Ian MacLarty <maclarty at csse.unimelb.edu.au> wrote:
> I think your diagnosis and fix of the second bug is wrong. See below.
I agree; I was misremembering a problem I had before my break. The actual
problem is indeed different. This updated diff locates and marks the problem,
but I think you (Ian) and I should discuss the proper solution before any more
work is done.
I implemented your other suggestion. The updated log and diff follow.
(So much has changed that an interdiff would not be very useful.)
Zoltan.
-----------------------------------------------------------------------------
Fix a bug in the handling of I/O actions by the debugger: the procedural
debugger didn't implement the documented commands for printing I/O actions.
Also implement some new variants of the print commands to make it easier
to print I/O actions.
Also track down and pinpoint a bug that caused the declarative debugger
to ask questions from *outside* the tree it was asked to debug, as shown
by this example from a new test case compiled in a decldebug grade (so that
the library, and thus io.read, gets compiled with deep, not shallow tracing):
-----------------------------------------------------------------------------
mdb ./io_read_bug
1: 1 1 CALL pred io_read_bug.main/2-0 (cc_multi) io_read_bug.m:22
I/O tabling started.
mdb> g 4
Please input the number of queens and a period:
4: 3 2 CALL pred io.read/3-0 (det) io.m:4240 (io_read_bug.m:24)
mdb> f
5.
513: 3 2 EXIT pred io.read/3-0 (det) io.m:4240 (io_read_bug.m:24)
mdb> dd
[1, 3, 5, 2, 4]
main(_, _)
31 tabled IO actions: too many to show
Valid?
-----------------------------------------------------------------------------
browser/declarative_tree.m:
Put an XXX at the spot of the second bug.
browser/declarative_analyser.m:
browser/declarative_debugger.m:
Change the formatting of some code to give consistent and more
meaningful names to some arguments, and to make switches easier
to read. There are no algorithmic changes.
runtime/mercury_trace_base.[ch]:
Move the code for disabling/enabling deep profiling to the code that
does disabling/enabling of I/O actions, to put all relevant actions
for entering and leaving Mercury code together.
Note the similarity of MR_turn_debug_off/MR_turn_debug_back_on
with MR_TRACE_CALL_MERCURY, and make the similarity even greater
by adding the code for disabling/enabling deep profiling to
MR_TRACE_CALL_MERCURY (without which the deep profiler data structures
would have been screwed up by the declarative debugger).
Add a const qualifier to an argument.
trace/mercury_trace_cmd_browsing.c:
Fix the first bug: update the code of the "print" and "browse" mdb
commands to implement their documented capabilities with respect to
printing I/O actions.
Add a new capability: "print io" (or "print action") will now print
a bunch of I/O actions, starting with the first available one, and on
successive invocations will print successive bunches. This is an easy
way to print all I/O actions (without being overwhelmed by a huge
printout if there are too many).
Add a new capability: "print io limits" will now print the numbers of
the first and last I/O actions.
doc/user_guide.texi:
Document the new capabilities.
trace/mercury_trace_declarative.c:
Fix the second bug: disable debugging and then restore the old state
around calls to Mercury code from the declarative debugger.
My guess is that the bug was introduced when we gave declarative
debugging its own trace function; the one it used to share with
the procedural debugger still does the same disable/restore pair.
trace/mercury_trace_internal.c:
Delete the code now moved to mercury_trace_base.c.
trace/mercury_trace_util.[ch]:
Add a utility function for use by the new code in
mercury_trace_cmd_browsing.c, and increase robustness by more
precise representation of unsigned values.
trace/mercury_trace_cmd_dd.c:
Cosmetic fixes.
tests/debugger/declarative/tabled_read_decl.m:
Update this test case to our current coding standards. There are no
changes in the code.
tests/debugger/declarative/tabled_read_decl.{inp,out}:
Test the bug fixes by printing out a bunch of I/O actions.
tests/debugger/declarative/builtin_call_rep.exp:
Update this expected output file to conform for my recent change to
procedure representations.
tests/debugger/declarative/io_read_bug.{m,inp,exp}:
A new test case that exposes the second bug above. The .inp file
exposes the bug; the .exp file is a dummy.
tests/debugger/declarative/Mmakefile:
Add the new test case, but don't enable it yet.
tests/debugger/print_io_actions.{m,inp,exp,data}:
A new test case to test the new "print io" variant of the print
command.
tests/debugger/Mmakefile:
Enable the new test case.
tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug:
Expect the big_array_from_list test to fail in decldebug grades,
since we in that grade we can never get tail recursion, even in the
standard library.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.37
diff -u -b -r1.37 declarative_analyser.m
--- browser/declarative_analyser.m 19 Jan 2007 07:03:58 -0000 1.37
+++ browser/declarative_analyser.m 24 Sep 2007 16:02:03 -0000
@@ -299,8 +299,7 @@
%
:- type analyser_state(T)
---> analyser(
- % Information about the EDT nodes relevant to
- % the bug search.
+ % Information about the EDT nodes relevant to the bug search.
search_space :: search_space(T),
% This is set to yes when an explicit tree needs to be
@@ -318,17 +317,16 @@
% be used as the fallback search mode.
fallback_search_mode :: search_mode,
- % Everytime a search finds a suspect to ask the oracle
- % about it is put in this field before asking the oracle,
- % so the analyser knows how to modify the search space when
- % it gets an answer.
+ % Everytime a search finds a suspect to ask the oracle about,
+ % it is put in this field before asking the oracle, so the
+ % analyser knows how to modify the search space when it gets
+ % an answer.
last_search_question :: maybe(suspect_and_reason),
- % This field is present only to make it easier
- % to debug the dependency tracking algorithm;
- % if bound to yes, it records the result of
- % the invocation of that algorithm on the last
- % analysis step.
+ % This field is present only to make it easier to debug
+ % the dependency tracking algorithm; if bound to yes, it
+ % records the result of the invocation of that algorithm
+ % on the last analysis step.
debug_origin :: maybe(subterm_origin(T))
).
@@ -336,7 +334,6 @@
---> suspect_and_reason(suspect_id, reason_for_question).
:- type explicit_tree_type
-
---> explicit_subtree(suspect_id)
% Generate an explicit subtree for the implicit root
% referenced by the suspect_id.
@@ -474,37 +471,40 @@
:- pred process_answer(S::in, decl_answer(T)::in, suspect_id::in,
analyser_state(T)::in, analyser_state(T)::out) is det <= mercury_edt(S, T).
-process_answer(_, skip(_), SuspectId, !Analyser) :-
+process_answer(Store, Answer, SuspectId, !Analyser) :-
+ (
+ Answer = skip(_),
skip_suspect(SuspectId, !.Analyser ^ search_space, SearchSpace),
- !:Analyser = !.Analyser ^ search_space := SearchSpace.
-
-process_answer(Store, ignore(_), SuspectId, !Analyser) :-
- ignore_suspect(Store, SuspectId, !.Analyser ^ search_space, SearchSpace),
- !:Analyser = !.Analyser ^ search_space := SearchSpace.
-
-process_answer(_, truth_value(_, truth_correct), SuspectId, !Analyser) :-
+ !:Analyser = !.Analyser ^ search_space := SearchSpace
+ ;
+ Answer = ignore(_),
+ ignore_suspect(Store, SuspectId, !.Analyser ^ search_space,
+ SearchSpace),
+ !:Analyser = !.Analyser ^ search_space := SearchSpace
+ ;
+ Answer = truth_value(_, truth_correct),
assert_suspect_is_correct(SuspectId, !.Analyser ^ search_space,
SearchSpace),
- !:Analyser = !.Analyser ^ search_space := SearchSpace.
-
-process_answer(_, truth_value(_, truth_inadmissible), SuspectId, !Analyser) :-
+ !:Analyser = !.Analyser ^ search_space := SearchSpace
+ ;
+ Answer = truth_value(_, truth_inadmissible),
assert_suspect_is_inadmissible(SuspectId, !.Analyser ^ search_space,
SearchSpace),
- !:Analyser = !.Analyser ^ search_space := SearchSpace.
-
-process_answer(_, truth_value(_, truth_erroneous), SuspectId, !Analyser) :-
+ !:Analyser = !.Analyser ^ search_space := SearchSpace
+ ;
+ Answer = truth_value(_, truth_erroneous),
assert_suspect_is_erroneous(SuspectId, !.Analyser ^ search_space,
SearchSpace),
- !:Analyser = !.Analyser ^ search_space := SearchSpace.
+ !:Analyser = !.Analyser ^ search_space := SearchSpace
+ ;
+ Answer = suspicious_subterm(Node, ArgPos, TermPath, HowTrack,
+ ShouldAssertInvalid),
-process_answer(Store, suspicious_subterm(Node, ArgPos, TermPath, HowTrack,
- ShouldAssertInvalid), SuspectId, !Analyser) :-
- %
% XXX The following 2 lines just done so that debugging info can be
% printed for tests run when declarative_analyser.m not compiled with
% tracing (so can't use dd_dd command in mdb). Should be removed when
% edt_dependency becomes stable enough.
- %
+
edt_dependency(Store, Node, ArgPos, TermPath, _, DebugOrigin),
!:Analyser = !.Analyser ^ debug_origin := yes(DebugOrigin),
(
@@ -524,7 +524,9 @@
ShouldAssertInvalid = no_assert_invalid
),
!:Analyser = !.Analyser ^ search_mode :=
- analyser_follow_subterm_end(SuspectId, ArgPos, TermPath, no, HowTrack).
+ analyser_follow_subterm_end(SuspectId, ArgPos, TermPath, no,
+ HowTrack)
+ ).
revise_analysis(Store, Response, !Analyser) :-
SearchSpace = !.Analyser ^ search_space,
@@ -553,8 +555,9 @@
"Start of decide_analyser_response"),
some [!SearchSpace] (
!:SearchSpace = !.Analyser ^ search_space,
- search(Store, Oracle, !SearchSpace, !.Analyser ^ search_mode,
- !.Analyser ^ fallback_search_mode, NewMode, SearchResponse),
+ search_for_question(Store, Oracle, !SearchSpace,
+ !.Analyser ^ search_mode, !.Analyser ^ fallback_search_mode,
+ NewMode, SearchResponse),
!:Analyser = !.Analyser ^ search_space := !.SearchSpace,
!:Analyser = !.Analyser ^ search_mode := NewMode,
handle_search_response(Store, SearchResponse, !Analyser, Response)
@@ -566,8 +569,9 @@
analyser_state(T)::in, analyser_state(T)::out,
analyser_response(T)::out) is det <= mercury_edt(S, T).
-handle_search_response(Store, search_response_question(SuspectId, Reason),
- !Analyser, Response) :-
+handle_search_response(Store, SearchResponse, !Analyser, AnalyserResponse) :-
+ (
+ SearchResponse = search_response_question(SuspectId, Reason),
SearchSpace = !.Analyser ^ search_space,
Node = get_edt_node(SearchSpace, SuspectId),
edt_question(Store, Node, OracleQuestion),
@@ -578,7 +582,8 @@
suspect_skipped(SearchSpace, SuspectId)
)
->
- Response = analyser_response_oracle_question(OracleQuestion)
+ AnalyserResponse =
+ analyser_response_oracle_question(OracleQuestion)
;
suspect_ignored(SearchSpace, SuspectId)
->
@@ -591,37 +596,38 @@
% wants the oracle to be requeried. This may happen if the
% search thinks the user might have answered the question
% incorrectly before.
- Response = analyser_response_revise(OracleQuestion)
+ AnalyserResponse = analyser_response_revise(OracleQuestion)
),
!:Analyser = !.Analyser ^ last_search_question :=
- yes(suspect_and_reason(SuspectId, Reason)).
-
-handle_search_response(_, search_response_require_explicit_subtree(SuspectId),
- !Analyser, Response) :-
+ yes(suspect_and_reason(SuspectId, Reason))
+ ;
+ SearchResponse = search_response_require_explicit_subtree(SuspectId),
!:Analyser = !.Analyser ^ require_explicit := yes(explicit_subtree(
SuspectId)),
Node = get_edt_node(!.Analyser ^ search_space, SuspectId),
- Response = analyser_response_require_explicit_subtree(Node).
-
-handle_search_response(_, search_response_require_explicit_supertree,
- !Analyser, Response) :-
+ AnalyserResponse = analyser_response_require_explicit_subtree(Node)
+ ;
+ SearchResponse = search_response_require_explicit_supertree,
!:Analyser = !.Analyser ^ require_explicit := yes(explicit_supertree),
SearchSpace = !.Analyser ^ search_space,
topmost_det(SearchSpace, TopMostId),
TopMost = get_edt_node(SearchSpace, TopMostId),
- Response = analyser_response_require_explicit_supertree(TopMost).
-
-handle_search_response(_, search_response_no_suspects, !Analyser,
- analyser_response_no_suspects).
-
-handle_search_response(Store,
- search_response_found_bug(BugId, CorrectDescendents,
- InadmissibleChildren), !Analyser, Response) :-
+ AnalyserResponse =
+ analyser_response_require_explicit_supertree(TopMost)
+ ;
+ SearchResponse = search_response_no_suspects,
+ AnalyserResponse = analyser_response_no_suspects
+ ;
+ SearchResponse = search_response_found_bug(BugId, CorrectDescendents,
+ InadmissibleChildren),
bug_response(Store, !.Analyser ^ search_space, BugId,
- [BugId | CorrectDescendents], InadmissibleChildren, Response).
+ [BugId | CorrectDescendents], InadmissibleChildren,
+ AnalyserResponse)
+ ).
% bug_response(Store, SearchSpace, BugId, Evidence,
- % InadmissibleChildren, Response)
+ % InadmissibleChildren, Response):
+ %
% Create a bug analyser-response using the given Evidence. If
% InadmissibleChildren isn't empty then an i_bug will be created,
% otherwise an e_bug will be created.
@@ -656,48 +662,45 @@
% that the search algorithm being used can remember its current state
% next time round.
%
-:- pred search(S::in, oracle_state::in,
+:- pred search_for_question(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out,
search_mode::in, search_mode::in,
search_mode::out, search_response::out) is det <= mercury_edt(S, T).
-search(Store, Oracle, !SearchSpace, analyser_top_down, FallBackSearchMode,
+search_for_question(Store, Oracle, !SearchSpace, OldMode, FallBackSearchMode,
NewMode, Response) :-
+ (
+ OldMode = analyser_top_down,
top_down_search(Store, Oracle, !SearchSpace, Response),
% We always go back to the fallback search mode after a top-down
% search, because some fallback searches (such as divide and query)
% use top-down as a fail safe and we want the fallback search to
% resume after the top-down search.
- NewMode = FallBackSearchMode.
-
-search(Store, Oracle, !SearchSpace, SearchMode, FallBackSearchMode,
- NewMode, Response) :-
- SearchMode = analyser_follow_subterm_end(SuspectId, ArgPos, TermPath,
+ NewMode = FallBackSearchMode
+ ;
+ OldMode = analyser_follow_subterm_end(SuspectId, ArgPos, TermPath,
LastUnknown, HowTrack),
follow_subterm_end_search(Store, Oracle, !SearchSpace, HowTrack,
LastUnknown, SuspectId, ArgPos, TermPath, FallBackSearchMode,
- NewMode, Response).
-
-search(Store, Oracle, !SearchSpace, SearchMode, FallBackSearchMode, NewMode,
- Response) :-
- SearchMode = analyser_binary(PathArray, Top - Bottom, LastTested),
+ NewMode, Response)
+ ;
+ OldMode = analyser_binary(PathArray, Top - Bottom, LastTested),
binary_search(Store, Oracle, PathArray, Top, Bottom, LastTested,
- !SearchSpace, FallBackSearchMode, NewMode, Response).
-
-search(Store, Oracle, !SearchSpace, analyser_divide_and_query(Weighting), _,
- NewMode, Response) :-
+ !SearchSpace, FallBackSearchMode, NewMode, Response)
+ ;
+ OldMode = analyser_divide_and_query(Weighting),
divide_and_query_search(Store, Oracle, Weighting, !SearchSpace,
- Response, NewMode).
+ Response, NewMode)
+ ).
:- pred top_down_search(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out,
search_response::out) is det <= mercury_edt(S, T).
top_down_search(Store, Oracle, !SearchSpace, Response) :-
- %
% If there's no root yet (because the oracle hasn't asserted any nodes
% are erroneous yet) then use the topmost suspect as a starting point.
- %
+
( root(!.SearchSpace, RootId) ->
Start = RootId
;
@@ -716,13 +719,12 @@
Response = search_response_question(SkippedSuspect,
ques_reason_skipped)
;
- % Since the are no skipped suspects and no unknown
- % suspects in the search space, if there is a root
- % (i.e. an erroneous suspect), then it must be a bug.
- % Note that only top down search actually checks if a
- % bug was found. This is okay, since all the other
- % search algorithms call top down search if they can't
- % find an unknown suspect.
+ % Since the are no skipped suspects and no unknown suspects
+ % in the search space, if there is a root (i.e. an erroneous
+ % suspect), then it must be a bug. Note that only top down search
+ % actually checks if a bug was found. This is okay, since all the
+ % other search algorithms call top down search if they can't find
+ % an unknown suspect.
root(!.SearchSpace, BugId)
->
(
@@ -835,8 +837,9 @@
SearchResponse = search_response_question(Unknown, Reason),
NewMode = FallBackSearchMode
;
- search(Store, Oracle, !SearchSpace, FallBackSearchMode,
- FallBackSearchMode, NewMode, SearchResponse)
+ search_for_question(Store, Oracle, !SearchSpace,
+ FallBackSearchMode, FallBackSearchMode, NewMode,
+ SearchResponse)
)
)
;
@@ -849,7 +852,7 @@
ques_reason_subterm_no_proc_rep),
NewMode = FallBackSearchMode
;
- search(Store, Oracle, !SearchSpace,
+ search_for_question(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode,
NewMode, SearchResponse)
)
@@ -896,19 +899,17 @@
ques_reason_binding_node_eliminated),
NewMode = FallBackSearchMode
;
- search(Store, Oracle, !SearchSpace,
+ search_for_question(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode,
NewMode, SearchResponse)
)
;
- %
% This recursive call will not lead to an infinite loop
% because eventually either the sub-term will be bound
- % (and find_subterm_origin will respond with
- % primitive_op/3) or there will be insufficient tracing
- % information to continue (and find_subterm_origin will
- % respond with not_found).
- %
+ % (and find_subterm_origin will respond with primitive_op/3)
+ % or there will be insufficient tracing information to continue
+ % (and find_subterm_origin will respond with not_found).
+
follow_subterm_end_search_2(Store, Oracle, !SearchSpace, HowTrack,
!TriedShortcutProcs, NewLastUnknown, OriginId,
OriginArgPos, OriginTermPath,
@@ -916,11 +917,12 @@
)
).
- % setup_binary_search(SearchSpace, SuspectId, SearchMode).
+ % setup_binary_search(SearchSpace, SuspectId, SearchMode):
+ %
% Sets up the search mode to do a binary search between SuspectId
- % and either the root of the search space if a suspect has
- % previously been marked erroneous, or the topmost node if no suspect
- % has yet been marked erroneous.
+ % and either the root of the search space if a suspect has previously been
+ % marked erroneous, or the topmost node if no suspect has yet been marked
+ % erroneous.
%
:- pred setup_binary_search(search_space(T)::in, suspect_id::in,
search_mode::out) is det.
@@ -950,10 +952,9 @@
binary_search(Store, Oracle, PathArray, Top, Bottom, LastTested,
!SearchSpace, FallBackSearchMode, NewMode, Response) :-
SuspectId = PathArray ^ elem(LastTested),
- %
+
% Check what the result of the query about LastTested was and adjust
% the range appropriately.
- %
(
% The oracle answered `erroneous'.
suspect_in_excluded_complement(!.SearchSpace, SuspectId)
@@ -975,7 +976,7 @@
NewTop > NewBottom
->
% Revert to the fallback search mode when binary search is over.
- search(Store, Oracle, !SearchSpace,
+ search_for_question(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode, NewMode, Response)
;
(
@@ -988,9 +989,9 @@
PathArray ^ elem(UnknownClosestToMiddle),
ques_reason_binary(NewBottom, NewTop, UnknownClosestToMiddle))
;
- % No unknown suspects on the path, so revert to
- % the fallback search mode.
- search(Store, Oracle, !SearchSpace,
+ % No unknown suspects on the path, so revert to the fallback
+ % search mode.
+ search_for_question(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode, NewMode, Response)
)
).
@@ -1115,9 +1116,8 @@
MaybeLastUnknown, !SearchSpace, Response) :-
TopWeight = get_weight(!.SearchSpace, TopId),
Target = TopWeight // 2,
- %
- % Find the heaviest suspect:
- %
+
+ % Find the heaviest suspect.
Weight = get_weight(!.SearchSpace, SuspectId),
list.foldl2(max_weight(!.SearchSpace), SuspectIds,
Weight, MaxWeight, SuspectId, Heaviest),
@@ -1136,10 +1136,9 @@
suspect_still_unknown(!.SearchSpace, LastUnknown)
->
LastUnknownWeight = get_weight(!.SearchSpace, LastUnknown),
- %
- % If the last unknown suspect was closer to
- % the target weight then ask about it.
- %
+
+ % If the last unknown suspect was closer to the target weight,
+ % then ask about it.
( LastUnknownWeight - Target < Target - MaxWeight ->
Response = search_response_question(LastUnknown,
ques_reason_divide_and_query(Weighting, TopWeight,
@@ -1201,7 +1200,6 @@
reason_to_string(ques_reason_start) =
"this is the node where the `dd' command was issued.".
-
reason_to_string(ques_reason_binding_node(PrimOpType, FileName, LineNo,
MaybePath, ProcLabel, Eliminated)) = Str :-
PrimOpStr = primitive_op_type_to_string(PrimOpType),
@@ -1238,18 +1236,14 @@
" " ++ Module ++ "." ++ Name ++ "/" ++ ArityStr ++
" (" ++ FileName ++ ":" ++ LineNoStr ++ "). " ++
PathSent ++ EliminatedSent.
-
reason_to_string(ques_reason_top_down) =
"this is the next node in the top-down search.".
-
reason_to_string(ques_reason_subterm_no_proc_rep) =
"tracking of the marked subterm had to be aborted here, because of "
++ "missing tracing information.".
-
reason_to_string(ques_reason_binding_node_eliminated) =
"tracking of the marked subterm was stopped here, because the binding "
++ "node lies in a portion of the tree which has been eliminated.".
-
reason_to_string(ques_reason_binary(Bottom, Top, Split)) = Str :-
PathLengthStr = int_to_string_thousands(Bottom - Top + 1),
SubPath1LengthStr = int_to_string_thousands(Bottom - Split),
@@ -1257,15 +1251,12 @@
Str = "this node divides a path of length " ++ PathLengthStr
++ " into two paths of length " ++
SubPath1LengthStr ++ " and " ++ SubPath2LengthStr ++ ".".
-
reason_to_string(ques_reason_divide_and_query(Weighting, OldWeight,
SubtreeWeight)) =
weighting_to_reason_string(Weighting, OldWeight - SubtreeWeight,
SubtreeWeight).
-
reason_to_string(ques_reason_skipped) =
"there are no more non-skipped questions left.".
-
reason_to_string(ques_reason_revise) =
"this question is being revisited, because of "
++ "an unsuccessful previous bug search.".
@@ -1277,7 +1268,6 @@
Weight2Str = int_to_string_thousands(Weight2),
Str = "this node divides the suspect area into two regions of "
++ Weight1Str ++ " and " ++ Weight2Str ++ " events each.".
-
weighting_to_reason_string(suspicion, Weight1, Weight2) = Str :-
Weight1Str = int_to_string_thousands(Weight1),
Weight2Str = int_to_string_thousands(Weight2),
@@ -1290,9 +1280,8 @@
some [!FieldNames, !Data] (
!:FieldNames = [],
!:Data = [],
- %
+
% Get the context of the current question.
- %
(
Analyser ^ last_search_question =
yes(suspect_and_reason(LastId, Reason)),
@@ -1337,18 +1326,16 @@
Analyser ^ search_mode =
analyser_divide_and_query(number_of_events)
->
- list.append(!.FieldNames, ["Estimated questions remaining"],
- !:FieldNames),
+ !:FieldNames = !.FieldNames ++
+ ["Estimated questions remaining"],
EstimatedQuestions = float.ceiling_to_int(
math.log2(float(Weight))),
- list.append(!.Data, [int_to_string(EstimatedQuestions)],
- !:Data)
+ !:Data = !.Data ++ [int_to_string(EstimatedQuestions)]
;
true
),
- list.append(!.FieldNames, ["Number of suspect events"],
- !:FieldNames),
- list.append(!.Data, [int_to_string_thousands(Weight)], !:Data)
+ !:FieldNames = !.FieldNames ++ ["Number of suspect events"],
+ !:Data = !.Data ++ [int_to_string_thousands(Weight)]
;
true
),
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.75
diff -u -b -r1.75 declarative_debugger.m
--- browser/declarative_debugger.m 8 Jun 2007 15:43:15 -0000 1.75
+++ browser/declarative_debugger.m 24 Sep 2007 16:02:36 -0000
@@ -408,16 +408,17 @@
diagnoser_state(R)::in, diagnoser_state(R)::out,
io::di, io::uo) is cc_multi <= annotated_trace(S, R).
-handle_analyser_response(_, analyser_response_no_suspects, _, no_bug_found,
- !Diagnoser, !IO) :-
- io.write_string("No bug found.\n", !IO).
-
-handle_analyser_response(Store, analyser_response_bug_found(Bug, Evidence), _,
- Response, !Diagnoser, !IO) :-
- confirm_bug(Store, Bug, Evidence, Response, !Diagnoser, !IO).
-
-handle_analyser_response(Store, analyser_response_oracle_question(Question),
- MaybeOrigin, Response, !Diagnoser, !IO) :-
+handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ DiagnoserResponse, !Diagnoser, !IO) :-
+ (
+ AnalyserResponse = analyser_response_no_suspects,
+ DiagnoserResponse = no_bug_found,
+ io.write_string("No bug found.\n", !IO)
+ ;
+ AnalyserResponse = analyser_response_bug_found(Bug, Evidence),
+ confirm_bug(Store, Bug, Evidence, DiagnoserResponse, !Diagnoser, !IO)
+ ;
+ AnalyserResponse = analyser_response_oracle_question(Question),
Oracle0 = !.Diagnoser ^ oracle_state,
debug_origin(Flag, !IO),
(
@@ -440,12 +441,10 @@
true
),
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
- handle_oracle_response(Store, OracleResponse, Response, !Diagnoser,
- !IO).
-
-handle_analyser_response(Store,
- analyser_response_require_explicit_subtree(Node), _, Response,
- Diagnoser, Diagnoser, !IO) :-
+ handle_oracle_response(Store, OracleResponse, DiagnoserResponse,
+ !Diagnoser, !IO)
+ ;
+ AnalyserResponse = analyser_response_require_explicit_subtree(Node),
edt_subtree_details(Store, Node, Event, Seqno, CallPreceding),
( trace_implicit_tree_info(wrap(Store), Node, ImplicitTreeInfo) ->
ImplicitTreeInfo = implicit_tree_info(IdealDepth)
@@ -453,40 +452,40 @@
throw(internal_error("handle_analyser_response",
"subtree requested for node which is not an implicit root"))
),
- Response = require_subtree(Event, Seqno, CallPreceding, IdealDepth).
-
-handle_analyser_response(Store,
- analyser_response_require_explicit_supertree(Node), _,
- Response, Diagnoser, Diagnoser, !IO) :-
+ DiagnoserResponse = require_subtree(Event, Seqno, CallPreceding,
+ IdealDepth)
+ ;
+ AnalyserResponse = analyser_response_require_explicit_supertree(Node),
edt_subtree_details(Store, Node, Event, Seqno, _),
- Response = require_supertree(Event, Seqno).
-
-handle_analyser_response(Store, analyser_response_revise(Question), _,
- Response, !Diagnoser, !IO) :-
+ DiagnoserResponse = require_supertree(Event, Seqno)
+ ;
+ AnalyserResponse = analyser_response_revise(Question),
Oracle0 = !.Diagnoser ^ oracle_state,
revise_oracle(Question, Oracle0, Oracle),
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
handle_analyser_response(Store,
- analyser_response_oracle_question(Question), no, Response,
- !Diagnoser, !IO).
+ analyser_response_oracle_question(Question), no, DiagnoserResponse,
+ !Diagnoser, !IO)
+ ).
:- pred handle_oracle_response(S::in, oracle_response(edt_node(R))::in,
diagnoser_response(R)::out, diagnoser_state(R)::in,
- diagnoser_state(R)::out, io::di, io::uo)
- is cc_multi <= annotated_trace(S, R).
+ diagnoser_state(R)::out, io::di, io::uo) is cc_multi
+ <= annotated_trace(S, R).
-handle_oracle_response(Store, oracle_response_answer(Answer), Response,
- !Diagnoser, !IO) :-
+handle_oracle_response(Store, OracleResponse, DiagnoserResponse, !Diagnoser,
+ !IO) :-
+ (
+ OracleResponse = oracle_response_answer(Answer),
Analyser0 = !.Diagnoser ^ analyser_state,
continue_analysis(wrap(Store), !.Diagnoser ^ oracle_state, Answer,
AnalyserResponse, Analyser0, Analyser),
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
- Response, !Diagnoser, !IO).
-
-handle_oracle_response(Store, oracle_response_show_info(OutStream), Response,
- !Diagnoser, !IO) :-
+ DiagnoserResponse, !Diagnoser, !IO)
+ ;
+ OracleResponse = oracle_response_show_info(OutStream),
Analyser = !.Diagnoser ^ analyser_state,
show_info(wrap(Store), OutStream, Analyser, !IO),
( reask_last_question(wrap(Store), Analyser, AnalyserResponse0) ->
@@ -497,10 +496,9 @@
),
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
- Response, !Diagnoser, !IO).
-
-handle_oracle_response(Store, oracle_response_change_search(Mode), Response,
- !Diagnoser, !IO) :-
+ DiagnoserResponse, !Diagnoser, !IO)
+ ;
+ OracleResponse = oracle_response_change_search(Mode),
Analyser0 = !.Diagnoser ^ analyser_state,
Oracle = !.Diagnoser ^ oracle_state,
change_search_mode(wrap(Store), Oracle, Mode, Analyser0, Analyser,
@@ -508,10 +506,9 @@
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
- Response, !Diagnoser, !IO).
-
-handle_oracle_response(Store, oracle_response_undo, Response,
- !Diagnoser, !IO) :-
+ DiagnoserResponse, !Diagnoser, !IO)
+ ;
+ OracleResponse = oracle_response_undo,
( pop_diagnoser(!.Diagnoser, PoppedDiagnoser) ->
!:Diagnoser = PoppedDiagnoser
;
@@ -530,16 +527,16 @@
),
debug_analyser_state(!.Diagnoser ^ analyser_state, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
- Response, !Diagnoser, !IO).
-
-handle_oracle_response(Store, oracle_response_exit_diagnosis(Node), Response,
- !Diagnoser, !IO) :-
+ DiagnoserResponse, !Diagnoser, !IO)
+ ;
+ OracleResponse = oracle_response_exit_diagnosis(Node),
edt_subtree_details(Store, Node, Event, _, _),
- Response = symptom_found(Event).
-
-handle_oracle_response(_, oracle_response_abort_diagnosis, no_bug_found,
- !Diagnoser, !IO) :-
- io.write_string("Diagnosis aborted.\n", !IO).
+ DiagnoserResponse = symptom_found(Event)
+ ;
+ OracleResponse = oracle_response_abort_diagnosis,
+ DiagnoserResponse = no_bug_found,
+ io.write_string("Diagnosis aborted.\n", !IO)
+ ).
:- pred confirm_bug(S::in, decl_bug::in, decl_evidence(T)::in,
diagnoser_response(R)::out, diagnoser_state(R)::in,
@@ -826,7 +823,7 @@
handle_diagnoser_exception(io_error(Loc, Msg), Response, !Diagnoser, !IO) :-
io.stderr_stream(StdErr, !IO),
- io.write_string(StdErr, "I/O error: "++Loc++": "++Msg++".\n"++
+ io.write_string(StdErr, "I/O error: " ++ Loc ++ ": " ++ Msg ++ ".\n" ++
"Diagnosis will be aborted.\n", !IO),
% Reset the analyser, in case it was left in an inconsistent state.
reset_analyser(!.Diagnoser ^ analyser_state, Analyser),
@@ -835,10 +832,10 @@
handle_diagnoser_exception(unimplemented_feature(Feature), Response,
!Diagnoser, !IO) :-
- io.write_string("Sorry, the diagnosis cannot continue because "++
- "it requires support for\n"++
- "the following: "++Feature++".\n"++
- "The debugger is a work in progress, and this is not "++
+ io.write_string("Sorry, the diagnosis cannot continue because " ++
+ "it requires support for\n" ++
+ "the following: " ++ Feature ++ ".\n" ++
+ "The debugger is a work in progress, and this is not " ++
"supported in the\ncurrent version.\n", !IO),
% Reset the analyser, in case it was left in an inconsistent state.
reset_analyser(!.Diagnoser ^ analyser_state, Analyser),
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.51
diff -u -b -r1.51 declarative_tree.m
--- browser/declarative_tree.m 12 Sep 2007 06:21:05 -0000 1.51
+++ browser/declarative_tree.m 24 Sep 2007 16:00:11 -0000
@@ -273,7 +273,8 @@
;
Node = node_excp(_, CallId, _, _, _, _, _)
),
- % The node is topmost of the call sequence number is 1.
+ % XXX This is buggy: see the io_read_bug test case.
+ % The node is topmost if the call sequence number is 1.
call_node_from_id(Store, CallId, node_call(_, _, _, 1, _, _, _, _, _, _)).
:- pred trace_children(wrap(S)::in, edt_node(R)::in, list(edt_node(R))::out)
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.544
diff -u -b -r1.544 user_guide.texi
--- doc/user_guide.texi 12 Sep 2007 06:21:12 -0000 1.544
+++ doc/user_guide.texi 24 Sep 2007 04:34:25 -0000
@@ -4826,6 +4826,14 @@
@item print io @var{n}- at var{m}
Print the @var{n}th to @var{m}th IO actions (inclusive).
@sp 1
+ at item print io limits
+Print the values for which @samp{print @var{n}} makes sense.
+ at sp 1
+ at item print io
+Print some I/O actions,
+starting just after the last action printed (if there was one)
+or at the first available action (if there was not).
+ at sp 1
@item format @var{format}
Set the default format to @var{format},
which should be one of @samp{flat}, @samp{verbose} and @samp{pretty}.
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.83
diff -u -b -r1.83 mercury_trace_base.c
--- runtime/mercury_trace_base.c 12 Sep 2007 06:21:16 -0000 1.83
+++ runtime/mercury_trace_base.c 24 Sep 2007 15:33:55 -0000
@@ -1052,6 +1052,9 @@
/**************************************************************************/
/*
** This section of this file deals with switching debugging on and off.
+**
+** XXX The code here is very similar to MR_TRACE_CALL_MERCURY in the header
+** file. Look into merging the two pieces of code.
*/
void
@@ -1075,10 +1078,14 @@
saved_state->MR_sds_trace_call_seqno = MR_trace_call_seqno;
saved_state->MR_sds_trace_call_depth = MR_trace_call_depth;
saved_state->MR_sds_trace_event_number = MR_trace_event_number;
+
+#if defined(MR_DEEP_PROFILING) && defined(MR_EXEC_TRACE)
+ MR_disable_deep_profiling_in_debugger = MR_TRUE;
+#endif
}
void
-MR_turn_debug_back_on(MR_SavedDebugState *saved_state)
+MR_turn_debug_back_on(const MR_SavedDebugState *saved_state)
{
int i;
@@ -1086,7 +1093,7 @@
MR_update_trace_func_enabled();
MR_io_tabling_enabled = saved_state->MR_sds_io_tabling_enabled;
- for (i = 0; i < MR_MAXFLAG ; i++) {
+ for (i = 0; i < MR_MAXFLAG; i++) {
MR_debugflag[i] = saved_state->MR_sds_debugflags[i];
}
@@ -1095,6 +1102,10 @@
MR_trace_call_depth = saved_state->MR_sds_trace_call_depth;
MR_trace_event_number = saved_state->MR_sds_trace_event_number;
}
+
+#if defined(MR_DEEP_PROFILING) && defined(MR_EXEC_TRACE)
+ MR_disable_deep_profiling_in_debugger = MR_FALSE;
+#endif
}
/**************************************************************************/
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.61
diff -u -b -r1.61 mercury_trace_base.h
--- runtime/mercury_trace_base.h 12 Sep 2007 06:21:16 -0000 1.61
+++ runtime/mercury_trace_base.h 24 Sep 2007 15:33:56 -0000
@@ -545,7 +545,7 @@
extern void MR_turn_off_debug(MR_SavedDebugState *saved_state,
MR_bool include_counter_vars);
-extern void MR_turn_debug_back_on(MR_SavedDebugState *saved_state);
+extern void MR_turn_debug_back_on(const MR_SavedDebugState *saved_state);
/*
** These functions allow library/exceptions.m to tell the debuggers
@@ -665,15 +665,38 @@
** to call save_registers() and restore_registers() around it.
** That in turn needs to be preceded/followed by
** restore/save_transient_registers() if it is in a C function.
+**
+** We also need to ensure that Mercury code called from the debugger
+** doesn't screw up the data structures belonging to the program being
+** debugged.
+**
+** XXX The code here is very similar to MR_turn_off_debug/MR_turn_debug_back_on
+** in the source file. Look into merging the two pieces of code.
*/
-#define MR_TRACE_CALL_MERCURY(STATEMENTS) do { \
+#if defined(MR_DEEP_PROFILING) && defined(MR_EXEC_TRACE)
+ #define MR_TRACE_CALL_MERCURY_DEEP_BEGIN \
+ do { \
+ MR_disable_deep_profiling_in_debugger = MR_TRUE; \
+ } while (0)
+ #define MR_TRACE_CALL_MERCURY_DEEP_END \
+ do { \
+ MR_disable_deep_profiling_in_debugger = MR_FALSE; \
+ } while (0)
+#else
+ #define MR_TRACE_CALL_MERCURY_DEEP_BEGIN ((void) 0)
+ #define MR_TRACE_CALL_MERCURY_DEEP_END ((void) 0)
+#endif
+
+#define MR_TRACE_CALL_MERCURY(STATEMENTS) \
+ do { \
MR_bool saved_debug_enabled; \
MR_bool saved_io_enabled; \
MR_Unsigned saved_trace_call_seqno; \
MR_Unsigned saved_trace_call_depth; \
MR_Unsigned saved_trace_event_number; \
\
+ MR_TRACE_CALL_MERCURY_DEEP_BEGIN; \
saved_debug_enabled = MR_debug_enabled; \
saved_io_enabled = MR_io_tabling_enabled; \
saved_trace_call_seqno = MR_trace_call_seqno; \
@@ -693,6 +716,7 @@
MR_trace_call_seqno = saved_trace_call_seqno; \
MR_trace_call_depth = saved_trace_call_depth; \
MR_trace_event_number = saved_trace_event_number; \
+ MR_TRACE_CALL_MERCURY_DEEP_END; \
} while (0)
#endif /* MERCURY_TRACE_BASE_H */
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
Index: tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug
===================================================================
RCS file: tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug
diff -N tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug 24 Sep 2007 07:15:32 -0000
@@ -0,0 +1 @@
+hard_coded/big_array_from_list
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.138
diff -u -b -r1.138 Mmakefile
--- tests/debugger/Mmakefile 31 Jul 2007 07:58:45 -0000 1.138
+++ tests/debugger/Mmakefile 26 Sep 2007 02:42:02 -0000
@@ -45,6 +45,7 @@
poly_io_retry2 \
polymorphic_output \
print_goal \
+ print_io_actions \
print_table \
queens_rep \
resume_typeinfos \
@@ -456,6 +457,12 @@
print_goal.out: print_goal print_goal.inp
$(MDB_STD) ./print_goal < print_goal.inp > print_goal.out 2>&1
+print_io_actions.out: print_io_actions print_io_actions.inp \
+ print_io_actions.data
+ $(MDB_STD) ./print_io_actions < print_io_actions.inp | \
+ sed 's/c_pointer(0x[0-9A-Fa-f]*)/c_pointer(0xXXXX)/g' \
+ > print_io_actions.out 2>&1
+
print_table.out: print_table print_table.inp
$(MDB_STD) ./print_table < print_table.inp > print_table.out 2>&1
Index: tests/debugger/print_io_actions.data
===================================================================
RCS file: tests/debugger/print_io_actions.data
diff -N tests/debugger/print_io_actions.data
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/print_io_actions.data 26 Sep 2007 02:38:57 -0000
@@ -0,0 +1,24 @@
+*Contractor -* A gambler who never gets to shuffle, cut or deal.
+
+*Bid Opening -* A poker game in which the losing hand wins.
+
+*Bid -* A wild guess carried out to two decimal places.
+
+*Low Bidder -* A contractor who is wondering what he left out.
+
+*Engineer's Estimate -* The cost of construction in heaven.
+
+*Project Manager -* The conductor of an orchestra in which every
+musician is in a different union.
+
+*Critical Path Method -* A management technique for losing your shirt
+under perfect control.
+
+*OSHA -* A protective coating made by half-baking a mixture of fine
+print, *red tape, split hairs and baloney--usually applied at random
+with a shotgun.
+
+*Strike -* An effort to increase egg production by strangling the
+chicken.
+
+*Delayed Payment -* A tourniquet applied at the pockets.
Index: tests/debugger/print_io_actions.exp
===================================================================
RCS file: tests/debugger/print_io_actions.exp
diff -N tests/debugger/print_io_actions.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/print_io_actions.exp 26 Sep 2007 02:45:08 -0000
@@ -0,0 +1,91 @@
+ E1: C1 CALL pred print_io_actions.main/2-0 (det) print_io_actions.m:20
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> b fake_read_n_chars
+ 0: + stop interface pred print_io_actions.fake_read_n_chars/5-0 (det)
+mdb> c
+ E2: C2 CALL pred print_io_actions.fake_read_n_chars/5-0 (det) print_io_actions.m:35 (print_io_actions.m:23)
+mdb> f -n -S
+ E3: C2 EXIT pred print_io_actions.fake_read_n_chars/5-0 (det) print_io_actions.m:35 (print_io_actions.m:23)
+mdb> print io
+action 0: fake_open_input("print_io_actions.data", 0, c_pointer(0xXXXX))
+action 1: fake_read_char_code(c_pointer(0xXXXX), 42)
+action 2: fake_read_char_code(c_pointer(0xXXXX), 67)
+action 3: fake_read_char_code(c_pointer(0xXXXX), 111)
+action 4: fake_read_char_code(c_pointer(0xXXXX), 110)
+action 5: fake_read_char_code(c_pointer(0xXXXX), 116)
+action 6: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 7: fake_read_char_code(c_pointer(0xXXXX), 97)
+action 8: fake_read_char_code(c_pointer(0xXXXX), 99)
+action 9: fake_read_char_code(c_pointer(0xXXXX), 116)
+action 10: fake_read_char_code(c_pointer(0xXXXX), 111)
+action 11: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 12: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 13: fake_read_char_code(c_pointer(0xXXXX), 45)
+action 14: fake_read_char_code(c_pointer(0xXXXX), 42)
+action 15: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 16: fake_read_char_code(c_pointer(0xXXXX), 65)
+action 17: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 18: fake_read_char_code(c_pointer(0xXXXX), 103)
+action 19: fake_read_char_code(c_pointer(0xXXXX), 97)
+action 20: fake_read_char_code(c_pointer(0xXXXX), 109)
+there are more actions, up to action 40
+mdb> print io
+action 21: fake_read_char_code(c_pointer(0xXXXX), 98)
+action 22: fake_read_char_code(c_pointer(0xXXXX), 108)
+action 23: fake_read_char_code(c_pointer(0xXXXX), 101)
+action 24: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 25: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 26: fake_read_char_code(c_pointer(0xXXXX), 119)
+action 27: fake_read_char_code(c_pointer(0xXXXX), 104)
+action 28: fake_read_char_code(c_pointer(0xXXXX), 111)
+action 29: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 30: fake_read_char_code(c_pointer(0xXXXX), 110)
+action 31: fake_read_char_code(c_pointer(0xXXXX), 101)
+action 32: fake_read_char_code(c_pointer(0xXXXX), 118)
+action 33: fake_read_char_code(c_pointer(0xXXXX), 101)
+action 34: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 35: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 36: fake_read_char_code(c_pointer(0xXXXX), 103)
+action 37: fake_read_char_code(c_pointer(0xXXXX), 101)
+action 38: fake_read_char_code(c_pointer(0xXXXX), 116)
+action 39: fake_read_char_code(c_pointer(0xXXXX), 115)
+action 40: fake_read_char_code(c_pointer(0xXXXX), 32)
+there are no more actions (yet)
+mdb> s
+ E4: C3 CALL pred print_io_actions.fake_read_n_chars/5-0 (det) print_io_actions.m:35 (print_io_actions.m:24)
+mdb> f -n -S
+ E5: C3 EXIT pred print_io_actions.fake_read_n_chars/5-0 (det) print_io_actions.m:35 (print_io_actions.m:24)
+mdb> p io 0
+fake_open_input("print_io_actions.data", 0, c_pointer(0xXXXX))
+mdb> p io
+action 1: fake_read_char_code(c_pointer(0xXXXX), 42)
+action 2: fake_read_char_code(c_pointer(0xXXXX), 67)
+action 3: fake_read_char_code(c_pointer(0xXXXX), 111)
+action 4: fake_read_char_code(c_pointer(0xXXXX), 110)
+action 5: fake_read_char_code(c_pointer(0xXXXX), 116)
+action 6: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 7: fake_read_char_code(c_pointer(0xXXXX), 97)
+action 8: fake_read_char_code(c_pointer(0xXXXX), 99)
+action 9: fake_read_char_code(c_pointer(0xXXXX), 116)
+action 10: fake_read_char_code(c_pointer(0xXXXX), 111)
+action 11: fake_read_char_code(c_pointer(0xXXXX), 114)
+action 12: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 13: fake_read_char_code(c_pointer(0xXXXX), 45)
+action 14: fake_read_char_code(c_pointer(0xXXXX), 42)
+action 15: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 16: fake_read_char_code(c_pointer(0xXXXX), 65)
+action 17: fake_read_char_code(c_pointer(0xXXXX), 32)
+action 18: fake_read_char_code(c_pointer(0xXXXX), 103)
+action 19: fake_read_char_code(c_pointer(0xXXXX), 97)
+action 20: fake_read_char_code(c_pointer(0xXXXX), 109)
+action 21: fake_read_char_code(c_pointer(0xXXXX), 98)
+there are more actions, up to action 80
+mdb> c
+*Contractor -* A gambler who never gets to shuffle, cut or deal.
+
+*Bid Opening -
Index: tests/debugger/print_io_actions.inp
===================================================================
RCS file: tests/debugger/print_io_actions.inp
diff -N tests/debugger/print_io_actions.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/print_io_actions.inp 26 Sep 2007 02:45:06 -0000
@@ -0,0 +1,14 @@
+echo on
+register --quiet
+table_io allow
+table_io start
+b fake_read_n_chars
+c
+f -n -S
+print io
+print io
+s
+f -n -S
+p io 0
+p io
+c
Index: tests/debugger/print_io_actions.m
===================================================================
RCS file: tests/debugger/print_io_actions.m
diff -N tests/debugger/print_io_actions.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/print_io_actions.m 26 Sep 2007 02:42:39 -0000
@@ -0,0 +1,91 @@
+% vim: ts=4 sw=4 et ft=mercury
+% We define our own I/O primitives, in case the library was compiled without
+% IO tabling.
+
+:- module print_io_actions.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module char.
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ fake_open_input("print_io_actions.data", Res, Stream, !IO),
+ ( Res = 0 ->
+ fake_read_n_chars(Stream, 40, CharList1, !IO),
+ fake_read_n_chars(Stream, 40, CharList2, !IO),
+ Str = string.from_char_list(CharList1 ++ CharList2),
+ io.write_string(Str, !IO),
+ io.nl(!IO)
+ ;
+ io.write_string("could not open print_io_actions.data\n", !IO)
+ ).
+
+:- pred fake_read_n_chars(c_pointer::in, int::in, list(char)::out,
+ io::di, io::uo) is det.
+
+fake_read_n_chars(Stream, N, Chars, !IO) :-
+ ( N =< 0 ->
+ Chars = []
+ ;
+ fake_read_char_code(Stream, CharCode, !IO),
+ ( CharCode = -1 ->
+ Chars = []
+ ;
+ Char = char.det_from_int(CharCode),
+ fake_read_n_chars(Stream, N - 1, TailChars, !IO),
+ Chars = [Char | TailChars]
+ )
+ ).
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred fake_open_input(string::in, int::out, c_pointer::out, io::di, io::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ fake_open_input(FileName::in, Res::out, Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ Stream = (MR_Word) fopen((const char *) FileName, ""r"");
+ Res = Stream? 0 : -1;
+ IO = IO0;
+").
+
+:- pred fake_read_char_code(c_pointer::in, int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ fake_read_char_code(Stream::in, CharCode::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred fake_write_int(int::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ fake_write_int(N::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+ printf(""%d\\n"", (int) N);
+ IO = IO0;
+}").
+
+:- pred fake_io(int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ fake_io(X::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+ X = 1;
+ IO = IO0;
+}").
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.99
diff -u -b -r1.99 Mmakefile
--- tests/debugger/declarative/Mmakefile 6 Jun 2007 01:48:09 -0000 1.99
+++ tests/debugger/declarative/Mmakefile 24 Sep 2007 15:12:31 -0000
@@ -98,6 +98,7 @@
shallow
NONWORKING_DECLARATIVE_PROGS= \
+ io_read_bug
# Some of the test cases require a different input in debug or decldebug
# grades, so we set DEBUG_INP and DECLDEBUG_INP to the appropriate extension to
@@ -387,6 +388,10 @@
> input_term_dep.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
+io_read_bug.out: io_read_bug io_read_bug.inp
+ $(MDB_STD) ./io_read_bug < io_read_bug.inp > io_read_bug.out 2>&1 \
+ || { grep . $@ /dev/null; exit 1; }
+
io_stream_test.out: io_stream_test io_stream_test.inp
$(MDB_STD) ./io_stream_test < io_stream_test.inp \
> io_stream_test.out 2>&1 \
Index: tests/debugger/declarative/builtin_call_rep.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/builtin_call_rep.exp,v
retrieving revision 1.3
diff -u -b -r1.3 builtin_call_rep.exp
--- tests/debugger/declarative/builtin_call_rep.exp 20 May 2005 05:40:21 -0000 1.3
+++ tests/debugger/declarative/builtin_call_rep.exp 24 Sep 2007 05:52:17 -0000
@@ -5,7 +5,7 @@
mdb> step
E2: C2 CALL func int.+/2-0 (det)
mdb> print proc_body
- proc_rep([1, 2, 3], atomic_goal_rep(det_rep, "int.m", NN, [3], builtin_call_rep/3))
+ proc_defn_rep([1, 2, 3], atomic_goal_rep(det_rep, "int.m", NN, [3], builtin_call_rep/3))
mdb> browse proc_body
browser> cd 2
browser> ls
Index: tests/debugger/declarative/io_read_bug.exp
===================================================================
RCS file: tests/debugger/declarative/io_read_bug.exp
diff -N tests/debugger/declarative/io_read_bug.exp
Index: tests/debugger/declarative/io_read_bug.inp
===================================================================
RCS file: tests/debugger/declarative/io_read_bug.inp
diff -N tests/debugger/declarative/io_read_bug.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_read_bug.inp 24 Sep 2007 15:28:15 -0000
@@ -0,0 +1,9 @@
+table_io allow
+table_io start
+break -A io.read
+c
+f
+5.
+dd
+abort
+quit -y
Index: tests/debugger/declarative/io_read_bug.m
===================================================================
RCS file: tests/debugger/declarative/io_read_bug.m
diff -N tests/debugger/declarative/io_read_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_read_bug.m 24 Sep 2007 15:27:02 -0000
@@ -0,0 +1,119 @@
+% vim: ts=4 sw=4 et ft=mercury
+%
+% This program is a test case for a bug that causes the declarative debugger
+% to ask questions about a node outside the subtree it was asked to debug.
+% In this case, the .inp file asks it to debug the subtree of the call to
+% io.read, and yet it asks about main.
+
+:- module io_read_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module prolog.
+
+main(!IO) :-
+ io.write_string("Please input the number of queens and a period:\n", !IO),
+ io.read(NRes, !IO),
+ (
+ NRes = ok(N),
+ iota(N, RevData),
+ list.reverse(RevData, Data),
+ ( queen(Data, Out) ->
+ print_list(Out, !IO)
+ ;
+ io.write_string("No solution\n", !IO)
+ )
+ ;
+ NRes = error(Msg, _LineNumber),
+ io.write_string(Msg, !IO)
+ ;
+ NRes = eof,
+ io.write_string("eof", !IO)
+ ).
+
+:- pred iota(int::in, list(int)::out) is det.
+
+iota(N, List) :-
+ ( N =< 0 ->
+ List = []
+ ;
+ iota(N - 1, Tail),
+ List = [N | Tail]
+ ).
+
+:- pred queen(list(int)::in, list(int)::out) is nondet.
+
+queen(Data, Out) :-
+ qperm(Data, Out),
+ safe(Out).
+
+:- pred qperm(list(int)::in, list(int)::out) is nondet.
+
+qperm([], []).
+qperm([X|Y], K) :-
+ qdelete(U, [X|Y], Z),
+ K = [U|V],
+ qperm(Z, V).
+
+:- pred qdelete(int::out, list(int)::in, list(int)::out) is nondet.
+
+qdelete(A, [A|L], L).
+qdelete(X, [A|Z], [A|R]) :-
+ qdelete(X, Z, R).
+
+:- pred safe(list(int)::in) is semidet.
+
+safe([]).
+safe([N|L]) :-
+ nodiag(N, 1, L),
+ safe(L).
+
+:- pred nodiag(int::in, int::in, list(int)::in) is semidet.
+
+nodiag(_, _, []).
+nodiag(B, D, [N|L]) :-
+ NmB is N - B,
+ BmN is B - N,
+ ( D = NmB ->
+ fail
+ ; D = BmN ->
+ fail
+ ;
+ true
+ ),
+ D1 is D + 1,
+ nodiag(B, D1, L).
+
+:- pred print_list(list(int)::in, io::di, io::uo) is det.
+
+print_list(Xs, !IO) :-
+ (
+ Xs = [],
+ io.write_string("[]\n", !IO)
+ ;
+ Xs = [_ | _],
+ io.write_string("[", !IO),
+ print_list_2(Xs, !IO),
+ io.write_string("]\n", !IO)
+ ).
+
+:- pred print_list_2(list(int)::in, io::di, io::uo) is det.
+
+print_list_2([], !IO).
+print_list_2([X | Xs], !IO) :-
+ io.write_int(X, !IO),
+ (
+ Xs = []
+ ;
+ Xs = [_ | _],
+ io.write_string(", ", !IO),
+ print_list_2(Xs, !IO)
+ ).
Index: tests/debugger/declarative/tabled_read_decl.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/tabled_read_decl.exp,v
retrieving revision 1.17
diff -u -b -r1.17 tabled_read_decl.exp
--- tests/debugger/declarative/tabled_read_decl.exp 22 Aug 2006 02:33:52 -0000 1.17
+++ tests/debugger/declarative/tabled_read_decl.exp 25 Sep 2007 10:33:37 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred tabled_read_decl.main/2-0 (det) tabled_read_decl.m:17
+ E1: C1 CALL pred tabled_read_decl.main/2-0 (det) tabled_read_decl.m:19
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -118,6 +118,36 @@
write_int(1789)
Is this a bug? y
E7: C3 EXIT pred tabled_read_decl.part_2/3-0 (det)
+mdb> print io limits
+I/O tabling has recorded actions 0 to 15.
+mdb> print io
+action 0: open_input("tabled_read_decl.data", 0, c_pointer(0xXXXX))
+action 1: read_char_code(c_pointer(0xXXXX), 49)
+action 2: read_char_code(c_pointer(0xXXXX), 50)
+action 3: read_char_code(c_pointer(0xXXXX), 51)
+action 4: read_char_code(c_pointer(0xXXXX), 10)
+action 5: write_int(1123)
+action 6: poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 52)
+action 7: poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 53)
+action 8: poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 54)
+action 9: poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 10)
+action 10: write_int(1456)
+action 11: read_char_code(c_pointer(0xXXXX), 55)
+action 12: read_char_code(c_pointer(0xXXXX), 56)
+action 13: read_char_code(c_pointer(0xXXXX), 57)
+action 14: read_char_code(c_pointer(0xXXXX), 10)
+action 15: write_int(1789)
+there are no more actions (yet)
+mdb> print io 8
+poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 54)
+mdb> print action 10-12
+action 10: write_int(1456)
+action 11: read_char_code(c_pointer(0xXXXX), 55)
+action 12: read_char_code(c_pointer(0xXXXX), 56)
+mdb> browse io 9
+browser> p
+poly_read_char_code(list(character), c_pointer(0xXXXX), ['a', 'b', 'c'], 10)
+browser> quit
mdb> break tabled_read_decl.part_3
0: + stop interface pred tabled_read_decl.part_3/2-0 (det)
mdb> c
Index: tests/debugger/declarative/tabled_read_decl.inp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/tabled_read_decl.inp,v
retrieving revision 1.7
diff -u -b -r1.7 tabled_read_decl.inp
--- tests/debugger/declarative/tabled_read_decl.inp 4 Apr 2006 07:37:24 -0000 1.7
+++ tests/debugger/declarative/tabled_read_decl.inp 24 Sep 2007 04:27:10 -0000
@@ -32,6 +32,13 @@
n
y
y
+print io limits
+print io
+print io 8
+print action 10-12
+browse io 9
+p
+quit
break tabled_read_decl.part_3
c
break tabled_read_decl.fake_io
Index: tests/debugger/declarative/tabled_read_decl.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/tabled_read_decl.m,v
retrieving revision 1.3
diff -u -b -r1.3 tabled_read_decl.m
--- tests/debugger/declarative/tabled_read_decl.m 6 Apr 2005 01:11:31 -0000 1.3
+++ tests/debugger/declarative/tabled_read_decl.m 24 Sep 2007 01:58:00 -0000
@@ -1,3 +1,4 @@
+% vim: ts=4 sw=4 et ft=mercury
% We define our own I/O primitives, in case the library was compiled without
% IO tabling.
@@ -7,97 +8,95 @@
:- import_module io.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module list, char, int.
-
-main -->
- tabled_read_decl__open_input("tabled_read_decl.data", Res, Stream),
- ( { Res = 0 } ->
- tabled_read_decl__part_1(Stream),
- tabled_read_decl__part_2(Stream),
- tabled_read_decl__part_3
+:- import_module list.
+:- import_module char.
+:- import_module int.
+
+main(!IO) :-
+ tabled_read_decl.open_input("tabled_read_decl.data", Res, Stream, !IO),
+ ( Res = 0 ->
+ tabled_read_decl.part_1(Stream, !IO),
+ tabled_read_decl.part_2(Stream, !IO),
+ tabled_read_decl.part_3(!IO)
;
- io__write_string("could not open tabled_read.data\n")
+ io.write_string("could not open tabled_read.data\n", !IO)
).
-:- pred tabled_read_decl__part_1(c_pointer::in, io__state::di, io__state::uo)
- is det.
+:- pred tabled_read_decl.part_1(c_pointer::in, io::di, io::uo) is det.
-tabled_read_decl__part_1(Stream) -->
- tabled_read_decl__test(Stream, A),
- tabled_read_decl__write_int(A),
- tabled_read_decl__poly_test(Stream, ['a', 'b', 'c'], B),
- tabled_read_decl__write_int(B).
+tabled_read_decl.part_1(Stream, !IO) :-
+ tabled_read_decl.test(Stream, A, !IO),
+ tabled_read_decl.write_int(A, !IO),
+ tabled_read_decl.poly_test(Stream, ['a', 'b', 'c'], B, !IO),
+ tabled_read_decl.write_int(B, !IO).
-:- pred tabled_read_decl__part_2(c_pointer::in, io__state::di, io__state::uo)
- is det.
+:- pred tabled_read_decl.part_2(c_pointer::in, io::di, io::uo) is det.
-tabled_read_decl__part_2(Stream) -->
- tabled_read_decl__test(Stream, A),
- tabled_read_decl__write_int(A).
+tabled_read_decl.part_2(Stream, !IO) :-
+ tabled_read_decl.test(Stream, A, !IO),
+ tabled_read_decl.write_int(A, !IO).
-:- pred tabled_read_decl__part_3(io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.part_3(io::di, io::uo) is det.
-tabled_read_decl__part_3(!IO) :-
- tabled_read_decl__fake_io(X, !IO),
- tabled_read_decl__write_int(X, !IO).
+tabled_read_decl.part_3(!IO) :-
+ tabled_read_decl.fake_io(X, !IO),
+ tabled_read_decl.write_int(X, !IO).
-:- pred tabled_read_decl__test(c_pointer::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.test(c_pointer::in, int::out, io::di, io::uo) is det.
-tabled_read_decl__test(Stream, N) -->
+tabled_read_decl.test(Stream, N, !IO) :-
% BUG: the 1 should be 0
- tabled_read_decl__test_2(Stream, 1, N).
+ tabled_read_decl.test_2(Stream, 1, N, !IO).
-:- pred tabled_read_decl__test_2(c_pointer::in, int::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.test_2(c_pointer::in, int::in, int::out,
+ io::di, io::uo) is det.
-tabled_read_decl__test_2(Stream, SoFar, N) -->
- tabled_read_decl__read_char_code(Stream, CharCode),
+tabled_read_decl.test_2(Stream, SoFar, N, !IO) :-
+ tabled_read_decl.read_char_code(Stream, CharCode, !IO),
(
- { char__to_int(Char, CharCode) },
- { char__is_digit(Char) },
- { char__digit_to_int(Char, CharInt) }
+ char.to_int(Char, CharCode),
+ char.is_digit(Char),
+ char.digit_to_int(Char, CharInt)
->
- tabled_read_decl__test_2(Stream, SoFar * 10 + CharInt, N)
+ tabled_read_decl.test_2(Stream, SoFar * 10 + CharInt, N, !IO)
;
- { N = SoFar }
+ N = SoFar
).
-:- pred tabled_read_decl__poly_test(c_pointer::in, T::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.poly_test(c_pointer::in, T::in, int::out,
+ io::di, io::uo) is det.
-tabled_read_decl__poly_test(Stream, Unused, N) -->
+tabled_read_decl.poly_test(Stream, Unused, N, !IO) :-
% BUG: the 1 should be 0
- tabled_read_decl__poly_test_2(Stream, Unused, 1, N).
+ tabled_read_decl.poly_test_2(Stream, Unused, 1, N, !IO).
-:- pred tabled_read_decl__poly_test_2(c_pointer::in, T::in, int::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.poly_test_2(c_pointer::in, T::in, int::in, int::out,
+ io::di, io::uo) is det.
-tabled_read_decl__poly_test_2(Stream, Unused, SoFar, N) -->
- tabled_read_decl__poly_read_char_code(Stream, Unused, CharCode),
+tabled_read_decl.poly_test_2(Stream, Unused, SoFar, N, !IO) :-
+ tabled_read_decl.poly_read_char_code(Stream, Unused, CharCode, !IO),
(
- { char__to_int(Char, CharCode) },
- { char__is_digit(Char) },
- { char__digit_to_int(Char, CharInt) }
+ char.to_int(Char, CharCode),
+ char.is_digit(Char),
+ char.digit_to_int(Char, CharInt)
->
- tabled_read_decl__poly_test_2(Stream, Unused,
- SoFar * 10 + CharInt, N)
+ tabled_read_decl.poly_test_2(Stream, Unused, SoFar * 10 + CharInt, N,
+ !IO)
;
- { N = SoFar }
+ N = SoFar
).
:- pragma c_header_code("#include <stdio.h>").
-:- pred tabled_read_decl__open_input(string::in, int::out, c_pointer::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.open_input(string::in, int::out, c_pointer::out,
+ io::di, io::uo) is det.
:- pragma foreign_proc("C",
- tabled_read_decl__open_input(FileName::in, Res::out, Stream::out,
+ tabled_read_decl.open_input(FileName::in, Res::out, Stream::out,
IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
@@ -106,11 +105,11 @@
IO = IO0;
").
-:- pred tabled_read_decl__read_char_code(c_pointer::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.read_char_code(c_pointer::in, int::out,
+ io::di, io::uo) is det.
:- pragma foreign_proc("C",
- tabled_read_decl__read_char_code(Stream::in, CharCode::out,
+ tabled_read_decl.read_char_code(Stream::in, CharCode::out,
IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
@@ -118,11 +117,11 @@
IO = IO0;
").
-:- pred tabled_read_decl__poly_read_char_code(c_pointer::in, T::in, int::out,
- io__state::di, io__state::uo) is det.
+:- pred tabled_read_decl.poly_read_char_code(c_pointer::in, T::in, int::out,
+ io::di, io::uo) is det.
:- pragma foreign_proc("C",
- tabled_read_decl__poly_read_char_code(Stream::in, Unused::in,
+ tabled_read_decl.poly_read_char_code(Stream::in, Unused::in,
CharCode::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
@@ -131,21 +130,20 @@
IO = IO0;
").
-:- pred tabled_read_decl__write_int(int::in, io__state::di, io__state::uo)
- is det.
+:- pred tabled_read_decl.write_int(int::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- tabled_read_decl__write_int(N::in, IO0::di, IO::uo),
+ tabled_read_decl.write_int(N::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
printf(""%d\\n"", (int) N);
IO = IO0;
}").
-:- pred tabled_read_decl__fake_io(int::out, io::di, io::uo) is det.
+:- pred tabled_read_decl.fake_io(int::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- tabled_read_decl__fake_io(X::out, IO0::di, IO::uo),
+ tabled_read_decl.fake_io(X::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
X = 1;
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_cmd_browsing.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_browsing.c,v
retrieving revision 1.7
diff -u -b -r1.7 mercury_trace_cmd_browsing.c
--- trace/mercury_trace_cmd_browsing.c 12 Sep 2007 06:21:20 -0000 1.7
+++ trace/mercury_trace_cmd_browsing.c 25 Sep 2007 07:24:30 -0000
@@ -179,13 +179,20 @@
return KEEP_INTERACTING;
}
+#define MR_MAX_NUM_IO_ACTIONS_TO_PRINT 20
+
MR_Next
MR_trace_cmd_print(char **words, int word_count, MR_TraceCmdInfo *cmd,
MR_EventInfo *event_info, MR_Code **jumpaddr)
{
MR_BrowseFormat format;
MR_bool xml;
- int n;
+ const char *problem;
+ MR_Unsigned action;
+ MR_Unsigned lo_action;
+ MR_Unsigned hi_action;
+ static MR_bool have_next_io_action = MR_FALSE;
+ static MR_Unsigned next_io_action = 0;
if (! MR_trace_options_format(&format, &xml, &words, &word_count)) {
; /* the usage message has already been printed */
@@ -193,8 +200,6 @@
/* the --xml option is not valid for print */
MR_trace_usage_cur_cmd();
} else if (word_count == 1) {
- const char *problem;
-
problem = MR_trace_browse_one_goal(MR_mdb_out,
MR_trace_browse_goal_internal, MR_BROWSE_CALLER_PRINT, format);
@@ -203,8 +208,6 @@
fprintf(MR_mdb_err, "mdb: %s.\n", problem);
}
} else if (word_count == 2) {
- const char *problem;
-
if (MR_streq(words[1], "*")) {
problem = MR_trace_browse_all(MR_mdb_out,
MR_trace_browse_internal, format);
@@ -217,6 +220,76 @@
} else if (MR_streq(words[1], "proc_body")) {
problem = MR_trace_browse_proc_body(event_info,
MR_trace_browse_internal, MR_BROWSE_CALLER_PRINT, format);
+ } else if ((MR_streq(words[1], "io") || MR_streq(words[1], "action")))
+ {
+ MR_Unsigned num_printed_actions;
+
+ if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "mdb: I/O tabling has not yet started.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm);
+ return KEEP_INTERACTING;
+ }
+
+ if (MR_io_tabling_counter_hwm == 0) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "mdb: There are no tabled I/O actions yet.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm);
+ return KEEP_INTERACTING;
+ }
+
+ if (have_next_io_action && (!
+ (MR_io_tabling_start <= next_io_action
+ && next_io_action < MR_io_tabling_counter_hwm)))
+ {
+ have_next_io_action = MR_FALSE;
+ }
+
+ if (have_next_io_action) {
+ lo_action = next_io_action;
+ } else {
+ lo_action = MR_io_tabling_start;
+ }
+
+ hi_action = lo_action + MR_MAX_NUM_IO_ACTIONS_TO_PRINT;
+ if (hi_action >= MR_io_tabling_counter_hwm) {
+ hi_action = MR_io_tabling_counter_hwm - 1;
+ }
+
+ num_printed_actions = hi_action - lo_action + 1;
+ if (num_printed_actions <= 0) {
+ fprintf(MR_mdb_out, "There are no I/O actions to print\n");
+ have_next_io_action = MR_FALSE;
+ } else {
+ for (action = lo_action; action <= hi_action; action++) {
+ fprintf(MR_mdb_out,
+ "action %" MR_INTEGER_LENGTH_MODIFIER "u: ", action);
+ problem = MR_trace_browse_action(MR_mdb_out, action,
+ MR_trace_browse_goal_internal,
+ MR_BROWSE_CALLER_PRINT, format);
+
+ if (problem != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "mdb: %s.\n", problem);
+ return KEEP_INTERACTING;
+ }
+ }
+
+ if (hi_action == MR_io_tabling_counter_hwm - 1) {
+ fprintf(MR_mdb_out,
+ "there are no more actions (yet)\n");
+ } else {
+ fprintf(MR_mdb_out,
+ "there are more actions, up to action "
+ "%" MR_INTEGER_LENGTH_MODIFIER "u\n",
+ MR_io_tabling_counter_hwm - 1);
+ }
+
+ next_io_action = hi_action + 1;
+ have_next_io_action = MR_TRUE;
+ }
} else {
problem = MR_trace_parse_browse_one(MR_mdb_out, MR_TRUE, words[1],
MR_trace_browse_internal, MR_BROWSE_CALLER_PRINT, format,
@@ -227,18 +300,88 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: %s.\n", problem);
}
- } else if (word_count == 3 && MR_streq(words[1], "action")
- && MR_trace_is_natural_number(words[2], &n))
+ } else if (word_count == 3 &&
+ (MR_streq(words[1], "io") || MR_streq(words[1], "action")))
{
- const char *problem;
+ if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "mdb: I/O tabling has not yet started.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm);
+ return KEEP_INTERACTING;
+ }
+
+ if (MR_io_tabling_counter_hwm == 0) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "mdb: There are no tabled I/O actions yet.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm);
+ return KEEP_INTERACTING;
+ }
+
+ if (MR_streq(words[2], "limits")) {
+ fprintf(MR_mdb_out,
+ "I/O tabling has recorded actions "
+ "%" MR_INTEGER_LENGTH_MODIFIER "u to "
+ "%" MR_INTEGER_LENGTH_MODIFIER "u.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm - 1);
+ fflush(MR_mdb_out);
+ } else if (MR_trace_is_natural_number(words[2], &action)) {
+ problem = MR_trace_browse_action(MR_mdb_out, action,
+ MR_trace_browse_goal_internal,
+ MR_BROWSE_CALLER_PRINT, format);
+
+ if (problem != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "mdb: %s.\n", problem);
+ have_next_io_action = MR_FALSE;
+ }
+
+ next_io_action = action + 1;
+ have_next_io_action = MR_TRUE;
+ } else if (MR_trace_is_natural_number_pair(words[2],
+ &lo_action, &hi_action))
+ {
+ if (lo_action >= hi_action) {
+ /* swap lo_action and hi_action */
+ MR_Unsigned tmp;
+
+ tmp = lo_action;
+ lo_action = hi_action;
+ hi_action = tmp;
+ }
+
+ if (! (MR_io_tabling_start <= lo_action
+ && hi_action < MR_io_tabling_counter_hwm))
+ {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "I/O tabling has only recorded actions "
+ "%" MR_INTEGER_LENGTH_MODIFIER "u to "
+ "%" MR_INTEGER_LENGTH_MODIFIER "u.\n",
+ MR_io_tabling_start, MR_io_tabling_counter_hwm - 1);
+ have_next_io_action = MR_FALSE;
+ return KEEP_INTERACTING;
+ }
- problem = MR_trace_browse_action(MR_mdb_out, n,
+ for (action = lo_action; action <= hi_action; action++) {
+ fprintf(MR_mdb_out,
+ "action %" MR_INTEGER_LENGTH_MODIFIER "u: ", action);
+ problem = MR_trace_browse_action(MR_mdb_out, action,
MR_trace_browse_goal_internal,
MR_BROWSE_CALLER_PRINT, format);
if (problem != NULL) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: %s.\n", problem);
+ return KEEP_INTERACTING;
+ }
+ }
+
+ next_io_action = hi_action + 1;
+ have_next_io_action = MR_TRUE;
+ } else {
+ MR_trace_usage_cur_cmd();
}
} else {
MR_trace_usage_cur_cmd();
@@ -253,9 +396,10 @@
{
MR_BrowseFormat format;
MR_bool xml;
- int n;
+ int action;
MR_GoalBrowser goal_browser;
MR_Browser browser;
+ const char *problem;
if (! MR_trace_options_format(&format, &xml, &words, &word_count)) {
; /* the usage message has already been printed */
@@ -269,8 +413,6 @@
}
if (word_count == 1) {
- const char *problem;
-
problem = MR_trace_browse_one_goal(MR_mdb_out, goal_browser,
MR_BROWSE_CALLER_BROWSE, format);
@@ -279,8 +421,6 @@
fprintf(MR_mdb_err, "mdb: %s.\n", problem);
}
} else if (word_count == 2) {
- const char *problem;
-
if (MR_streq(words[1], "goal")) {
problem = MR_trace_browse_one_goal(MR_mdb_out, goal_browser,
MR_BROWSE_CALLER_BROWSE, format);
@@ -300,12 +440,11 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: %s.\n", problem);
}
- } else if (word_count == 3 && MR_streq(words[1], "action")
- && MR_trace_is_natural_number(words[2], &n))
+ } else if (word_count == 3 &&
+ (MR_streq(words[1], "io") || MR_streq(words[1], "action"))
+ && MR_trace_is_natural_number(words[2], &action))
{
- const char *problem;
-
- problem = MR_trace_browse_action(MR_mdb_out, n, goal_browser,
+ problem = MR_trace_browse_action(MR_mdb_out, action, goal_browser,
MR_BROWSE_CALLER_BROWSE, format);
if (problem != NULL) {
Index: trace/mercury_trace_cmd_dd.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_dd.c,v
retrieving revision 1.3
diff -u -b -r1.3 mercury_trace_cmd_dd.c
--- trace/mercury_trace_cmd_dd.c 7 Jun 2007 06:53:54 -0000 1.3
+++ trace/mercury_trace_cmd_dd.c 24 Sep 2007 01:26:33 -0000
@@ -87,12 +87,14 @@
decl_mode = MR_DECL_NODUMP;
filename = (const char *) NULL;
}
+
if (MR_trace_have_unhid_events) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
"mdb: dd doesn't work after `unhide_events on'.\n");
return KEEP_INTERACTING;
}
+
if (search_mode_requires_trace_counts && (
pass_trace_counts_file == NULL || fail_trace_counts_file == NULL))
{
@@ -102,6 +104,7 @@
"files\nbefore using the specified search mode.\n");
return KEEP_INTERACTING;
}
+
if (pass_trace_counts_file != NULL && fail_trace_counts_file != NULL) {
if (! MR_trace_decl_init_suspicion_table(pass_trace_counts_file,
fail_trace_counts_file, &problem))
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.112
diff -u -b -r1.112 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 31 Jul 2007 05:48:21 -0000 1.112
+++ trace/mercury_trace_declarative.c 24 Sep 2007 15:15:20 -0000
@@ -10,24 +10,22 @@
/*
** Main authors: Mark Brown, Ian MacLarty
**
-** 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 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.
+** 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 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 browser/declarative_debugger.m.
**
-** The interface between the front and back ends is via the
-** annotated_trace/2 typeclass, which is documented in
-** browse/declarative_debugger.m. It would be possible to replace
-** the front end or the back end with an alternative implementation
-** which also conforms to the typeclass constraints. For example:
-** - An alternative back end could generate the same tree
-** structure in a different way, such as via program
-** transformation.
-** - An alternative front end could graphically display the
-** generated trees as part of a visualization tool rather
-** than analyzing them for bugs.
+** The interface between the front and back ends is via the typeclass
+** annotated_trace/2, which is documented in browser/declarative_debugger.m.
+** It would be possible to replace the front end or the back end with an
+** alternative implementation which also conforms to the typeclass constraints.
+** For example:
+**
+** - An alternative back end could generate the same tree structure in a
+** different way, such as via program transformation.
+** - An alternative front end could graphically display the generated trees
+** as part of a visualization tool rather than analyzing them for bugs.
**
** The back end decides which events should be included in the annotated trace.
** The back end can be called multiple times to materialize different portions
@@ -55,8 +53,8 @@
** This could be because the bug has been found, or the user has
** exited the declarative debugging session.
** 2. The front end wants the subtree of a specific node in the annotated
-** trace. Here the front end will tell the back end to what depth it
-** wants the new subtree built to.
+** trace. Here the front end will tell the back end what depth it wants
+** the new subtree built to.
** 3. The front end wants nodes generated above the currently materialized
** portion of the annotated trace (referred to here as a supertree).
**
@@ -78,9 +76,9 @@
** many events are at each depth below the depth limit. The data collected is
** used to populate a field at each CALL event that is the root of an implicit
** (unmaterialized) subtree in the annotated trace. The field (called the
-** ideal depth) gives the maximum depth to build the subtree to to so that no
-** more than MR_edt_desired_nodes_in_subtree nodes are materialized. The front
-** end passes the ideal depth to the back end when requesting a new subtree.
+** ideal depth) gives the maximum depth to build the subtree to so that no more
+** than MR_edt_desired_nodes_in_subtree nodes are materialized. The front end
+** passes the ideal depth to the back end when requesting a new subtree.
**
** In case 3 the front end will supply the event number and call sequence
** number of the EXIT, FAIL or EXCP event at the root of the currently
@@ -102,7 +100,6 @@
** / \ |- Previously materialized tree
** / \ |
** / \ |
-**
*/
#include "mercury_imp.h"
@@ -140,34 +137,58 @@
*/
#ifdef MR_DEBUG_DD_BACK_END
+#define MR_DEBUG_DD_BACK_END_EVENT
+#define MR_DEBUG_DD_BACK_END_FILTER
+#define MR_DEBUG_DD_BACK_END_LINKS
+#define MR_DEBUG_DD_BACK_END_ALLOC
+#define MR_DEBUG_DD_BACK_END_PASSES
+#endif
+#ifdef MR_DEBUG_DD_BACK_END_EVENT
#define MR_decl_checkpoint_event(event_info) \
- MR_decl_checkpoint_event_imp("EVENT", event_info)
+ MR_decl_checkpoint_event_imp("EVENT", MR_TRUE, event_info)
+#else
+#define MR_decl_checkpoint_event(event_info) ((void) 0)
+#endif
+#ifdef MR_DEBUG_DD_BACK_END_FILTER
#define MR_decl_checkpoint_filter(event_info) \
- MR_decl_checkpoint_event_imp("FILTER", event_info)
+ MR_decl_checkpoint_event_imp("FILTER", MR_TRUE, event_info)
+#else
+#define MR_decl_checkpoint_filter(event_info) ((void) 0)
+#endif
+#ifdef MR_DEBUG_DD_BACK_END_LINKS
#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)
+#else
+#define MR_decl_checkpoint_find(location) ((void) 0)
+#define MR_decl_checkpoint_step(location) ((void) 0)
+#define MR_decl_checkpoint_match(location) ((void) 0)
+#endif
+#ifdef MR_DEBUG_DD_BACK_END_ALLOC
#define MR_decl_checkpoint_alloc(location) \
MR_decl_checkpoint_loc("ALLOC", location)
+#else
+#define MR_decl_checkpoint_alloc(location) ((void) 0)
+#endif
-#else /* !MR_DEBUG_DD_BACK_END */
-
-#define MR_decl_checkpoint_event(event_info)
-#define MR_decl_checkpoint_filter(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)
-
+#ifdef MR_DEBUG_DD_BACK_END_PASSES
+#define MR_decl_checkpoint_pass(msg, print, event_info) \
+ MR_decl_checkpoint_event_imp(msg, print, event_info)
+#define MR_decl_checkpoint_subtree(final, top_seqno, depth) \
+ MR_decl_checkpoint_tree("SUBTREE", final, top_seqno, depth)
+#define MR_decl_checkpoint_supertree(final, top_seqno, depth) \
+ MR_decl_checkpoint_tree("SUPERTREE", final, top_seqno, depth)
+#else
+#define MR_decl_checkpoint_pass(msg, print, event_info) ((void) 0)
+#define MR_decl_checkpoint_subtree(final, top_seqno, depth) ((void) 0)
+#define MR_decl_checkpoint_supertree(final, top_seqno, depth) ((void) 0)
#endif
/*
@@ -416,9 +437,13 @@
static MR_TraceNode MR_trace_step_left_in_contour(MR_TraceNode node);
static MR_TraceNode MR_trace_find_prev_contour(MR_TraceNode node);
static void MR_decl_checkpoint_event_imp(const char *str,
- MR_EventInfo *event_info);
+ MR_bool print_event, MR_EventInfo *event_info);
static void MR_decl_checkpoint_loc(const char *str,
MR_TraceNode node);
+static void MR_decl_checkpoint_tree(const char *tree_kind,
+ MR_Unsigned final_event,
+ MR_Unsigned top_seqno,
+ MR_Unsigned depth_limit);
static void MR_decl_print_edt_stats(void);
static void MR_decl_inc_constructed_nodes(void);
static void MR_trace_edt_build_sanity_check(
@@ -481,9 +506,7 @@
entry = event_info->MR_event_sll->MR_sll_entry;
MR_trace_edt_build_sanity_check(event_info, entry);
-
MR_trace_maybe_update_suspicion_accumulator(event_info->MR_event_sll);
-
MR_DECL_MAYBE_UPDATE_PROGRESS(MR_trace_event_number);
if (! MR_trace_include_event(entry, event_info, &jumpaddr)) {
@@ -491,14 +514,17 @@
}
MR_DD_CALC_NODE_DEPTH(port, node_depth, MR_edt_depth);
-
if (node_depth == MR_edt_max_depth
&& (port == MR_PORT_CALL || port == MR_PORT_REDO))
{
/*
- ** Reset the accumulators, since we are entering the
- ** top of an implicit subtree.
+ ** We are entering the top of an implicit subtree. Switch to the
+ ** event handler that processes the notes in the implicit subtree,
+ ** and reset the data structures it works with.
*/
+
+ MR_decl_checkpoint_pass("SWITCHING TO IMPLICIT SUBTREE", MR_FALSE,
+ event_info);
MR_trace_reset_implicit_subtree_counters();
MR_edt_implicit_subtree_counters[0]++;
MR_edt_implicit_subtree_depth = 0;
@@ -522,9 +548,7 @@
MR_trace_finish_progress();
}
- /*
- ** Call the front end.
- */
+ MR_decl_checkpoint_pass("CALL FRONTEND", MR_FALSE, event_info);
return MR_decl_diagnosis(MR_edt_return_node, &MR_trace_ctrl,
event_info, MR_TRUE);
}
@@ -561,6 +585,7 @@
/*
** Filter out events for compiler generated procedures.
*/
+
if (MR_PROC_LAYOUT_IS_UCI(entry)) {
*jumpaddr = NULL;
return MR_FALSE;
@@ -568,11 +593,11 @@
if (entry->MR_sle_module_layout->MR_ml_suppressed_events != 0) {
/*
- ** We ignore events from modules that were not compiled
- ** with the necessary information. Procedures in those
- ** modules are effectively assumed correct, so we give
- ** the user a warning.
+ ** We ignore events from modules that were not compiled with the
+ ** necessary information. Procedures in those modules are effectively
+ ** assumed correct, so we give the user a warning.
*/
+
MR_edt_compiler_flag_warning = MR_TRUE;
*jumpaddr = NULL;
return MR_FALSE;
@@ -595,31 +620,43 @@
/*
** We are exiting the subtree rooted at MR_edt_start_seqno.
*/
+
+ MR_decl_checkpoint_pass("SUPERTREE: SWITCHING TO INSIDE",
+ MR_FALSE, event_info);
MR_edt_inside = MR_TRUE;
return MR_TRUE;
} else if (event_info->MR_call_seqno == MR_edt_start_seqno
&& MR_port_is_entry(event_info->MR_trace_port))
{
/*
- ** We are entering the top of the currently materialized portion
- ** of the annotated trace. Since we are building a supertree
- ** we must retry to above the current event and start building
- ** the new portion of the annotated trace from there.
+ ** We are entering the top of the currently materialized
+ ** portion of the annotated trace. Since we are building
+ ** a supertree, we must retry to above the current event
+ ** and start building the new portion of the annotated trace
+ ** from there.
*/
+
+ MR_decl_checkpoint_pass("SUPERTREE: RETRYING", MR_TRUE,
+ event_info);
MR_edt_inside = MR_TRUE;
*jumpaddr = MR_trace_decl_retry_supertree(MR_edt_max_depth,
event_info);
+
/*
** Reset the depth since we will now be at the top of the
** supertree to be materialized. We set it to -1 since the
** next call to MR_trace_decl_debug will set it to 0.
*/
+
MR_edt_depth = -1;
return MR_FALSE;
} else {
/*
** We are in an existing explicit subtree.
*/
+
+ MR_decl_checkpoint_pass("SUPERTREE: FILTER", MR_TRUE,
+ event_info);
MR_decl_checkpoint_filter(event_info);
*jumpaddr = NULL;
return MR_FALSE;
@@ -631,6 +668,9 @@
** supertree and entering the existing explicit subtree.
** We must still however add this node to the generated EDT.
*/
+
+ MR_decl_checkpoint_pass("SUPERTREE: SWITCHING TO OUTSIDE",
+ MR_FALSE, event_info);
MR_edt_inside = MR_FALSE;
return MR_TRUE;
}
@@ -643,6 +683,9 @@
/*
** We are leaving the topmost call.
*/
+
+ MR_decl_checkpoint_pass("INSIDE: SWITCHING TO OUTSIDE",
+ MR_FALSE, event_info);
MR_edt_inside = MR_FALSE;
return MR_TRUE;
}
@@ -652,6 +695,9 @@
** The port must be either CALL or REDO;
** we are (re)entering the topmost call.
*/
+
+ MR_decl_checkpoint_pass("INSIDE: REENTERING TOPMOST",
+ MR_FALSE, event_info);
MR_edt_inside = MR_TRUE;
MR_edt_depth = -1;
return MR_TRUE;
@@ -659,6 +705,9 @@
/*
** Ignore this event -- it is outside the topmost call.
*/
+
+ MR_decl_checkpoint_pass("INSIDE: FILTERING", MR_TRUE,
+ event_info);
MR_decl_checkpoint_filter(event_info);
*jumpaddr = NULL;
return MR_FALSE;
@@ -852,7 +901,8 @@
MR_TRACE_CALL_MERCURY(
if (result == MR_STEP_OK && return_label_layout != NULL) {
- maybe_return_label = MR_DD_make_yes_maybe_label(return_label_layout);
+ maybe_return_label =
+ MR_DD_make_yes_maybe_label(return_label_layout);
} else {
maybe_return_label = MR_DD_make_no_maybe_label();
}
@@ -1722,6 +1772,7 @@
MR_RetryResult retry_result;
int retry_distance;
MR_bool unsafe_retry;
+ int counter_depth;
MR_edt_unsafe_retry_already_asked = MR_FALSE;
@@ -1798,8 +1849,8 @@
** the number of desired nodes divided by two, since the minimum
** number of events at each depth will be 2 (the CALL and EXIT).
*/
- MR_trace_init_implicit_subtree_counters(
- MR_edt_desired_nodes_in_subtree / 2 + 1);
+ counter_depth = (MR_edt_desired_nodes_in_subtree / 2) + 1;
+ MR_trace_init_implicit_subtree_counters(counter_depth);
/*
** Single step through every event.
@@ -1885,6 +1936,7 @@
&MR_trace_browser_persistent_state
);
}
+
bug_found = MR_DD_diagnoser_bug_found(response,
(MR_Integer *) &bug_event);
symptom_found = MR_DD_diagnoser_symptom_found(response,
@@ -1904,6 +1956,7 @@
** Turn off interactive debugging after the diagnosis in case a new
** explicit subtree or supertree needs to be constructed.
*/
+
MR_debug_enabled = MR_FALSE;
MR_update_trace_func_enabled();
MR_selected_trace_func_ptr = MR_trace_real_decl;
@@ -1918,9 +1971,10 @@
if (no_bug_found) {
/*
- ** No bug found. Return to the procedural debugger at the
- ** event where the `dd' command was initially given.
+ ** No bug found. Return to the procedural debugger at the event
+ ** where the `dd' command was initially given.
*/
+
return MR_decl_go_to_selected_event(MR_edt_initial_event, cmd,
event_info);
}
@@ -1930,6 +1984,8 @@
** The front end requires a subtree to be made explicit.
** Restart the declarative debugger with the appropriate depth limit.
*/
+ MR_decl_checkpoint_subtree(final_event, topmost_seqno,
+ requested_subtree_depth);
return MR_trace_restart_decl_debug(call_preceding, final_event,
topmost_seqno, MR_FALSE, requested_subtree_depth, cmd, event_info);
}
@@ -1938,6 +1994,8 @@
/*
** Front end requires a supertree to be made explicit.
*/
+ MR_decl_checkpoint_supertree(final_event, topmost_seqno,
+ MR_edt_default_depth_limit);
return MR_trace_restart_decl_debug((MR_TraceNode) NULL, final_event,
topmost_seqno, MR_TRUE, MR_edt_default_depth_limit, cmd,
event_info);
@@ -2390,19 +2448,23 @@
MR_edt_progress_last_tick = 0;
}
-#ifdef MR_DEBUG_DD_BACK_END
-
static void
-MR_decl_checkpoint_event_imp(const char *str, MR_EventInfo *event_info)
+MR_decl_checkpoint_event_imp(const char *str, MR_bool print_event,
+ MR_EventInfo *event_info)
{
+ if (print_event) {
fprintf(MR_mdb_out, "DD %s %ld: #%ld %ld %s ",
str,
(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_actual_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");
+ } else {
+ fprintf(MR_mdb_out, "DD AT EVENT %ld: %s\n",
+ (long) event_info->MR_event_number, str);
+ }
}
static void
@@ -2411,7 +2473,6 @@
MercuryFile mdb_out;
MR_mercuryfile_init(MR_mdb_out, 1, &mdb_out);
-
fprintf(MR_mdb_out, "DD %s: %ld ", str, (long) node);
MR_TRACE_CALL_MERCURY(
MR_DD_print_trace_node((MR_Word) &mdb_out, (MR_Word) node);
@@ -2419,7 +2480,14 @@
fprintf(MR_mdb_out, "\n");
}
-#endif /* MR_DEBUG_DD_BACK_END */
+static void
+MR_decl_checkpoint_tree(const char *tree_kind, MR_Unsigned final_event,
+ MR_Unsigned top_seqno, MR_Unsigned depth_limit)
+{
+ fprintf(MR_mdb_out, "DD STARTING %s: ", tree_kind);
+ fprintf(MR_mdb_out, "final event %lu, topmost seqno %lu, depth %lu\n",
+ final_event, top_seqno, depth_limit);
+}
#ifdef MR_DD_PRINT_EDT_STATS
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.31
diff -u -b -r1.31 mercury_trace_declarative.h
--- trace/mercury_trace_declarative.h 7 Jun 2007 06:53:54 -0000 1.31
+++ trace/mercury_trace_declarative.h 24 Sep 2007 11:32:26 -0000
@@ -291,7 +291,7 @@
/*
** The following two macros decide when to display progress.
-** We define two version: one for when we are materializing nodes and one
+** We define two versions: one for when we are materializing nodes and one
** for when we are in an implicit subtree, since execution is much faster in
** implicit subtrees.
** In the implicit tree version we don't need to check if the event is the
@@ -306,7 +306,7 @@
#define MR_DECL_MAYBE_UPDATE_PROGRESS(event_number) \
do { \
if (MR_mdb_decl_print_progress) { \
- if(MR_edt_building_supertree) { \
+ if (MR_edt_building_supertree) { \
if (event_number % MR_DECL_PROGRESS_CHECK_INTERVAL == 0) { \
MR_trace_show_progress_supertree(event_number); \
} \
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.236
diff -u -b -r1.236 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 19 Jun 2007 03:12:50 -0000 1.236
+++ trace/mercury_trace_internal.c 24 Sep 2007 11:44:10 -0000
@@ -216,9 +216,6 @@
*/
MR_turn_off_debug(&MR_saved_debug_state, MR_FALSE);
-#if defined(MR_DEEP_PROFILING) && defined(MR_EXEC_TRACE)
- MR_disable_deep_profiling_in_debugger = MR_TRUE;
-#endif
MR_trace_internal_ensure_init();
MR_trace_browse_ensure_init();
@@ -260,9 +257,6 @@
MR_scroll_next = 0;
MR_turn_debug_back_on(&MR_saved_debug_state);
-#if defined(MR_DEEP_PROFILING) && defined(MR_EXEC_TRACE)
- MR_disable_deep_profiling_in_debugger = MR_FALSE;
-#endif
return jumpaddr;
}
Index: trace/mercury_trace_util.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_util.c,v
retrieving revision 1.22
diff -u -b -r1.22 mercury_trace_util.c
--- trace/mercury_trace_util.c 29 Nov 2006 05:18:41 -0000 1.22
+++ trace/mercury_trace_util.c 24 Sep 2007 04:31:53 -0000
@@ -29,7 +29,7 @@
}
MR_bool
-MR_trace_is_natural_number(const char *word, int *value)
+MR_trace_is_natural_number(const char *word, MR_Unsigned *value)
{
if (word != NULL && MR_isdigit(*word)) {
*value = *word - '0';
@@ -48,6 +48,39 @@
}
MR_bool
+MR_trace_is_natural_number_pair(const char *word,
+ MR_Unsigned *value1, MR_Unsigned *value2)
+{
+ if (word != NULL && MR_isdigit(*word)) {
+ *value1 = *word - '0';
+ word++;
+ while (MR_isdigit(*word)) {
+ *value1 = (*value1 * 10) + *word - '0';
+ word++;
+ }
+
+ if (*word == '-') {
+ word++;
+
+ if (MR_isdigit(*word)) {
+ *value2 = *word - '0';
+ word++;
+ while (MR_isdigit(*word)) {
+ *value2 = (*value2 * 10) + *word - '0';
+ word++;
+ }
+
+ if (*word == '\0') {
+ return MR_TRUE;
+ }
+ }
+ }
+ }
+
+ return MR_FALSE;
+}
+
+MR_bool
MR_trace_is_unsigned(const char *word, MR_Unsigned *value)
{
if (word != NULL && MR_isdigit(*word)) {
Index: trace/mercury_trace_util.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_util.h,v
retrieving revision 1.18
diff -u -b -r1.18 mercury_trace_util.h
--- trace/mercury_trace_util.h 29 Nov 2006 05:18:41 -0000 1.18
+++ trace/mercury_trace_util.h 24 Sep 2007 02:02:58 -0000
@@ -38,6 +38,9 @@
** number, i.e. a sequence of digits. If yes, it puts the value of the number
** in *value (an int) and returns MR_TRUE, otherwise it returns MR_FALSE.
**
+** MR_trace_is_natural_number_pair looks for a pair of natural numbers
+** separated by a '-' character.
+**
** MR_trace_is_unsigned is similar, but puts the value of the number in a
** location of type MR_Unsigned.
**
@@ -52,7 +55,11 @@
** type. MR_trace_is_integer doesn't even work for MININT.
*/
-extern MR_bool MR_trace_is_natural_number(const char *word, int *value);
+extern MR_bool MR_trace_is_natural_number(const char *word,
+ MR_Unsigned *value);
+
+extern MR_bool MR_trace_is_natural_number_pair(const char *word,
+ MR_Unsigned *value1, MR_Unsigned *value2);
extern MR_bool MR_trace_is_unsigned(const char *word, MR_Unsigned *value);
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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