[m-rev.] for review: reset I/O tabling counter even if no !IO arguments
Ian MacLarty
maclarty at cs.mu.OZ.AU
Thu Oct 13 13:08:27 AEST 2005
For review by anyone.
Estimated hours taken: 2
Branches: main
Reset the I/O tabling counter on a retry if any I/O actions have occured inside
the call being retried, even if the procedure doesn't have a pair of I/O state
arguments.
This ensures retry works over impure procedures that do I/O, provided they
call tabled I/O primitives which take a pair of I/O states.
I picked this problem up while trying to debug code with a call to try_io.
try_io calls try, passing a goal that manufacturs its own I/O state.
doc/reference_manual.texi:
Document that tabled_for_io doesn't work with impure foreign procs
that do I/O if there are no I/O state arguments. Also document that
tabled_for_io will change in the future.
trace/mercury_trace.c:
Check if any I/O actions were performed and reset the I/O counter
accordingly, regardless of whether the procedure has a pair of
I/O state arguments. We still need to check if the procedure has
a pair of I/O state arguments, so we can warn the user if they
attempt a retry over such a call in the absense of I/O tabling.
We can't know if a call may do I/O if I/O tabling is off and it doesn't
have a pair of I/O state arguments, so we assume that it won't in this
case.
tests/debugger/declarative/Mercury.options:
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/io_tab_impure.exp:
tests/debugger/declarative/io_tab_impure.inp:
tests/debugger/declarative/io_tab_impure.m:
Test the change.
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.333
diff -u -r1.333 reference_manual.texi
--- doc/reference_manual.texi 6 Oct 2005 08:26:10 -0000 1.333
+++ doc/reference_manual.texi 13 Oct 2005 02:06:55 -0000
@@ -6149,6 +6149,12 @@
If the foreign procedure contains gotos or static variables then the
@samp{pragma no_inline} directive should also be given
(see @ref{pragma c_code}).
+Note that currently I/O tabling will only be done for foreign procedures
+that take a pair of I/O state arguments. Impure foreign procedures that
+perform I/O will not be made idempotent, even if the tabled_for_io
+attribute is present.
+Note also that the tabled_for_io attribute will likely be replaced in
+a future release with a more general solution.
@item @samp{terminates}/@samp{does_not_terminate}
This attribute specifies the termination properties of the given predicate
Index: tests/debugger/declarative/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mercury.options,v
retrieving revision 1.11
diff -u -r1.11 Mercury.options
--- tests/debugger/declarative/Mercury.options 28 Sep 2005 12:20:03 -0000 1.11
+++ tests/debugger/declarative/Mercury.options 13 Oct 2005 01:56:16 -0000
@@ -1,4 +1,5 @@
MCFLAGS-deep_sub=--trace rep --suppress-trace context
+MCFLAGS-io_tab_impure=--trace rep --trace-table-io-all
MCFLAGS-shallow_2=--trace shallow
MCFLAGS-tabled_read_decl=--trace rep --trace-table-io-all
MCFLAGS-tabled_read_decl_goto=--trace rep --trace-table-io-all
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.82
diff -u -r1.82 Mmakefile
--- tests/debugger/declarative/Mmakefile 16 Sep 2005 05:42:57 -0000 1.82
+++ tests/debugger/declarative/Mmakefile 13 Oct 2005 02:27:08 -0000
@@ -44,6 +44,7 @@
info \
input_term_dep \
io_stream_test \
+ io_tab_impure \
ite_2 \
lpe_example \
mapinit \
@@ -366,6 +367,11 @@
> io_stream_test.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
+io_tab_impure.out: io_tab_impure io_tab_impure.inp
+ $(MDB_STD) ./io_tab_impure < io_tab_impure.inp \
+ > io_tab_impure.out 2>&1 \
+ || { grep . $@ /dev/null; exit 1; }
+
ite_2.out: ite_2 ite_2.inp
$(MDB) ./ite_2 < ite_2.inp > ite_2.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
Index: tests/debugger/declarative/io_tab_impure.exp
===================================================================
RCS file: tests/debugger/declarative/io_tab_impure.exp
diff -N tests/debugger/declarative/io_tab_impure.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_tab_impure.exp 13 Oct 2005 02:30:04 -0000
@@ -0,0 +1,34 @@
+ E1: C1 CALL pred io_tab_impure.main/2-0 (det) io_tab_impure.m:11
+mdb> mdb> echo on
+Command echo enabled.
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> break impure_print_hello
+ 0: + stop interface pred io_tab_impure.impure_print_hello/0-0 (det)
+mdb> c
+ E2: C2 CALL pred io_tab_impure.impure_print_hello/0-0 (det) io_tab_impure.m:24 (io_tab_impure.m:20)
+mdb> f
+hello E3: C2 EXIT pred io_tab_impure.impure_print_hello/0-0 (det) io_tab_impure.m:24 (io_tab_impure.m:20)
+mdb> dd -a
+impure_print_hello
+1 tabled IO action:
+print("hello")
+Valid? n
+impure_print("hello")
+1 tabled IO action:
+print("hello")
+Valid? n
+make_io_state(_)
+Valid? y
+print("hello", _, _)
+1 tabled IO action:
+print("hello")
+Valid? n
+Found incorrect contour:
+print("hello", _, _)
+1 tabled IO action:
+print("hello")
+Is this a bug? y
+ E4: C3 EXIT pred io_tab_impure.print/3-0 (det) io_tab_impure.m:36 (io_tab_impure.m:31)
+mdb> quit -y
Index: tests/debugger/declarative/io_tab_impure.inp
===================================================================
RCS file: tests/debugger/declarative/io_tab_impure.inp
diff -N tests/debugger/declarative/io_tab_impure.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_tab_impure.inp 13 Oct 2005 02:29:35 -0000
@@ -0,0 +1,14 @@
+register --quiet
+echo on
+table_io allow
+table_io start
+break impure_print_hello
+c
+f
+dd -a
+n
+n
+y
+n
+y
+quit -y
Index: tests/debugger/declarative/io_tab_impure.m
===================================================================
RCS file: tests/debugger/declarative/io_tab_impure.m
diff -N tests/debugger/declarative/io_tab_impure.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_tab_impure.m 13 Oct 2005 02:20:39 -0000
@@ -0,0 +1,56 @@
+:- module io_tab_impure.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+ print_hello(!IO),
+ nl(!IO).
+
+:- pred print_hello(io::di, io::uo) is det.
+
+:- pragma promise_pure(print_hello/2).
+
+print_hello(!IO) :-
+ impure impure_print_hello.
+
+:- impure pred impure_print_hello is det.
+
+impure_print_hello :-
+ impure impure_print("hello").
+
+:- impure pred impure_print(string::in) is det.
+
+impure_print(S) :-
+ impure make_io_state(IO0),
+ io_tab_impure.print(S, IO0, IO),
+ impure consume_io_state(IO).
+
+:- pred print(string::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ print(S::in, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
+"
+ printf(S);
+ IO = IO0;
+").
+
+:- impure pred make_io_state(io::uo) is det.
+
+:- pragma foreign_proc("C",
+ make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe],
+"").
+
+:- impure pred consume_io_state(io::di) is det.
+
+:- pragma foreign_proc("C",
+ consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe],
+"").
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.90
diff -u -r1.90 mercury_trace.c
--- trace/mercury_trace.c 10 Oct 2005 07:58:11 -0000 1.90
+++ trace/mercury_trace.c 12 Oct 2005 07:34:07 -0000
@@ -638,6 +638,7 @@
MR_bool succeeded;
MR_Word *saved_regs;
MR_bool has_io_state;
+ MR_bool io_actions_were_performed;
MR_bool is_io_state;
MR_bool found_io_action_counter;
MR_Unsigned saved_io_action_counter;
@@ -768,15 +769,29 @@
}
}
- if (has_io_state) {
- MR_Unsigned cur_event_num;
+ found_io_action_counter = MR_find_saved_io_counter(call_label,
+ base_sp, base_curfr, &saved_io_action_counter);
+
+ if ((found_io_action_counter &&
+ saved_io_action_counter < MR_io_tabling_counter) ||
+ ((! found_io_action_counter) && has_io_state))
+ {
+ io_actions_were_performed = MR_TRUE;
+ } else {
+ /*
+ ** XXX We assume calls that weren't I/O tabled and that don't have
+ ** a pair of I/O state arguments did not do any I/O.
+ ** This assumption breaks for impure code that does I/O,
+ ** but we don't have a way to check if predicates are impure in the
+ ** debugger yet.
+ */
+ io_actions_were_performed = MR_FALSE;
+ }
+
+ if (io_actions_were_performed) {
MR_Unsigned retry_event_num;
MR_bool all_actions_tabled;
- found_io_action_counter = MR_find_saved_io_counter(call_label,
- base_sp, base_curfr, &saved_io_action_counter);
- cur_event_num = event_info->MR_event_number;
-
/*
** Event numbers are stored *before* being incremented at calls.
*/
@@ -794,7 +809,7 @@
#endif
if (! MR_retry_within_io_tabled_region(all_actions_tabled,
- retry_event_num, cur_event_num))
+ retry_event_num, event_info->MR_event_number))
{
MR_bool allow_retry;
char *answer;
@@ -847,7 +862,6 @@
*unsafe_retry = MR_FALSE;
}
} else {
- found_io_action_counter = MR_FALSE; /* avoid a warning */
*unsafe_retry = MR_FALSE;
}
@@ -991,7 +1005,7 @@
MR_saved_reg_assign(saved_regs, i, args[i]);
}
- if (has_io_state && found_io_action_counter) {
+ if (io_actions_were_performed && found_io_action_counter) {
MR_io_tabling_counter = saved_io_action_counter;
}
--------------------------------------------------------------------------
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