[m-rev.] for review: fix three bugs in declarative debugger

Ian MacLarty maclarty at cs.mu.OZ.AU
Mon Mar 28 02:26:43 AEST 2005


For review by anyone.

Estimated hours taken: 30
Branches: main

Fix three bugs in the declarative debuggger.

The first two are to do with IO tabling in the declarative debugger:

The first bug was exposed when a new explicit supertree was built over a part
of the program that did IO.  The starting IO action sequence number was not
being set correctly, causing some IO actions to be omitted from the resulting
IO action map.  The fix is to set the starting IO action sequence number to
the IO action sequence number at the CALL event for the topmost node of the new
explicit supertree.

The second bug was exposed when a retry was done over a part of the program
whose IO was not tabled.  This caused the building of the IO action map to
fail.  Specifically the MR_trace_get_action C function would abort with a
message that the IO action number was out of range.  The fix is to only record
tabled IO actions in the IO action map and then warn the user if a question is
asked where some of the IO actions for the atom haven't been tabled.

The third bug causes the declarative debugger to throw an exception when
an explicit subtree of depth 1 is requested.  This was because MR_edt_depth
(the global which keeps track of the current depth of the EDT) was not being 
set correctly.

browser/declarative_debugger.m:
	Allow the IO actions for a final atom to be tabled or untabled.

browser/declarative_tree.m:
	Extract a list of the tabled and untabled IO actions for a question
	from the IO action map.

browser/declarative_user.m:
	Bring module imports up to date with coding standards.
	
	Only allow browsing and printing of tabled IO actions.

	Print all the tabled IO actions for a question and print a warning if
	there are any untabled IO actions for a question.

	Use "tabled IO actions" instead of "io actions" when displaying how
	many tabled IO actions there are for a question.

browser/io_action.m:
	Add a type to record if an IO action is tabled or not.
	
	Bring module imports up to date with coding standards.

	Only record tabled IO actions in the IO action map used by the
	declarative debugger.

runtime/mercury_trace_base.[ch]:
	Make MR_trace_get_action return true or false depending on whether
	the requested IO action was tabled or not, so that we can easily
	detect this in io_action.m above.

tests/debugger/declarative/io_stream_test.exp2:
	Update expected output.

tests/debugger/declarative/tabled_read_decl.{exp,inp,m}:
	Add regression tests for all three bugs.

trace/mercury_trace.[ch]:
	Allow the message printed by the retry command, when it is about to 
	retry over untabled IO, to be customised.  This allows the declarative
	debugger to print a different message when it needs to do a retry
	over untabled IO.  Previously the message seemed unrelated to the
	declarative debugging session.

	Get MR_trace_retry to report if it did an unsafe retry over 
	untabled IO.
	
trace/mercury_trace_declarative.c:
	Print a friendlier message when attempting to retry over untabled IO.

	Set the initial IO action sequence number to the IO action sequence
	number at the time of the CALL event of the topmost node of the new 
	explicit supertree.

	Initialise MR_edt_depth to -1, instead of 0, since it will be
	subsequently made 0.
	
	When building an explicit supertree, only ask the user once if a
	retry can be done over untabled IO.
	Because of this rename MR_trace_retry_max to MR_trace_retry_supertree,
	since it should now only be used when building a supertree.

	When checking if we are at the final event for the top of the new
	explicit supertree, add the depth_check_adjustment.  This ensures
	that the final event has the same depth as the corresponding call 
	event.
	
	Add an argument to MR_decl_diagnosis to tell it whether a new tree
	was generated, or to resume a previous session.  Previously the resume
	option was implied by a null tree, which made the code less readable.

trace/mercury_trace_external.c:
trace/mercury_trace_internal.c:
	Pass the new extra arguments to MR_trace_retry.

trace/mercury_trace_readline.c:
	If a readline prompt spans multiple lines then the display gets messed
	up when the user starts typing (not sure if this is a bug in readline
	or not).  Fix this by only passing the last line of a prompt to 
	readline and just fprintf'ing any previous lines.
	
trace/mercury_trace_vars.c:
	Handle the new MR_bool return value of MR_trace_get_action.

Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.54
diff -u -r1.54 declarative_debugger.m
--- browser/declarative_debugger.m	12 Mar 2005 04:46:29 -0000	1.54
+++ browser/declarative_debugger.m	26 Mar 2005 05:58:20 -0000
@@ -219,7 +219,7 @@
 :- type final_decl_atom
 	--->	final_decl_atom(
 			final_atom		:: trace_atom,
-			final_io_actions	:: list(io_action)
+			final_io_actions	:: list(maybe_tabled_io_action)
 		).
 
 :- type decl_exception == term_rep.
@@ -281,7 +281,7 @@
 	io::di, io::uo) is cc_multi <= annotated_trace(S, R).
 
 :- pred unravel_decl_atom(some_decl_atom::in, trace_atom::out,
-	list(io_action)::out) is det.
+	list(maybe_tabled_io_action)::out) is det.
 
 %-----------------------------------------------------------------------------%
 
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.23
diff -u -r1.23 declarative_tree.m
--- browser/declarative_tree.m	24 Mar 2005 05:33:53 -0000	1.23
+++ browser/declarative_tree.m	26 Mar 2005 05:58:20 -0000
@@ -91,14 +91,19 @@
 	CallAtom = get_trace_call_atom(CallNode),
 	DeclAtom = init_decl_atom(CallAtom).
 
-:- func make_io_actions(io_action_map, int, int) = list(io_action).
+:- func make_io_actions(io_action_map, io_seq_num, io_seq_num) 
+	= list(maybe_tabled_io_action).
 
-make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) =
+make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) = IoActions :-
 	( InitIoSeq = ExitIoSeq ->
-		[]
-	;
-		[map.lookup(IoActionMap, InitIoSeq) |
-			make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq)]
+		IoActions = []
+	;	
+		Rest = make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq),
+		( map.search(IoActionMap, InitIoSeq, IoAction) ->
+			IoActions = [tabled(IoAction) | Rest]
+		;
+			IoActions = [untabled(InitIoSeq) | Rest]
+		)
 	).
 
 :- pred get_edt_node_initial_atom(S::in, R::in, init_decl_atom::out)
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.46
diff -u -r1.46 declarative_user.m
--- browser/declarative_user.m	12 Mar 2005 04:46:30 -0000	1.46
+++ browser/declarative_user.m	26 Mar 2005 06:19:53 -0000
@@ -78,7 +78,15 @@
 :- import_module mdb.parse.
 :- import_module mdb.term_rep.
 
-:- import_module std_util, char, string, bool, int, deconstruct, getopt, list.
+:- import_module bool.
+:- import_module char.
+:- import_module deconstruct.
+:- import_module exception.
+:- import_module getopt.
+:- import_module int.
+:- import_module list.
+:- import_module std_util.
+:- import_module string.
 
 :- type user_state
 	--->	user(
@@ -211,7 +219,8 @@
 handle_command(browse_io(ActionNum), UserQuestion, Response, 
 		!User, !IO) :-
 	Question = get_decl_question(UserQuestion),
-	edt_node_io_actions(Question, IoActions),
+	edt_node_io_actions(Question, MaybeTabledIoActions),
+	filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
 	% We don't have code yet to trace a marked I/O action.
 	browse_chosen_io_action(IoActions, ActionNum, _MaybeMark, !User, !IO),
 	query_user(UserQuestion, Response, !User, !IO).
@@ -219,7 +228,8 @@
 handle_command(print_io(From, To), UserQuestion, Response, 
 		!User, !IO) :-
 	Question = get_decl_question(UserQuestion),
-	edt_node_io_actions(Question, IoActions),
+	edt_node_io_actions(Question, MaybeTabledIoActions),
+	filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
 	print_chosen_io_actions(IoActions, From, To, !.User, !IO),
 	query_user(UserQuestion, Response, !User, !IO).
 
@@ -316,7 +326,8 @@
 edt_node_trace_atoms(unexpected_exception(_, InitDeclAtom, _),
 	InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
 
-:- pred edt_node_io_actions(decl_question(T)::in, list(io_action)::out) is det.
+:- pred edt_node_io_actions(decl_question(T)::in, 
+	list(maybe_tabled_io_action)::out) is det.
 
 edt_node_io_actions(wrong_answer(_, _, FinalDeclAtom),
 	FinalDeclAtom ^ final_io_actions).
@@ -335,7 +346,8 @@
 decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
 	InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
 
-:- pred decl_bug_io_actions(decl_bug::in, list(io_action)::out) is det.
+:- pred decl_bug_io_actions(decl_bug::in, list(maybe_tabled_io_action)::out) 
+	is det.
 
 decl_bug_io_actions(e_bug(incorrect_contour(_, FinalDeclAtom, _, _)),
 	FinalDeclAtom ^ final_io_actions).
@@ -868,7 +880,8 @@
 	;
 		Command = browse_io(ActionNum)
 	->
-		decl_bug_io_actions(Bug, IoActions),
+		decl_bug_io_actions(Bug, MaybeTabledIoActions),
+		filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
 		browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
 			!User, !IO),
 		user_confirm_bug(Bug, Response, !User, !IO)
@@ -965,7 +978,7 @@
 
 write_decl_atom(User, Indent, CallerType, DeclAtom, !IO) :-
 	io.write_string(User ^ outstr, Indent, !IO),
-	unravel_decl_atom(DeclAtom, TraceAtom, IoActions),
+	unravel_decl_atom(DeclAtom, TraceAtom, MaybeTabledIoActions),
 	TraceAtom = atom(ProcLayout, Args0),
 	ProcLabel = get_proc_label_from_layout(ProcLayout),
 	get_pred_attributes(ProcLabel, _, Functor, _, PredOrFunc),
@@ -980,7 +993,46 @@
 		is_function(PredOrFunc)),
 	browse.print_browser_term(BrowserTerm, User ^ outstr, CallerType,
 		User ^ browser, !IO),
-	write_io_actions(User, IoActions, !IO).
+	write_maybe_tabled_io_actions(User, MaybeTabledIoActions, !IO).
+
+:- pred write_maybe_tabled_io_actions(user_state::in, 
+	list(maybe_tabled_io_action)::in, io::di, io::uo) is cc_multi.
+
+write_maybe_tabled_io_actions(User, MaybeTabledIoActions, !IO) :-
+	filter_tabled_io_actions(MaybeTabledIoActions, IoActions, AreUntabled),
+	write_io_actions(User, IoActions, !IO),
+	(
+		AreUntabled = yes,
+		io.write_string(User ^ outstr, "Warning: some IO actions " ++
+			"for this atom were not tabled.\n", !IO)
+	;
+		AreUntabled = no
+	).
+
+:- pred filter_tabled_io_actions(list(maybe_tabled_io_action)::in, 
+	list(io_action)::out, bool::out) is det.
+
+filter_tabled_io_actions(MaybeTabledIoActions, IoActions, AreUntabled) :-
+	list.filter(io_action_is_tabled, MaybeTabledIoActions, TabledIoActions,
+		UnTabledIoActions),
+	IoActions = list.map(get_tabled_io_action, TabledIoActions),
+	(
+		UnTabledIoActions = [],
+		AreUntabled = no
+	;
+		UnTabledIoActions = [_ | _],
+		AreUntabled = yes
+	).
+
+:- pred io_action_is_tabled(maybe_tabled_io_action::in) is semidet.
+
+io_action_is_tabled(tabled(_)).
+
+:- func get_tabled_io_action(maybe_tabled_io_action) = io_action.
+
+get_tabled_io_action(tabled(IoAction)) = IoAction.
+get_tabled_io_action(untabled(_)) = _ :-
+	throw(internal_error("get_tabled_io_action", "io action not tabled")).
 
 :- pred trace_atom_arg_to_univ(trace_atom_arg::in, univ::out) is det.
 
@@ -1003,10 +1055,12 @@
 		true
 	;
 		( NumIoActions = 1 ->
-			io.write_string(User ^ outstr, "1 io action:", !IO)
+			io.write_string(User ^ outstr, "1 tabled IO action:", 
+				!IO)
 		;
 			io.write_int(User ^ outstr, NumIoActions, !IO),
-			io.write_string(User ^ outstr, " io actions:", !IO)
+			io.write_string(User ^ outstr, " tabled IO actions:", 
+				!IO)
 		),
  		NumPrinted = get_num_printed_io_actions(User ^ browser),
  		( NumIoActions =< NumPrinted ->
Index: browser/io_action.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/io_action.m,v
retrieving revision 1.7
diff -u -r1.7 io_action.m
--- browser/io_action.m	24 Jan 2005 07:41:04 -0000	1.7
+++ browser/io_action.m	26 Mar 2005 05:58:20 -0000
@@ -28,6 +28,10 @@
 			io_action_args		:: list(univ)
 		).
 
+:- type maybe_tabled_io_action
+	--->	tabled(io_action)
+	;	untabled(io_seq_num).
+
 :- type io_seq_num	== int.
 :- type io_action_map	== map(io_seq_num, io_action).
 
@@ -38,7 +42,10 @@
 
 :- implementation.
 
-:- import_module bool, int, require.
+:- import_module bool.
+:- import_module int.
+:- import_module require.
+:- import_module svmap.
 
 io_action_to_browser_term(IoAction) = Term :-
 	IoAction = io_action(ProcName, PredFunc, Args),
@@ -58,54 +65,64 @@
 	io_action_map::in, io_action_map::out, io__state::di, io__state::uo)
 	is det.
 
-make_io_action_map_2(Cur, End, IoActionMap0, IoActionMap) -->
-	( { Cur = End } ->
-		{ IoActionMap = IoActionMap0 }
+make_io_action_map_2(Cur, End, !IoActionMap, !IO) :-
+	( Cur = End ->
+		true
 	;
-		pickup_io_action(Cur, ProcName, IsFunc, Args),
-		{ update_io_action_map(Cur, ProcName, IsFunc, Args,
-			IoActionMap0, IoActionMap1) },
-		make_io_action_map_2(Cur + 1, End, IoActionMap1, IoActionMap)
+		pickup_io_action(Cur, MaybeIoAction, !IO),
+		(
+			MaybeIoAction = yes(IoAction),
+			svmap.det_insert(Cur, IoAction, !IoActionMap)
+		;
+			MaybeIoAction = no
+		),
+		make_io_action_map_2(Cur + 1, End, !IoActionMap, !IO)
 	).
 
-:- pred update_io_action_map(int::in, string::in, bool::in, list(univ)::in,
-	io_action_map::in, io_action_map::out) is det.
-
-update_io_action_map(IoActionNum, ProcName, IsFunc, Args,
-		IoActionMap0, IoActionMap) :-
-	(
-		IsFunc = no,
-		PredFunc = predicate
-	;
-		IsFunc = yes,
-		PredFunc = function
-	),
-	IoAction = io_action(ProcName, PredFunc, Args),
-	map__det_insert(IoActionMap0, IoActionNum, IoAction, IoActionMap).
-
-:- pred pickup_io_action(int::in, string::out, bool::out, list(univ)::out,
+:- pred pickup_io_action(int::in, maybe(io_action)::out,
 	io__state::di, io__state::uo) is det.
 
 :- pragma foreign_proc("C",
-	pickup_io_action(SeqNum::in, ProcName::out, IsFunc::out, Args::out,
-		S0::di, S::uo),
+	pickup_io_action(SeqNum::in, MaybeIOAction::out, S0::di, S::uo),
 	[thread_safe, promise_pure, tabled_for_io],
 "{
 	const char	*problem;
 	const char	*proc_name;
+	MR_bool		is_func;
+	MR_Word		args;
+	MR_bool		io_action_tabled;
+	MR_String	ProcName;
 
 	MR_save_transient_hp();
-	problem = MR_trace_get_action(SeqNum, &proc_name, &IsFunc, &Args);
+	io_action_tabled = MR_trace_get_action(SeqNum, &proc_name, 
+		&is_func, &args);
 	MR_restore_transient_hp();
-	if (problem != NULL) {
-		MR_fatal_error(""pickup_io_action: MR_trace_get_action"");
-	}
 
 	/* cast away const */
 	ProcName = (MR_String) (MR_Integer) proc_name;
+	if (io_action_tabled) {
+		MaybeIOAction = MR_IO_ACTION_make_yes_io_action(
+			ProcName, is_func, args);
+	} else {
+		MaybeIOAction = MR_IO_ACTION_make_no_io_action();
+	}
 
 	S = S0;
 }").
 
-pickup_io_action(_, _, _, _) -->
-	{ private_builtin__sorry("pickup_io_action") }.
+:- func make_no_io_action = maybe(io_action).
+:- pragma export(make_no_io_action = out, "MR_IO_ACTION_make_no_io_action").
+
+make_no_io_action = no.
+
+:- func make_yes_io_action(string, bool, list(univ)) = maybe(io_action).
+:- pragma export(make_yes_io_action(in, in, in) = out, 
+	"MR_IO_ACTION_make_yes_io_action").
+	
+make_yes_io_action(ProcName, yes, Args) = 
+	yes(io_action(ProcName, function, Args)).
+make_yes_io_action(ProcName, no, Args) = 
+	yes(io_action(ProcName, predicate, Args)).
+
+pickup_io_action(_, _, _, _) :-
+	private_builtin__sorry("pickup_io_action").
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.64
diff -u -r1.64 mercury_trace_base.c
--- runtime/mercury_trace_base.c	24 Mar 2005 01:58:05 -0000	1.64
+++ runtime/mercury_trace_base.c	26 Mar 2005 05:58:20 -0000
@@ -671,7 +671,7 @@
     }
 }
 
-const char *
+MR_bool
 MR_trace_get_action(int action_number, MR_ConstString *proc_name_ptr,
     MR_Word *is_func_ptr, MR_Word *arg_list_ptr)
 {
@@ -692,7 +692,7 @@
     if (! (MR_io_tabling_start <= action_number
         && action_number < MR_io_tabling_counter_hwm))
     {
-        return "I/O action number not in range";
+        return MR_FALSE;
     }
 
     MR_DEBUG_NEW_TABLE_START_INT(answer_block_trie,
@@ -701,7 +701,7 @@
     answer_block = answer_block_trie->MR_answerblock;
 
     if (answer_block == NULL) {
-        return "I/O action number not in range";
+        return MR_FALSE;
     }
 
     table_io_decl = (const MR_Table_Io_Decl *) answer_block[0];
@@ -732,7 +732,7 @@
     *proc_name_ptr = proc_name;
     *is_func_ptr = is_func;
     *arg_list_ptr = arg_list;
-    return NULL;
+    return MR_TRUE;
 }
 
 void
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.45
diff -u -r1.45 mercury_trace_base.h
--- runtime/mercury_trace_base.h	24 Mar 2005 01:58:05 -0000	1.45
+++ runtime/mercury_trace_base.h	26 Mar 2005 05:58:20 -0000
@@ -404,10 +404,12 @@
 ** This function is called from the Mercury code in the debugger, in the
 ** browser directory. It is here, not in the trace directory, because code
 ** in the browser directory cannot call functions in the trace directory.
+**
+** If the io action action_number has not been tabled, then this
+** function will return MR_FALSE, otherwise it will return MR_TRUE.
 */
 
-extern	const char
-		*MR_trace_get_action(int action_number,
+extern	MR_bool	MR_trace_get_action(int action_number,
 			MR_ConstString *proc_name_ptr, MR_Word *is_func_ptr,
 			MR_Word *arg_list_ptr);
 
Index: tests/debugger/declarative/io_stream_test.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/io_stream_test.exp2,v
retrieving revision 1.5
diff -u -r1.5 io_stream_test.exp2
--- tests/debugger/declarative/io_stream_test.exp2	6 Jan 2005 03:20:12 -0000	1.5
+++ tests/debugger/declarative/io_stream_test.exp2	27 Mar 2005 03:03:44 -0000
@@ -22,7 +22,7 @@
 test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, _)
 mdb> dd -a
 test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
@@ -31,7 +31,7 @@
 stream(0, input, text, file("tabled_read_decl.data"))
 1123
 test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
@@ -40,14 +40,14 @@
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
 Valid? no
 test_2(stream(0, input, text, file("tabled_read_decl.data")), 1, 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
@@ -55,13 +55,13 @@
 Valid? yes
 Found incorrect contour:
 test_2(stream(0, input, text, file("tabled_read_decl.data")), 1, 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
 test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
 read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
Index: tests/debugger/declarative/tabled_read_decl.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/tabled_read_decl.exp,v
retrieving revision 1.12
diff -u -r1.12 tabled_read_decl.exp
--- tests/debugger/declarative/tabled_read_decl.exp	6 Jan 2005 03:20:13 -0000	1.12
+++ tests/debugger/declarative/tabled_read_decl.exp	27 Mar 2005 16:17:42 -0000
@@ -17,7 +17,7 @@
 test('<<c_pointer>>', 1123, _, _)
 mdb> dd -a
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
@@ -26,7 +26,7 @@
 '<<c_pointer>>'
 1123
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
@@ -35,7 +35,7 @@
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
@@ -44,7 +44,7 @@
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
@@ -55,19 +55,19 @@
 browser> set num_io_actions 3
 browser> quit
 test('<<c_pointer>>', 1123, _, _)
-4 io actions: too many to show
+4 tabled IO actions: too many to show
 Valid? browse 1
 browser> set num_io_actions 10
 browser> quit
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
 read_char_code('<<c_pointer>>', 10)
 Valid? no
 test_2('<<c_pointer>>', 1, 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
@@ -75,20 +75,124 @@
 Valid? yes
 Found incorrect contour:
 test_2('<<c_pointer>>', 1, 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
 read_char_code('<<c_pointer>>', 10)
 test('<<c_pointer>>', 1123, _, _)
-4 io actions:
+4 tabled IO actions:
 read_char_code('<<c_pointer>>', 49)
 read_char_code('<<c_pointer>>', 50)
 read_char_code('<<c_pointer>>', 51)
 read_char_code('<<c_pointer>>', 10)
 Is this a bug? yes
       E3:     C2 EXIT pred tabled_read_decl.test/4-0 (det)
-mdb> c -n -S
+mdb> break tabled_read_decl.part_2
+ 1: + stop  interface pred tabled_read_decl.part_2/3-0 (det)
+mdb> c
 1123
 1456
+      E4:     C3 CALL pred tabled_read_decl.part_2/3-0 (det)
+mdb> break tabled_read_decl.test
+ 2: + stop  interface pred tabled_read_decl.test/4-0 (det)
+mdb> c
+      E5:     C4 CALL pred tabled_read_decl.test/4-0 (det)
+mdb> delete *
+ 0: E stop  interface pred tabled_read_decl.test/4-0 (det)
+ 1: E stop  interface pred tabled_read_decl.part_2/3-0 (det)
+ 2: E stop  interface pred tabled_read_decl.test/4-0 (det)
+mdb> f
+      E6:     C4 EXIT pred tabled_read_decl.test/4-0 (det)
+mdb> dd -ad1
+test('<<c_pointer>>', 1789, _, _)
+4 tabled IO actions:
+read_char_code('<<c_pointer>>', 55)
+read_char_code('<<c_pointer>>', 56)
+read_char_code('<<c_pointer>>', 57)
+read_char_code('<<c_pointer>>', 10)
+Valid? y
 1789
+part_2('<<c_pointer>>', _, _)
+5 tabled IO actions:
+read_char_code('<<c_pointer>>', 55)
+read_char_code('<<c_pointer>>', 56)
+read_char_code('<<c_pointer>>', 57)
+read_char_code('<<c_pointer>>', 10)
+write_int(1789)
+Valid? n
+write_int(1789, _, _)
+1 tabled IO action:
+write_int(1789)
+Valid? y
+Found incorrect contour:
+test('<<c_pointer>>', 1789, _, _)
+4 tabled IO actions:
+read_char_code('<<c_pointer>>', 55)
+read_char_code('<<c_pointer>>', 56)
+read_char_code('<<c_pointer>>', 57)
+read_char_code('<<c_pointer>>', 10)
+write_int(1789, _, _)
+1 tabled IO action:
+write_int(1789)
+part_2('<<c_pointer>>', _, _)
+5 tabled IO actions:
+read_char_code('<<c_pointer>>', 55)
+read_char_code('<<c_pointer>>', 56)
+read_char_code('<<c_pointer>>', 57)
+read_char_code('<<c_pointer>>', 10)
+write_int(1789)
+Is this a bug? y
+      E7:     C3 EXIT pred tabled_read_decl.part_2/3-0 (det)
+mdb> break tabled_read_decl.part_3
+ 0: + stop  interface pred tabled_read_decl.part_3/2-0 (det)
+mdb> c
+      E8:     C5 CALL pred tabled_read_decl.part_3/2-0 (det)
+mdb> break tabled_read_decl.fake_io
+ 1: + stop  interface pred tabled_read_decl.fake_io/3-0 (det)
+mdb> c
+      E9:     C6 CALL pred tabled_read_decl.fake_io/3-0 (det)
+mdb> table_io stop
+I/O tabling stopped.
+mdb> delete *
+ 0: E stop  interface pred tabled_read_decl.part_3/2-0 (det)
+ 1: E stop  interface pred tabled_read_decl.fake_io/3-0 (det)
+mdb> f
+     E10:     C6 EXIT pred tabled_read_decl.fake_io/3-0 (det)
+mdb> dd -ad1
+The declarative debugger needs to perform a retry across
+an area which is not IO tabled.  This is not always safe.
+To avoid this warning restart mdb and issue a `table_io start'
+command at an event before the suspect area.
+Do you wish to proceed with the retry? y
+fake_io(1, _, _)
+Warning: some IO actions for this atom were not tabled.
+Valid? y
+The declarative debugger needs to perform a retry across
+an area which is not IO tabled.  This is not always safe.
+To avoid this warning restart mdb and issue a `table_io start'
+command at an event before the suspect area.
+Do you wish to proceed with the retry? y
+1
+part_3(_, _)
+Warning: some IO actions for this atom were not tabled.
+Valid? n
+write_int(1, _, _)
+Warning: some IO actions for this atom were not tabled.
+Valid? y
+Found incorrect contour:
+fake_io(1, _, _)
+Warning: some IO actions for this atom were not tabled.
+write_int(1, _, _)
+Warning: some IO actions for this atom were not tabled.
+part_3(_, _)
+Warning: some IO actions for this atom were not tabled.
+Is this a bug? y
+The declarative debugger needs to perform a retry across
+an area which is not IO tabled.  This is not always safe.
+To avoid this warning restart mdb and issue a `table_io start'
+command at an event before the suspect area.
+Do you wish to proceed with the retry? y
+1
+     E11:     C5 EXIT pred tabled_read_decl.part_3/2-0 (det)
+mdb> c
Index: tests/debugger/declarative/tabled_read_decl.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/tabled_read_decl.inp,v
retrieving revision 1.4
diff -u -r1.4 tabled_read_decl.inp
--- tests/debugger/declarative/tabled_read_decl.inp	6 Nov 2002 02:02:35 -0000	1.4
+++ tests/debugger/declarative/tabled_read_decl.inp	27 Mar 2005 16:15:27 -0000
@@ -21,4 +21,30 @@
 no
 yes
 yes
-c -n -S
+break tabled_read_decl.part_2
+c
+break tabled_read_decl.test
+c
+delete *
+f
+dd -ad1
+y
+n
+y
+y
+break tabled_read_decl.part_3
+c
+break tabled_read_decl.fake_io
+c
+table_io stop
+delete *
+f
+dd -ad1
+y
+y
+y
+n
+y
+y
+y
+c
Index: tests/debugger/declarative/tabled_read_decl.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/tabled_read_decl.m,v
retrieving revision 1.2
diff -u -r1.2 tabled_read_decl.m
--- tests/debugger/declarative/tabled_read_decl.m	22 Jul 2002 07:13:12 -0000	1.2
+++ tests/debugger/declarative/tabled_read_decl.m	27 Mar 2005 08:53:07 -0000
@@ -18,7 +18,8 @@
 	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_2(Stream),
+		tabled_read_decl__part_3
 	;
 		io__write_string("could not open tabled_read.data\n")
 	).
@@ -39,6 +40,12 @@
 	tabled_read_decl__test(Stream, A),
 	tabled_read_decl__write_int(A).
 
+:- pred tabled_read_decl__part_3(io__state::di, io__state::uo) is det.
+
+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.
 
@@ -132,5 +139,15 @@
 	[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.
+
+:- pragma foreign_proc("C", 
+	tabled_read_decl__fake_io(X::out, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+	X = 1;
 	IO = IO0;
 }").
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.78
diff -u -r1.78 mercury_trace.c
--- trace/mercury_trace.c	28 Jan 2005 06:42:54 -0000	1.78
+++ trace/mercury_trace.c	27 Mar 2005 03:39:40 -0000
@@ -515,7 +515,8 @@
 MR_Retry_Result
 MR_trace_retry(MR_Event_Info *event_info, MR_Event_Details *event_details,
     int ancestor_level, MR_Retry_Across_Io across_io,
-    MR_bool assume_all_io_is_tabled, const char **problem,
+    MR_bool assume_all_io_is_tabled, const char *retry_interactive_message,
+    MR_bool *unsafe_retry, const char **problem,
     FILE *in_fp, FILE *out_fp, MR_Code **jumpaddr)
 {
     MR_Word                 *base_sp;
@@ -676,6 +677,8 @@
             MR_bool allow_retry;
             char    *answer;
 
+            *unsafe_retry = MR_TRUE;
+
             switch (across_io) {
 
                 case MR_RETRY_IO_FORCE:
@@ -687,10 +690,8 @@
                         MR_fatal_error("MR_RETRY_IO_INTERACTIVE but null fp");
                     }
 
-                    fprintf(out_fp,
-                        "Retry across I/O operations is not always safe.\n");
-                    answer = MR_trace_getline(
-                        "Are you sure you want to do it? ", in_fp, out_fp);
+                    answer = MR_trace_getline(retry_interactive_message, in_fp,
+                        out_fp);
 
                     if (answer == NULL) {
                         /* the user has pressed EOF */
@@ -720,7 +721,11 @@
                 default:
                     MR_fatal_error("MR_trace_retry: unknown across_io");
             }
+        } else {
+            *unsafe_retry = MR_FALSE;
         }
+    } else {
+        *unsafe_retry = MR_FALSE;
     }
 
 #ifdef  MR_USE_MINIMAL_MODEL_STACK_COPY
Index: trace/mercury_trace.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.h,v
retrieving revision 1.28
diff -u -r1.28 mercury_trace.h
--- trace/mercury_trace.h	12 Jun 2003 15:38:35 -0000	1.28
+++ trace/mercury_trace.h	27 Mar 2005 03:39:40 -0000
@@ -117,6 +117,13 @@
 ** - If across_io is MR_RETRY_IO_INTERACTIVE (in which case in_fp and out_fp
 **   must both be non-NULL), and the user, when asked whether he/she wants
 **   to perform the retry anyway, says yes.
+**
+** If across_io is set to MR_RETRY_IO_INTERACTIVE then the string pointed to by
+** the retry_interactive_message argument will be used to ask the user 
+** whether they want to perform an unsafe retry or not.
+**
+** If an unsafe retry across IO is performed then the unsafe_retry argument
+** will be set to MR_TRUE, otherwise it will be set to MR_FALSE.  
 */
 
 typedef	enum {
@@ -137,6 +144,8 @@
 				int ancestor_level,
 				MR_Retry_Across_Io across_io,
 				MR_bool assume_all_io_is_tabled,
+				const char *retry_interactive_message,
+				MR_bool *unsafe_retry,
 				const char **problem,
 				FILE *in_fp, FILE *out_fp,
 				MR_Code **jumpaddr);
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.82
diff -u -r1.82 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c	12 Mar 2005 04:46:33 -0000	1.82
+++ trace/mercury_trace_declarative.c	27 Mar 2005 09:02:13 -0000
@@ -99,6 +99,17 @@
 #endif
 
 /*
+** The message to display when attempting to retry of an untabled area.
+*/
+
+#define MR_DECL_UNTABLED_IO_RETRY_MESSAGE \
+	"The declarative debugger needs to perform a retry across\n" \
+	"an area which is not IO tabled.  This is not always safe.\n" \
+	"To avoid this warning restart mdb and issue a `table_io start'\n" \
+	"command at an event before the suspect area.\n" \
+	"Do you wish to proceed with the retry? "
+
+/*
 ** The declarative debugger back end is controlled by the
 ** settings of the following variables.  They are set in
 ** MR_trace_start_decl_debug when the back end is started.  They
@@ -194,6 +205,15 @@
 static	MR_bool		MR_edt_compiler_flag_warning;
 
 /*
+** When building a supertree there will be 2 retries.  The first will
+** retry to an event before the topmost node of the currently materialized
+** tree and the second will be a retry from the topmost node to the root
+** of the new supertree.  This global records whether the user said it 
+** was safe to do the first retry across untabled IO.  If they said this was
+** okay then there's no point asked them again for the second retry.
+*/
+static	MR_bool		MR_edt_unsafe_retry_already_asked;
+/*
 ** This is used as the abstract map from node identifiers to nodes
 ** in the data structure passed to the front end.  It should be
 ** incremented each time the data structure is destructively
@@ -287,7 +307,8 @@
 static	MR_Code		*MR_decl_diagnosis(MR_Trace_Node root,
 				MR_Trace_Cmd_Info *cmd,
 				MR_Event_Info *event_info,
-				MR_Event_Details *event_details);
+				MR_Event_Details *event_details,
+				MR_bool new_tree);
 static	MR_Code		*MR_decl_go_to_selected_event(MR_Unsigned event,
 				MR_Trace_Cmd_Info *cmd,
 				MR_Event_Info *event_info,
@@ -296,7 +317,8 @@
 	** Retry max_distance if there are that many ancestors, otherwise
 	** retry as far as possible.
 	*/
-static	MR_Code		*MR_trace_decl_retry_max(MR_Unsigned max_distance, 
+static	MR_Code		*MR_trace_decl_retry_supertree(
+				MR_Unsigned max_distance, 
 				MR_Event_Info *event_info,
 				MR_Event_Details *event_details);
 static	MR_String	MR_trace_node_path(MR_Trace_Node node);
@@ -391,6 +413,7 @@
 				MR_edt_start_seqno && MR_port_is_entry(
 					event_info->MR_trace_port))
 			{
+				MR_Code	*jumpaddr;
 				/*
 				** We are entering the top of the currently
 				** materialized portion of the annotated trace.
@@ -400,9 +423,24 @@
 				** trace from there.
 				*/
 				MR_edt_inside = MR_TRUE;
-				return MR_trace_decl_retry_max(
-					MR_edt_max_depth - 1, 
+				jumpaddr = MR_trace_decl_retry_supertree(
+					MR_edt_max_depth, 
 					event_info, &event_details);
+				/*
+				** We will need all the io actions from
+				** the point after the retry above onwards.
+				*/
+				MR_edt_start_io_counter = 
+					MR_io_tabling_counter;
+				/*
+				** 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 jumpaddr;
 			} else {
 				/*
 				** We are in an existing explicit subtree.
@@ -439,6 +477,16 @@
 				** we are (re)entering the topmost call.
 				*/
 				MR_edt_inside = MR_TRUE;
+				/*
+				** If the port is a call and not a redo, then
+				** we need the io actions from here on.
+				*/
+				if (event_info->MR_trace_port == MR_PORT_CALL) 
+				{
+					MR_edt_start_io_counter = 
+						MR_io_tabling_counter;
+				}
+				MR_edt_depth = -1;
 			} else {
 				/*
 				** Ignore this event---it is outside the
@@ -577,12 +625,14 @@
 
 	if ((!MR_edt_building_supertree && 
 			MR_trace_event_number == MR_edt_last_event)
-			|| (MR_edt_building_supertree && MR_edt_depth == 0)) {
+			|| (MR_edt_building_supertree && 
+			MR_edt_depth + depth_check_adjustment == 0 
+			&& MR_port_is_final(event_info->MR_trace_port))) {
 		/*
 		** Call the front end.
 		*/
 		return MR_decl_diagnosis(MR_edt_return_node, cmd,
-				event_info, &event_details);
+				event_info, &event_details, MR_TRUE);
 	}
 
 	MR_debug_enabled = MR_TRUE;
@@ -591,13 +641,15 @@
 }
 
 static	MR_Code *
-MR_trace_decl_retry_max(MR_Unsigned max_distance, MR_Event_Info *event_info,
-	MR_Event_Details *event_details)
+MR_trace_decl_retry_supertree(MR_Unsigned max_distance, 
+	MR_Event_Info *event_info, MR_Event_Details *event_details)
 {
-	MR_Code		*jumpaddr;
-	int		retry_distance;
-	const char	*problem;
-	MR_Retry_Result retry_result;
+	MR_Code			*jumpaddr;
+	int			retry_distance;
+	const char		*problem;
+	MR_Retry_Result		retry_result;
+	MR_bool			unsafe_retry;
+	MR_Retry_Across_Io	retry_mode;
 
 	if (max_distance >= event_info->MR_call_depth) {
 		retry_distance = event_info->MR_call_depth - 1;
@@ -605,27 +657,39 @@
 		retry_distance = max_distance;
 	}
 	
+	/*
+	** If the user was already asked if they want to do an unsafe retry
+	** while building this supertree, then don't ask them again.
+	*/
+	if (MR_edt_unsafe_retry_already_asked) {
+		retry_mode = MR_RETRY_IO_FORCE;
+	} else {
+		retry_mode = MR_RETRY_IO_INTERACTIVE;
+	}
+
 	retry_result = MR_trace_retry(event_info, event_details,
-		retry_distance, MR_RETRY_IO_INTERACTIVE,
-		MR_trace_decl_assume_all_io_is_tabled, &problem, MR_mdb_in,
-		MR_mdb_out, &jumpaddr);
+		retry_distance, retry_mode,
+		MR_trace_decl_assume_all_io_is_tabled, 
+		MR_DECL_UNTABLED_IO_RETRY_MESSAGE, &unsafe_retry, 
+		&problem, MR_mdb_in, MR_mdb_out, &jumpaddr);
 
 	if (retry_result != MR_RETRY_OK_DIRECT) {
 		if (retry_result == MR_RETRY_ERROR) {
 			MR_trace_decl_mode = MR_TRACE_INTERACTIVE;
 			fflush(MR_mdb_out);
 			fprintf(MR_mdb_err, "mdb: retry aborted in "
-				"MR_trace_decl_retry_max: %s\n",
+				"MR_trace_decl_retry_supertree: %s\n",
 				problem);
 			return NULL;
 		} else {
 			fflush(MR_mdb_out);
 			fprintf(MR_mdb_err, "mdb: internal error in "
-				"MR_trace_decl_retry_max: direct retry "
+				"MR_trace_decl_retry_supertree: direct retry "
 				"impossible\n");
 			return NULL;
 		}
 	}
+	
 	return jumpaddr;
 }
 
@@ -1390,14 +1454,12 @@
 	/*
 	** If it was requested that the previous session be resumed and
 	** there was a previous dd session, then there is no need to 
-	** build a new annotated trace.  Just call the front end, passing
-	** NULL as the root node to let it know it must resume the 
-	** previous session.
+	** build a new annotated trace.
 	*/
 	if (!new_session && !first_time) {
 		MR_trace_decl_mode = trace_mode;
 		*jumpaddr = MR_decl_diagnosis((MR_Trace_Node) NULL, cmd, 
-			event_info, event_details);
+			event_info, event_details, MR_FALSE);
 		return MR_TRUE;
 	}
 
@@ -1467,7 +1529,6 @@
 
 	MR_trace_decl_ensure_init();
 	edt_depth_limit = MR_edt_depth_step_size;
-	MR_edt_depth = 0;
 	
 	MR_trace_current_node = (MR_Trace_Node) NULL;
 	
@@ -1507,8 +1568,6 @@
 	MR_trace_current_node = call_preceding;
 
 	edt_depth_limit = MR_edt_depth_step_size;
-	
-	MR_edt_depth = 0;
 
 	message = MR_trace_start_collecting(event, seqno, edt_depth_limit,
 			create_supertree, cmd, event_info, event_details,
@@ -1535,6 +1594,9 @@
 	const char		*problem;
 	MR_Retry_Result		retry_result;
 	int			retry_distance;
+	MR_bool			unsafe_retry;
+
+	MR_edt_unsafe_retry_already_asked = MR_FALSE;
 
 	/* 
 	** We need to do a retry if the current event is greater than the
@@ -1568,8 +1630,9 @@
 
 		retry_result = MR_trace_retry(event_info, event_details, 
 			retry_distance, MR_RETRY_IO_INTERACTIVE,
-			MR_trace_decl_assume_all_io_is_tabled, &problem, 
-			MR_mdb_in, MR_mdb_out, jumpaddr);
+			MR_trace_decl_assume_all_io_is_tabled, 
+			MR_DECL_UNTABLED_IO_RETRY_MESSAGE, &unsafe_retry,
+			&problem, MR_mdb_in, MR_mdb_out, jumpaddr);
 		if (retry_result != MR_RETRY_OK_DIRECT) {
 			if (retry_result == MR_RETRY_ERROR) {
 				return problem;
@@ -1578,6 +1641,9 @@
 					"impossible";
 			}
 		}
+		if (unsafe_retry) {
+			MR_edt_unsafe_retry_already_asked = MR_TRUE;
+		}
 	} else {
 		*jumpaddr = NULL;
 	}
@@ -1593,7 +1659,6 @@
 	*/
 	MR_edt_last_event = event;
 	MR_edt_start_seqno = seqno;
-	MR_edt_start_io_counter = MR_io_tabling_counter;
 	MR_edt_max_depth = maxdepth;
 	MR_edt_inside = MR_FALSE;
 	MR_edt_building_supertree = create_supertree;
@@ -1625,7 +1690,8 @@
 
 static	MR_Code *
 MR_decl_diagnosis(MR_Trace_Node root, MR_Trace_Cmd_Info *cmd,
-	MR_Event_Info *event_info, MR_Event_Details *event_details)
+	MR_Event_Info *event_info, MR_Event_Details *event_details,
+	MR_bool new_tree)
 {
 	MR_Word			response;
 	MR_bool			bug_found;
@@ -1651,8 +1717,7 @@
 				" the debugging tree.\n");
 	}
 
-	if (MR_trace_decl_mode == MR_TRACE_DECL_DEBUG_DUMP 
-			&& root != (MR_Trace_Node) NULL) {
+	if (MR_trace_decl_mode == MR_TRACE_DECL_DEBUG_DUMP && new_tree) {
 		MR_mercuryfile_init(MR_trace_store_file, 1, &stream);
 
 		MR_TRACE_CALL_MERCURY(
@@ -1696,9 +1761,9 @@
 	}
 
 	MR_TRACE_CALL_MERCURY(
-		if (root == (MR_Trace_Node) NULL) {
-			MR_DD_decl_diagnosis_resume_previous(
-				MR_trace_node_store, MR_FALSE,
+		if (new_tree == MR_TRUE) {
+			MR_DD_decl_diagnosis_new_tree(MR_trace_node_store, 
+				root, use_old_io_map,
 				MR_io_action_map_cache_start,
 				MR_io_action_map_cache_end,
 				&response, MR_trace_front_end_state,
@@ -1707,8 +1772,8 @@
 				&MR_trace_browser_persistent_state
 			);
 		} else {
-			MR_DD_decl_diagnosis_new_tree(MR_trace_node_store, 
-				root, use_old_io_map,
+			MR_DD_decl_diagnosis_resume_previous(
+				MR_trace_node_store, MR_FALSE,
 				MR_io_action_map_cache_start,
 				MR_io_action_map_cache_end,
 				&response, MR_trace_front_end_state,
@@ -1795,6 +1860,7 @@
 	MR_Retry_Result		retry_result;
 	MR_Code			*jumpaddr;
 	int			ancestor_level;
+	MR_bool			unsafe_retry;
 
 	/*
 	** We only need to do a retry if the event number we want to be at is
@@ -1824,7 +1890,9 @@
 				event_details, ancestor_level,
 				MR_RETRY_IO_INTERACTIVE,
 				MR_trace_decl_assume_all_io_is_tabled,
-				&problem, MR_mdb_in, MR_mdb_out, &jumpaddr);
+				MR_DECL_UNTABLED_IO_RETRY_MESSAGE, 
+				&unsafe_retry, &problem, MR_mdb_in, 
+				MR_mdb_out, &jumpaddr);
 #ifdef	MR_DEBUG_RETRY
 			MR_print_stack_regs(stdout, event_info->MR_saved_regs);
 			MR_print_succip_reg(stdout, event_info->MR_saved_regs);
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.77
diff -u -r1.77 mercury_trace_external.c
--- trace/mercury_trace_external.c	17 Jan 2005 05:58:10 -0000	1.77
+++ trace/mercury_trace_external.c	27 Mar 2005 03:39:40 -0000
@@ -503,6 +503,7 @@
 	MR_Retry_Result		retry_result;
 	static MR_String	MR_object_file_name;
 	int			lineno = 0;
+	MR_bool			unsafe_retry;
 
 	MR_debug_enabled = MR_FALSE;
 	MR_update_trace_func_enabled();
@@ -620,7 +621,8 @@
 				}
 				retry_result = MR_trace_retry(event_info, 
 					&event_details, 0,
-					MR_RETRY_IO_ONLY_IF_SAFE, MR_FALSE,
+					MR_RETRY_IO_ONLY_IF_SAFE, 
+					MR_FALSE, "", &unsafe_retry, 
 					&message, NULL, NULL, &jumpaddr);
 				if (retry_result == MR_RETRY_OK_DIRECT) {
 					MR_send_message_to_socket("ok");
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.197
diff -u -r1.197 mercury_trace_internal.c
--- trace/mercury_trace_internal.c	2 Mar 2005 01:20:23 -0000	1.197
+++ trace/mercury_trace_internal.c	27 Mar 2005 03:39:40 -0000
@@ -101,6 +101,15 @@
 
 #define MR_DEFAULT_DICE_LINES   50
 
+/*
+** The message to print for retries through un-io-tabled areas, when
+** the MR_RETRY_IO_INTERACTIVE option is given.
+*/
+
+#define MR_UNTABLED_IO_RETRY_MESSAGE \
+    "Retry across I/O operations is not always safe.\n" \
+    "Are you sure you want to do it? "
+
 #define MDBRC_FILENAME      ".mdbrc"
 #define DEFAULT_MDBRC_FILENAME  "mdbrc"
 
@@ -1946,6 +1955,7 @@
     const char          *problem;
     MR_Retry_Result     result;
     MR_bool             assume_all_io_is_tabled;
+    MR_bool             unsafe_retry;
 
     across_io = MR_RETRY_IO_INTERACTIVE;
     assume_all_io_is_tabled = MR_FALSE;
@@ -1968,7 +1978,8 @@
     }
 
     result = MR_trace_retry(event_info, event_details, ancestor_level,
-        across_io, assume_all_io_is_tabled, &problem, MR_mdb_in, MR_mdb_out,
+        across_io, assume_all_io_is_tabled, MR_UNTABLED_IO_RETRY_MESSAGE,
+        &unsafe_retry, &problem, MR_mdb_in, MR_mdb_out,
         jumpaddr);
     switch (result) {
 
Index: trace/mercury_trace_readline.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_readline.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_trace_readline.c
--- trace/mercury_trace_readline.c	6 Mar 2002 14:35:05 -0000	1.8
+++ trace/mercury_trace_readline.c	27 Mar 2005 03:39:40 -0000
@@ -65,6 +65,7 @@
  && !defined(MR_NO_USE_READLINE)
 	char	*line;
  	MR_bool	in_isatty;
+	char	*last_nl;
 
 	in_isatty = isatty(fileno(in));
 	if (in_isatty || MR_force_readline) {
@@ -95,8 +96,27 @@
 			rl_deprep_term_function =
 				(void *) MR_dummy_deprep_term_function;
 		}	
-
-		line = readline((char *) prompt);
+		
+		/*
+		** If the prompt contains newlines then readline doesn't
+		** display it properly.
+		*/
+		last_nl = strrchr(prompt, '\n');
+		if (last_nl != NULL) {
+			char	*real_prompt;
+			char	*pre_prompt;
+			real_prompt = (char *) MR_malloc(strlen(last_nl));
+			strcpy(real_prompt, last_nl + 1);
+			pre_prompt = (char *) MR_malloc(last_nl - prompt + 2);
+			strncpy(pre_prompt, prompt, last_nl - prompt + 1);
+			pre_prompt[last_nl - prompt + 1] = '\0';
+			fprintf(out, pre_prompt);
+			line = readline((char *) real_prompt);
+			MR_free(real_prompt);
+			MR_free(pre_prompt);
+		} else {
+			line = readline((char *) prompt);
+		}
 
 		/*
 		** readline() allocates with malloc(), and we want
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.61
diff -u -r1.61 mercury_trace_vars.c
--- trace/mercury_trace_vars.c	1 Feb 2005 03:24:32 -0000	1.61
+++ trace/mercury_trace_vars.c	27 Mar 2005 03:39:40 -0000
@@ -917,13 +917,13 @@
     MR_ConstString  proc_name;
     MR_Word         is_func;
     MR_Word         arg_list;
-    const char      *problem;
+    MR_bool         io_action_tabled;
     MR_bool         saved_io_tabling_enabled;
 
-    problem = MR_trace_get_action(action_number, &proc_name, &is_func,
+    io_action_tabled = MR_trace_get_action(action_number, &proc_name, &is_func,
         &arg_list);
-    if (problem != NULL) {
-        return problem;
+    if (!io_action_tabled) {
+        return "I/O action number not in range";
     }
 
     saved_io_tabling_enabled = MR_io_tabling_enabled;
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list