[m-rev.] for review: make I/O tabling respect pragma no_inline

Ian MacLarty maclarty at cs.mu.OZ.AU
Wed Sep 14 16:47:53 AEST 2005


On Wed, 14 Sep 2005, Julien Fischer wrote:

>
> On Wed, 14 Sep 2005, Ian MacLarty wrote:
>
> > For review by anyone.
> >
> > Please note that I use the original goal_info for the new call goal.  I
> > looked through the goal_info and there didn't seem to be anything that would
> > need to be changed, but I may have missed something.
> >
> > Estimated hours taken: 3
> > Branches: main and 0.12
> >
> > Make the I/O tabling transformation respect :- pragma no_inline directives
> > by creating a copy of the predicate to be transformed and calling the
> > copy, instead of duplicating the body, if :- pragma no_inline is
> > given.
> >
> > compiler/hlds_pred.m:
> > 	Add a new functor to the pred_creation type to indicate that a pred
> > 	was created by the I/O tabling transformation.
> >
> > 	Fix some formatting.
> >
> > compiler/table_gen.m:
> > 	If the predicate to be I/O tabled should not be inlined, then
>
> I suggest:
>
> 	If the predicate to be I/O tabled has a no_inline pragma
> 	attached to it ... etc
>

Done.

> > 	create a copy of the predicate and call the new predicate in the
> > 	transformed version.
> >
> > tests/debugger/Mercury.options:
> > tests/debugger/Mmakefile:
> > tests/debugger/io_tab_goto.data:
> > tests/debugger/io_tab_goto.exp:
> > tests/debugger/io_tab_goto.inp:
> > tests/debugger/io_tab_goto.m:
> > 	Test that foreign C code with labels is I/O tabled correctly.
> >
>
> I suggest also updating the user guide extion on I/O tabling to warn about
> C code that contains labels.
>

I don't think that's the right place.  I think it should be documented
with the tabled_for_io attribute in the reference manual, however the
tabled_for_io attribute isn't documented at all, so I've added the
following to the reference manual:

@@ -6004,6 +6004,15 @@

 @table @asis

+ at item @samp{tabled_for_io}
+This attribute should be attached to foreign procs which do I/O.  It
+tells the debugger to make calls to the foreign proc idempotent.
+This allows the debugger to safely retry accross such calls and also
+allows safe declarative debugging of code containing such calls.
+For more information see the I/O tabling section of the Mercury user guide.
+If the foreign proc contains gotos then the @samp{pragma no_inline}
+directive should also be given.
+
 @item @samp{terminates}/@samp{does_not_terminate}
 This attribute specifies the termination properties of the given predicate
 or function definition.  It is equivalent to the corresponding


> > Index: compiler/table_gen.m
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
> > retrieving revision 1.91
> > diff -u -r1.91 table_gen.m
> > --- compiler/table_gen.m	12 Sep 2005 08:41:57 -0000	1.91
> > +++ compiler/table_gen.m	13 Sep 2005 09:06:16 -0000
> > @@ -1175,9 +1175,30 @@
> >          OrigInputVars, OrigOutputVars, !VarTypes, !VarSet,
> >          !TableInfo, Goal, MaybeProcTableInfo) :-
> >      OrigGoal = _ - OrigGoalInfo,
> > +    ModuleInfo0 = !.TableInfo ^ table_module_info,
> > +    module_info_pred_info(ModuleInfo0, PredId, PredInfo),
> > +    pred_info_get_markers(PredInfo, Markers),
> > +    ( check_marker(Markers, user_marked_no_inline) ->
> > +        %
> > +        % If the predicate should not be inlined, then we create a new
> > +        % predicate with the same body as the original predicate, which is
> > +        % called where-ever the original goal would appear in the transformed
> s/where-ever/wherever/
>

Fixed.

> > +        % code.  This is necessary when the original goal is foreign C code
> > +        % which uses labels.  The original goal would otherwise be duplicated
>
> s/which/that
>

Fixed.

> > +        % by the transformation, resulting in duplicate label errors from
> > +        % the C compiler.
> > +        %
> > +        clone_proc_and_create_call(PredInfo, ProcId, CallExpr, ModuleInfo0,
> > +            ModuleInfo),
> > +        NewGoal = CallExpr - OrigGoalInfo,
> > +        !:TableInfo = !.TableInfo ^ table_module_info := ModuleInfo
> > +    ;
> > +        NewGoal = OrigGoal,
> > +        ModuleInfo = ModuleInfo0
> > +    ),
>
> That looks fine otherwise.
>

I actually missed something:  The introduced predicate must not be traced.
If it is traced then the event numbers of events after the I/O action will
be different when the I/O action is reexecuted (because the introduced
predicate won't be reexecuted).

Here's the interdiff that fixes this:

only in patch2:
--- compiler/trace_params.m	29 Aug 2005 08:44:13 -0000	1.24
+++ compiler/trace_params.m	14 Sep 2005 04:59:39 -0000
@@ -180,6 +180,14 @@
 				SpecialPred = (initialise),
 				EffTraceLevel = TraceLevel
 			)
+		; Origin = created(io_tabling) ->
+			% Predicates called by a predicate which is I/O
+			% tabled should not be traced.  If such a predicate
+			% were allowed to generate events then the event
+			% numbers of events after the I/O primitive would be
+			% different between the first and subsequent
+			% (idempotent) executions of the same I/O action.
+			EffTraceLevel = none
 		;
 			pred_info_import_status(PredInfo, Status),
 			(
only in patch2:
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl_goto.m	14 Sep 2005 05:24:26 -0000
@@ -0,0 +1,174 @@
+% We define our own I/O primitives, in case the library was compiled without
+% IO tabling.
+
+:- module tabled_read_decl_goto.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module list, char, int.
+
+main -->
+	tabled_read_decl_goto__open_input("tabled_read_decl_goto.data", Res,
+		Stream),
+	( { Res = 0 } ->
+		tabled_read_decl_goto__part_1(Stream),
+		tabled_read_decl_goto__part_2(Stream),
+		tabled_read_decl_goto__part_3
+	;
+		io__write_string("could not open tabled_read.data\n")
+	).
+
+:- pred tabled_read_decl_goto__part_1(c_pointer::in,
+	io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__part_1(Stream) -->
+	tabled_read_decl_goto__test(Stream, A),
+	tabled_read_decl_goto__write_int(A),
+	tabled_read_decl_goto__poly_test(Stream, ['a', 'b', 'c'], B),
+	tabled_read_decl_goto__write_int(B).
+
+:- pred tabled_read_decl_goto__part_2(c_pointer::in,
+	io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__part_2(Stream) -->
+	tabled_read_decl_goto__test(Stream, A),
+	tabled_read_decl_goto__write_int(A).
+
+:- pred tabled_read_decl_goto__part_3(io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__part_3(!IO) :-
+	tabled_read_decl_goto__fake_io(X, !IO),
+	tabled_read_decl_goto__write_int(X, !IO).
+
+:- pred tabled_read_decl_goto__test(c_pointer::in, int::out,
+	io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__test(Stream, N) -->
+		% BUG: the 1 should be 0
+	tabled_read_decl_goto__test_2(Stream, 1, N).
+
+:- pred tabled_read_decl_goto__test_2(c_pointer::in, int::in, int::out,
+	io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__test_2(Stream, SoFar, N) -->
+	tabled_read_decl_goto__read_char_code(Stream, CharCode),
+	(
+		{ char__to_int(Char, CharCode) },
+		{ char__is_digit(Char) },
+		{ char__digit_to_int(Char, CharInt) }
+	->
+		tabled_read_decl_goto__test_2(Stream, SoFar * 10 + CharInt, N)
+	;
+		{ N = SoFar }
+	).
+
+:- pred tabled_read_decl_goto__poly_test(c_pointer::in, T::in, int::out,
+	io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__poly_test(Stream, Unused, N) -->
+		% BUG: the 1 should be 0
+	tabled_read_decl_goto__poly_test_2(Stream, Unused, 1, N).
+
+:- pred tabled_read_decl_goto__poly_test_2(c_pointer::in, T::in, int::in,
+	int::out, io__state::di, io__state::uo) is det.
+
+tabled_read_decl_goto__poly_test_2(Stream, Unused, SoFar, N) -->
+	tabled_read_decl_goto__poly_read_char_code(Stream, Unused, CharCode),
+	(
+		{ char__to_int(Char, CharCode) },
+		{ char__is_digit(Char) },
+		{ char__digit_to_int(Char, CharInt) }
+	->
+		tabled_read_decl_goto__poly_test_2(Stream, Unused,
+			SoFar * 10 + CharInt, N)
+	;
+		{ N = SoFar }
+	).
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred tabled_read_decl_goto__open_input(string::in, int::out, c_pointer::out,
+	io__state::di, io__state::uo) is det.
+
+:- pragma no_inline(tabled_read_decl_goto__open_input/5).
+
+:- pragma foreign_proc("C",
+	tabled_read_decl_goto__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;
+	goto end1;
+end1:
+	IO = IO0;
+").
+
+:- pred tabled_read_decl_goto__read_char_code(c_pointer::in, int::out,
+	io__state::di, io__state::uo) is det.
+
+:- pragma no_inline(tabled_read_decl_goto__read_char_code/4).
+
+:- pragma foreign_proc("C",
+	tabled_read_decl_goto__read_char_code(Stream::in, CharCode::out,
+		IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"
+	CharCode = getc((FILE *) Stream);
+	goto end2;
+end2:
+	IO = IO0;
+").
+
+:- pred tabled_read_decl_goto__poly_read_char_code(c_pointer::in, T::in,
+	int::out, io__state::di, io__state::uo) is det.
+
+:- pragma no_inline(tabled_read_decl_goto__poly_read_char_code/5).
+
+:- pragma foreign_proc("C",
+	tabled_read_decl_goto__poly_read_char_code(Stream::in, Unused::in,
+		CharCode::out, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"
+	/* ignore Unused */
+	CharCode = getc((FILE *) Stream);
+	goto end3;
+end3:
+	IO = IO0;
+").
+
+:- pred tabled_read_decl_goto__write_int(int::in, io__state::di, io__state::uo)
+	is det.
+
+:- pragma no_inline(tabled_read_decl_goto__write_int/3).
+
+:- pragma foreign_proc("C",
+	tabled_read_decl_goto__write_int(N::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+	printf(""%d\\n"", (int) N);
+	goto end4;
+end4:
+	IO = IO0;
+}").
+
+:- pred tabled_read_decl_goto__fake_io(int::out, io::di, io::uo) is det.
+
+:- pragma no_inline(tabled_read_decl_goto__fake_io/3).
+
+:- pragma foreign_proc("C",
+	tabled_read_decl_goto__fake_io(X::out, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+	X = 1;
+	goto end5;
+end5:
+	IO = IO0;
+}").
only in patch2:
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl_goto.inp	14 Sep 2005 05:19:40 -0000
@@ -0,0 +1,50 @@
+echo on
+register --quiet
+context none
+table_io allow
+table_io start
+break tabled_read_decl_goto__test
+continue
+finish -n
+print
+dd -d 3 -n 7 -a
+print 1-2
+p io 1-2
+print io 2-1
+browse io 4
+print
+set num_io_actions 3
+quit
+browse 1
+set num_io_actions 10
+quit
+no
+yes
+yes
+break tabled_read_decl_goto.part_2
+c
+break tabled_read_decl_goto.test
+c
+delete *
+f
+dd -d 3 -n 7 -ad1
+y
+n
+y
+y
+break tabled_read_decl_goto.part_3
+c
+break tabled_read_decl_goto.fake_io
+c
+table_io stop
+delete *
+f
+dd -d 3 -n 7 -ad1
+y
+y
+y
+n
+y
+y
+y
+c
only in patch2:
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl_goto.exp	14 Sep 2005 05:23:08 -0000
@@ -0,0 +1,172 @@
+      E1:     C1 CALL pred tabled_read_decl_goto.main/2-0 (det) tabled_read_decl_goto.m:17
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> break tabled_read_decl_goto__test
+ 0: + stop  interface pred tabled_read_decl_goto.test/4-0 (det)
+mdb> continue
+      E2:     C2 CALL pred tabled_read_decl_goto.test/4-0 (det)
+mdb> finish -n
+      E3:     C2 EXIT pred tabled_read_decl_goto.test/4-0 (det)
+mdb> print
+test('<<c_pointer>>', 1123, _, _)
+mdb> dd -d 3 -n 7 -a
+test('<<c_pointer>>', 1123, _, _)
+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? print 1-2
+'<<c_pointer>>'
+1123
+dd> p io 1-2
+read_char_code('<<c_pointer>>', 49)
+read_char_code('<<c_pointer>>', 50)
+dd> print io 2-1
+read_char_code('<<c_pointer>>', 49)
+read_char_code('<<c_pointer>>', 50)
+dd> browse io 4
+browser> print
+read_char_code('<<c_pointer>>', 10)
+browser> set num_io_actions 3
+browser> quit
+dd> browse 1
+browser> set num_io_actions 10
+browser> quit
+dd> no
+test_2('<<c_pointer>>', 1, 1123, _, _)
+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? yes
+Found incorrect contour:
+test_2('<<c_pointer>>', 1, 1123, _, _)
+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 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_goto.test/4-0 (det)
+mdb> break tabled_read_decl_goto.part_2
+ 1: + stop  interface pred tabled_read_decl_goto.part_2/3-0 (det)
+mdb> c
+1123
+1456
+      E4:     C3 CALL pred tabled_read_decl_goto.part_2/3-0 (det)
+mdb> break tabled_read_decl_goto.test
+ 2: + stop  interface pred tabled_read_decl_goto.test/4-0 (det)
+mdb> c
+      E5:     C4 CALL pred tabled_read_decl_goto.test/4-0 (det)
+mdb> delete *
+ 0: E stop  interface pred tabled_read_decl_goto.test/4-0 (det)
+ 1: E stop  interface pred tabled_read_decl_goto.part_2/3-0 (det)
+ 2: E stop  interface pred tabled_read_decl_goto.test/4-0 (det)
+mdb> f
+      E6:     C4 EXIT pred tabled_read_decl_goto.test/4-0 (det)
+mdb> dd -d 3 -n 7 -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_goto.part_2/3-0 (det)
+mdb> break tabled_read_decl_goto.part_3
+ 0: + stop  interface pred tabled_read_decl_goto.part_3/2-0 (det)
+mdb> c
+      E8:     C5 CALL pred tabled_read_decl_goto.part_3/2-0 (det)
+mdb> break tabled_read_decl_goto.fake_io
+ 1: + stop  interface pred tabled_read_decl_goto.fake_io/3-0 (det)
+mdb> c
+      E9:     C6 CALL pred tabled_read_decl_goto.fake_io/3-0 (det)
+mdb> table_io stop
+I/O tabling stopped.
+mdb> delete *
+ 0: E stop  interface pred tabled_read_decl_goto.part_3/2-0 (det)
+ 1: E stop  interface pred tabled_read_decl_goto.fake_io/3-0 (det)
+mdb> f
+     E10:     C6 EXIT pred tabled_read_decl_goto.fake_io/3-0 (det)
+mdb> dd -d 3 -n 7 -ad1
+The declarative debugger needs to perform a retry across
+an area in which IO is not 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 are not tabled.
+Valid? y
+The declarative debugger needs to perform a retry across
+an area in which IO is not 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 are not tabled.
+Valid? n
+write_int(1, _, _)
+Warning: some IO actions for this atom are not tabled.
+Valid? y
+Found incorrect contour:
+fake_io(1, _, _)
+Warning: some IO actions for this atom are not tabled.
+write_int(1, _, _)
+Warning: some IO actions for this atom are not tabled.
+part_3(_, _)
+Warning: some IO actions for this atom are not tabled.
+Is this a bug? y
+The declarative debugger needs to perform a retry across
+an area in which IO is not 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_goto.part_3/2-0 (det)
+mdb> c
only in patch2:
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl_goto.data	14 Sep 2005 05:25:02 -0000
@@ -0,0 +1,4 @@
+123
+456
+789
+42
only in patch2:
--- tests/debugger/declarative/Mmakefile	13 Sep 2005 04:04:06 -0000	1.81
+++ tests/debugger/declarative/Mmakefile	14 Sep 2005 05:23:44 -0000
@@ -65,6 +65,7 @@
 	special_term_dep	\
 	skip			\
 	tabled_read_decl	\
+	tabled_read_decl_goto	\
 	throw			\
 	trust			\
 	undo			\
@@ -470,6 +471,11 @@
 tabled_read_decl.out: tabled_read_decl tabled_read_decl.inp
 	$(MDB_STD) ./tabled_read_decl < tabled_read_decl.inp \
 		> tabled_read_decl.out 2>&1 \
+	|| { grep . $@ /dev/null; exit 1; }
+
+tabled_read_decl_goto.out: tabled_read_decl_goto tabled_read_decl_goto.inp
+	$(MDB_STD) ./tabled_read_decl_goto < tabled_read_decl_goto.inp \
+		> tabled_read_decl_goto.out 2>&1 \
 	|| { grep . $@ /dev/null; exit 1; }

 # We need to pipe the output through sed to avoid hard-coding dependencies on
only in patch2:
--- doc/reference_manual.texi	13 Sep 2005 03:25:42 -0000	1.326
+++ doc/reference_manual.texi	14 Sep 2005 05:45:55 -0000
@@ -6004,6 +6004,15 @@

 @table @asis

+ at item @samp{tabled_for_io}
+This attribute should be attached to foreign procs which do I/O.  It
+tells the debugger to make calls to the foreign proc idempotent.
+This allows the debugger to safely retry accross such calls and also
+allows safe declarative debugging of code containing such calls.
+For more information see the I/O tabling section of the Mercury user guide.
+If the foreign proc contains gotos then the @samp{pragma no_inline}
+directive should also be given.
+
 @item @samp{terminates}/@samp{does_not_terminate}
 This attribute specifies the termination properties of the given predicate
 or function definition.  It is equivalent to the corresponding
@@ -6011,6 +6020,7 @@
 If omitted, the termination property of the procedure is determined by the
 value of the @samp{may_call_mercury}/@samp{will_not_call_mercury} attribute.
 See @ref{Termination analysis} for more details.
+
 @item @samp{max_stack_size(Size)}
 This attribute declares the maximum stack usage of a particular piece of
 code.  The unit that @samp{Size} is measured in depends upon foreign language
@@ -6018,6 +6028,7 @@
 Currently this attribute is only used (and is in fact required) by the
 @samp{IL} foreign language interface, and is measured in units of stack
 items.
+
 @item @samp{will_not_throw_exception}
 This attribute promises that the given predicate or function will not
 make calls back to Mercury that may result in an exception being thrown.
@@ -6033,10 +6044,12 @@
 these types may also throw exceptions.  As such, we recommend that
 only implementors of the Mercury system use this annotation for
 polymorphic predicates and functions.
+
 @c @item @samp{high_level_backend}
 @c The foreign_proc will apply only on the high level backend.
 @c @item @samp{low_level_backend}
 @c The foreign_proc will apply only on the low level backend.
+
 @end table

 @c -----------------------------------------------------------------------

--------------------------------------------------------------------------
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