Make the I/O tabling transformation respect :- pragma no_inline directives

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. This is necessary to avoid duplicate label errors from the C compiler when the I/O tabled foreign proc uses labels. 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 has a no_inline pragma attached to it, then create a copy of the predicate and call the new predicate in the transformed version. compiler/trace_params.m: Do not trace the copy of the I/O tabled predicate. doc/reference_manual.texi Document the tabled_for_io attribute. 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. tests/debugger/declarative/Mmakefile: tests/debugger/declarative/tabled_read_decl_goto.data: tests/debugger/declarative/tabled_read_decl_goto.exp: tests/debugger/declarative/tabled_read_decl_goto.inp: tests/debugger/declarative/tabled_read_decl_goto.m: Test declarative debugging of I/O tabled foreign predicates with gotos.
2026-04-15 01:13:30 +00:00 · 2005-09-16 05:42:58 +00:00
parent 9ec3ae8d08
commit 3d2c49e759
15 changed files with 743 additions and 8 deletions
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -1337,7 +1337,10 @@ add_clause(Clause, !ClausesRep) :-
    ;       aditi_magic_supp
    ;       aditi_join
    ;       aditi_rl_exprn
-    ;       deforestation.
+    ;       deforestation
+                % I/O tabling will create a new predicate if the predicate
+                % to be I/O tabled must not be inlined.
+    ;       io_tabling.

 :- type pred_origin
    --->    special_pred(special_pred)
@@ -1772,7 +1775,7 @@ calls_are_fully_qualified(Markers) =
    % polymorphically-typed arguments whose type depends on the
    % values of those type_info-related variables;
    % accurate GC for the MLDS back-end relies on this.
- :- type pred_info --->
+:- type pred_info --->
    pred_info(
        module_name         :: module_name,
                            % Module in which pred occurs.
--- a/compiler/table_gen.m
+++ b/compiler/table_gen.m
@@ -1175,9 +1175,30 @@ table_gen__create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
        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 wherever the original goal would appear in the transformed
+        % code.  This is necessary when the original goal is foreign C code
+        % that uses labels.  The original goal would otherwise be duplicated
+        % 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
+    ),
    goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
    goal_info_get_context(OrigGoalInfo, Context),
-    ModuleInfo = !.TableInfo ^ table_module_info,
+
    (
        TableIoStates = yes,
        IoStateAssignToVars = [],
@@ -1290,7 +1311,7 @@ table_gen__create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
        SaveAnswerGoals),
    (
        Unitize = table_io_alone,
-        CallSaveAnswerGoalList = [OrigGoal, TableIoDeclGoal | SaveAnswerGoals]
+        CallSaveAnswerGoalList = [NewGoal, TableIoDeclGoal | SaveAnswerGoals]
    ;
        Unitize = table_io_unitize,
        generate_new_table_var("SavedTraceEnabled", int_type,
@@ -1302,7 +1323,7 @@ table_gen__create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
        generate_call("table_io_right_bracket_unitized_goal", det,
            [SavedTraceEnabledVar], impure_code, [],
            ModuleInfo, Context, RightBracketGoal),
-        CallSaveAnswerGoalList = [LeftBracketGoal, OrigGoal,
+        CallSaveAnswerGoalList = [LeftBracketGoal, NewGoal,
            RightBracketGoal, TableIoDeclGoal | SaveAnswerGoals]
    ),
    CallSaveAnswerGoalExpr = conj(CallSaveAnswerGoalList),
@@ -1341,8 +1362,8 @@ table_gen__create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
        - CheckAndGenAnswerGoalInfo,

    BodyGoalExpr = if_then_else([], InRangeGoal, CheckAndGenAnswerGoal,
-        OrigGoal),
-    create_instmap_delta([InRangeGoal, CheckAndGenAnswerGoal, OrigGoal],
+        NewGoal),
+    create_instmap_delta([InRangeGoal, CheckAndGenAnswerGoal, NewGoal],
        BodyInstMapDelta0),
    instmap_delta_restrict(OrigNonLocals, BodyInstMapDelta0, BodyInstMapDelta),
    goal_info_init_hide(OrigNonLocals, BodyInstMapDelta, det, impure,
@@ -1784,6 +1805,55 @@ clone_pred_info(OrigPredId, PredInfo0, HeadVars, NumberedOutputVars,
    module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo),
    !:TableInfo = !.TableInfo ^ table_module_info := ModuleInfo.

+    % clone_proc_and_create_call(PredInfo, ProcId, CallExpr, !ModuleInfo).
+    % This predicate creates a new procedure with the same body as the
+    % procedure with ProcId in PredInfo.  It then creates a call goal
+    % expression which calls the new procedure with its formal arguments as the
+    % actual arguments.
+    %
+:- pred clone_proc_and_create_call(pred_info::in, proc_id::in, 
+    hlds_goal_expr::out, module_info::in, module_info::out) is det.
+
+clone_proc_and_create_call(PredInfo, ProcId, CallExpr, !ModuleInfo) :-
+        pred_info_proc_info(PredInfo, ProcId, ProcInfo),
+        proc_info_context(ProcInfo, ProcContext),
+        proc_info_varset(ProcInfo, ProcVarSet),
+        proc_info_vartypes(ProcInfo, ProcVarTypes),
+        proc_info_headvars(ProcInfo, ProcHeadVars),
+        proc_info_inst_varset(ProcInfo, ProcInstVarSet),
+        proc_info_argmodes(ProcInfo, ProcHeadModes),
+        proc_info_inferred_determinism(ProcInfo, ProcDetism),
+        proc_info_goal(ProcInfo, ProcGoal),
+        proc_info_rtti_varmaps(ProcInfo, ProcRttiVarMaps),
+        proc_info_create(ProcContext, ProcVarSet, ProcVarTypes, 
+                ProcHeadVars, ProcInstVarSet, ProcHeadModes,
+                ProcDetism, ProcGoal, ProcRttiVarMaps, address_is_not_taken,
+                NewProcInfo),
+        ModuleName = pred_info_module(PredInfo),
+        OrigPredName = pred_info_name(PredInfo),
+        PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+        pred_info_context(PredInfo, PredContext),
+        NewPredName = qualified(ModuleName, "OutlinedForIOTablingFrom_" ++ 
+            OrigPredName),
+        pred_info_arg_types(PredInfo, PredArgTypes),
+        pred_info_typevarset(PredInfo, PredTypeVarSet),
+        pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars),
+        pred_info_get_class_context(PredInfo, PredClassContext),
+        pred_info_get_assertions(PredInfo, PredAssertions),
+        pred_info_get_aditi_owner(PredInfo, AditiOwner),
+        pred_info_get_markers(PredInfo, Markers),
+        pred_info_create(ModuleName, NewPredName, PredOrFunc, PredContext, 
+                created(io_tabling), local, Markers, PredArgTypes, 
+                PredTypeVarSet, PredExistQVars, PredClassContext,
+                PredAssertions, AditiOwner, NewProcInfo, NewProcId, 
+                NewPredInfo),
+        module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
+		predicate_table_insert(NewPredInfo, NewPredId,
+			PredicateTable0, PredicateTable),
+		module_info_set_predicate_table(PredicateTable, !ModuleInfo),
+        CallExpr = call(NewPredId, NewProcId, ProcHeadVars, not_builtin, no,
+            NewPredName).
+
 :- pred keep_only_output_arg_types(assoc_list(prog_var, type)::in,
    list(var_mode_pos_method)::in, list(type)::out) is det.

--- a/compiler/trace_params.m
+++ b/compiler/trace_params.m
@@ -180,6 +180,14 @@ eff_trace_level(PredInfo, ProcInfo, TraceLevel) = EffTraceLevel :-
 				SpecialPred = (initialise),
 				EffTraceLevel = TraceLevel
 			)
+		; Origin = created(io_tabling) ->
+			% Predicates called by a predicate that 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),
 			(
--- a/doc/reference_manual.texi
+++ b/doc/reference_manual.texi
@@ -6004,6 +6004,16 @@ compiler are as follows:

@table @asis

+@item @samp{tabled_for_io}
+This attribute should be attached to foreign procedures that do I/O.  It
+tells the debugger to make calls to the foreign procedure idempotent.
+This allows the debugger to safely retry across 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 procedure contains gotos or static variables then the
+@samp{pragma no_inline} directive should also be given 
+(see @ref{pragma c_code}).
+
@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 +6021,7 @@ or function definition.  It is equivalent to the corresponding
 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 +6029,7 @@ being used.
 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 +6045,12 @@ predicates throw exceptions then unifications or comparisons involving
 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 -----------------------------------------------------------------------
--- a/tests/debugger/Mercury.options
+++ b/tests/debugger/Mercury.options
@@ -10,6 +10,7 @@ MCFLAGS-class_decl = --new-type-class-rtti
 # The label_layout test is for a bug that showed up only with --opt-space.
 MCFLAGS-label_layout = --opt-space

+MCFLAGS-io_tab_goto = --trace-table-io-all
 MCFLAGS-no_inline_builtins = --no-inline-builtins
 MCFLAGS-poly_io_retry = --trace-table-io-all
 MCFLAGS-poly_io_retry2 = --trace-table-io-all
--- a/tests/debugger/Mmakefile
+++ b/tests/debugger/Mmakefile
@@ -7,8 +7,9 @@ THIS_DIR = debugger
 RETRY_PROGS = \
 	all_solutions			\
 	browser_test			\
-	mdb_command_test		\
+	io_tab_goto			\
 	lambda_expr			\
+	mdb_command_test		\
 	queens				\
 	retry				\
 	tabled_read			\
@@ -365,6 +366,9 @@ implied_instance.out: implied_instance implied_instance.inp
 	$(MDB) ./implied_instance < implied_instance.inp \
 		> implied_instance.out 2>&1

+io_tab_goto.out: io_tab_goto io_tab_goto.inp
+	$(MDB_STD) ./io_tab_goto < io_tab_goto.inp > io_tab_goto.out 2>&1
+
 lambda_expr.out: lambda_expr lambda_expr.inp
 	$(MDB_STD) ./lambda_expr < lambda_expr.inp > lambda_expr.out 2>&1

--- a/tests/debugger/declarative/Mmakefile
+++ b/tests/debugger/declarative/Mmakefile
@@ -65,6 +65,7 @@ DECLARATIVE_PROGS=		\
 	special_term_dep	\
 	skip			\
 	tabled_read_decl	\
+	tabled_read_decl_goto	\
 	throw			\
 	trust			\
 	undo			\
@@ -472,6 +473,11 @@ tabled_read_decl.out: 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
 # particular line numbers in the standard library source code.
 throw.out: throw throw.inp
--- a/tests/debugger/declarative/tabled_read_decl_goto.data
+++ b/tests/debugger/declarative/tabled_read_decl_goto.data
@@ -0,0 +1,4 @@
+123
+456
+789
+42
--- a/tests/debugger/declarative/tabled_read_decl_goto.exp
+++ b/tests/debugger/declarative/tabled_read_decl_goto.exp
@@ -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
--- a/tests/debugger/declarative/tabled_read_decl_goto.inp
+++ b/tests/debugger/declarative/tabled_read_decl_goto.inp
@@ -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
--- a/tests/debugger/declarative/tabled_read_decl_goto.m
+++ b/tests/debugger/declarative/tabled_read_decl_goto.m
@@ -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 foreign_decl("C", "#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;
+}").
--- a/tests/debugger/io_tab_goto.data
+++ b/tests/debugger/io_tab_goto.data
@@ -0,0 +1,4 @@
+123
+456
+789
+42
--- a/tests/debugger/io_tab_goto.exp
+++ b/tests/debugger/io_tab_goto.exp
@@ -0,0 +1,55 @@
+      E1:     C1 CALL pred io_tab_goto.main/2-0 (det) io_tab_goto.m:13
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io allow
+mdb> table_io
+I/O tabling has not yet started.
+mdb> break io_tab_goto__test
+ 0: + stop  interface pred io_tab_goto.test/5-0 (det)
+mdb> table_io start
+I/O tabling started.
+mdb> continue
+should see this printf
+      E2:     C2 CALL pred io_tab_goto.test/5-0 (det)
+mdb> finish -n
+      E3:     C2 EXIT pred io_tab_goto.test/5-0 (det)
+mdb> print *
+       Stream (arg 1)         	'<<c_pointer>>'
+       SoFar (arg 2)          	0
+       N (arg 3)              	123
+mdb> retry -o -a
+      E2:     C2 CALL pred io_tab_goto.test/5-0 (det)
+mdb> print *
+       Stream (arg 1)         	'<<c_pointer>>'
+       SoFar (arg 2)          	0
+mdb> finish -n
+      E4:     C2 EXIT pred io_tab_goto.test/5-0 (det)
+mdb> print *
+       Stream (arg 1)         	'<<c_pointer>>'
+       SoFar (arg 2)          	0
+       N (arg 3)              	123
+mdb> table_io end
+I/O tabling stopped.
+mdb> continue
+123
+456
+      E5:     C3 CALL pred io_tab_goto.test/5-0 (det)
+mdb> finish -n
+      E6:     C3 EXIT pred io_tab_goto.test/5-0 (det)
+mdb> print *
+       Stream (arg 1)         	'<<c_pointer>>'
+       SoFar (arg 2)          	0
+       N (arg 3)              	789
+mdb> retry -f
+      E5:     C3 CALL pred io_tab_goto.test/5-0 (det)
+mdb> finish -n
+      E7:     C3 EXIT pred io_tab_goto.test/5-0 (det)
+mdb> print *
+       Stream (arg 1)         	'<<c_pointer>>'
+       SoFar (arg 2)          	0
+       N (arg 3)              	42
+mdb> continue -S
+42
--- a/tests/debugger/io_tab_goto.inp
+++ b/tests/debugger/io_tab_goto.inp
@@ -0,0 +1,22 @@
+echo on
+register --quiet
+context none
+table_io allow
+table_io
+break io_tab_goto__test
+table_io start
+continue
+finish -n
+print *
+retry -o -a
+print *
+finish -n
+print *
+table_io end
+continue
+finish -n
+print *
+retry -f
+finish -n
+print *
+continue -S
--- a/tests/debugger/io_tab_goto.m
+++ b/tests/debugger/io_tab_goto.m
@@ -0,0 +1,148 @@
+:- module io_tab_goto.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, char, int.
+
+main(!IO) :-
+	goto(!IO),
+	io_tab_goto.open_input("io_tab_goto.data", Res, Stream, !IO),
+	( Res = 0 ->
+		io_tab_goto.part_1(Stream, !IO),
+		io_tab_goto.part_2(Stream, !IO)
+	;
+		io.write_string("could not open io_tab_goto.data\n", !IO)
+	).
+
+:- pred goto(io::di, io::uo) is det.
+
+:- pragma no_inline(goto/2).
+
+:- pragma foreign_proc(c, goto(IO0::di, IO::uo),
+		[tabled_for_io, promise_pure], "
+	printf(""should see this printf\\n"");
+	goto label;
+	printf(""should never see this printf\\n"");
+label:
+	IO = IO0;
+").
+
+:- pred io_tab_goto.part_1(c_pointer::in, io.state::di, io.state::uo)
+	is det. 
+
+io_tab_goto.part_1(Stream) -->
+	io_tab_goto.test(Stream, 0, A),
+	io_tab_goto.write_int(A),
+	io_tab_goto.poly_test(Stream, ['a', 'b', 'c'], 0, B),
+	io_tab_goto.write_int(B).
+
+:- pred io_tab_goto.part_2(c_pointer::in, io.state::di, io.state::uo)
+	is det.
+
+io_tab_goto.part_2(Stream) -->
+	io_tab_goto.test(Stream, 0, A),
+	io_tab_goto.write_int(A).
+
+:- pred io_tab_goto.test(c_pointer::in, int::in, int::out,
+	io.state::di, io.state::uo) is det.
+
+io_tab_goto.test(Stream, SoFar, N) -->
+	io_tab_goto.read_char_code(Stream, CharCode),
+	(
+		{ char.to_int(Char, CharCode) },
+		{ char.is_digit(Char) },
+		{ char.digit_to_int(Char, CharInt) }
+	->
+		io_tab_goto.test(Stream, SoFar * 10 + CharInt, N)
+	;
+		{ N = SoFar }
+	).
+
+:- pred io_tab_goto.poly_test(c_pointer::in, T::in, int::in, int::out,
+	io.state::di, io.state::uo) is det.
+
+io_tab_goto.poly_test(Stream, Unused, SoFar, N) -->
+	io_tab_goto.poly_read_char_code(Stream, Unused, CharCode),
+	(
+		{ char.to_int(Char, CharCode) },
+		{ char.is_digit(Char) },
+		{ char.digit_to_int(Char, CharInt) }
+	->
+		io_tab_goto.poly_test(Stream, Unused,
+			SoFar * 10 + CharInt, N)
+	;
+		{ N = SoFar }
+	).
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred io_tab_goto.open_input(string::in, int::out, c_pointer::out,
+	io.state::di, io.state::uo) is det.
+
+:- pragma no_inline(io_tab_goto.open_input/5).
+
+:- pragma foreign_proc("C",
+	io_tab_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 io_tab_goto.read_char_code(c_pointer::in, int::out,
+	io.state::di, io.state::uo) is det.
+
+:- pragma no_inline(io_tab_goto.read_char_code/4).
+
+:- pragma foreign_proc("C",
+	io_tab_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 io_tab_goto.poly_read_char_code(c_pointer::in, T::in, int::out,
+	io.state::di, io.state::uo) is det.
+
+:- pragma no_inline(io_tab_goto.poly_read_char_code/5).
+
+:- pragma foreign_proc("C",
+	io_tab_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 io_tab_goto.write_int(int::in, io.state::di, io.state::uo)
+	is det.
+
+:- pragma no_inline(io_tab_goto.write_int/3).
+
+:- pragma foreign_proc("C",
+	io_tab_goto.write_int(N::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure],
+"{
+	printf(""%d\\n"", (int) N);
+	goto end4;
+end4:
+	IO = IO0;
+}").