[m-dev.] for review: retry across I/O: the whole new diff
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Dec 4 16:58:38 AEDT 2000
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.259
diff -u -b -r1.259 code_info.m
--- compiler/code_info.m 2000/11/23 04:32:29 1.259
+++ compiler/code_info.m 2000/11/27 23:59:11
@@ -393,7 +393,7 @@
set__init(Zombies),
map__init(LayoutMap),
code_info__max_var_slot(StackSlots, VarSlotMax),
- trace__reserved_slots(ProcInfo, Globals, FixedSlots, _),
+ trace__reserved_slots(ModuleInfo, ProcInfo, Globals, FixedSlots, _),
int__max(VarSlotMax, FixedSlots, SlotMax),
CodeInfo0 = code_info(
Globals,
@@ -423,21 +423,22 @@
no
),
code_info__init_maybe_trace_info(TraceLevel, Globals, ProcInfo,
- TraceSlotInfo, CodeInfo0, CodeInfo1),
+ ModuleInfo, TraceSlotInfo, CodeInfo0, CodeInfo1),
code_info__init_fail_info(CodeModel, MaybeFailVars, ResumePoint,
CodeInfo1, CodeInfo).
:- pred code_info__init_maybe_trace_info(trace_level::in, globals::in,
- proc_info::in, trace_slot_info::out,
+ proc_info::in, module_info::in, trace_slot_info::out,
code_info::in, code_info::out) is det.
-code_info__init_maybe_trace_info(TraceLevel, Globals, ProcInfo, TraceSlotInfo)
- -->
+code_info__init_maybe_trace_info(TraceLevel, Globals, ProcInfo, ModuleInfo,
+ TraceSlotInfo) -->
( { trace_level_is_none(TraceLevel) = no } ->
- trace__setup(ProcInfo, Globals, TraceSlotInfo, TraceInfo),
+ trace__setup(ModuleInfo, ProcInfo, Globals,
+ TraceSlotInfo, TraceInfo),
code_info__set_maybe_trace_info(yes(TraceInfo))
;
- { TraceSlotInfo = trace_slot_info(no, no, no, no, no) }
+ { TraceSlotInfo = trace_slot_info(no, no, no, no, no, no) }
).
%---------------------------------------------------------------------------%
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.251
diff -u -b -r1.251 hlds_out.m
--- compiler/hlds_out.m 2000/11/23 04:32:19 1.251
+++ compiler/hlds_out.m 2000/11/28 00:11:22
@@ -134,6 +134,9 @@
:- pred hlds_out__write_can_fail(can_fail, io__state, io__state).
:- mode hlds_out__write_can_fail(in, di, uo) is det.
+:- pred hlds_out__write_eval_method(eval_method, io__state, io__state).
+:- mode hlds_out__write_eval_method(in, di, uo) is det.
+
:- pred hlds_out__write_import_status(import_status, io__state, io__state).
:- mode hlds_out__write_import_status(in, di, uo) is det.
@@ -301,7 +304,8 @@
hlds_out__cons_id_to_string(type_ctor_info_const(_, _, _), "<type_ctor_info>").
hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _, _),
"<base_typeclass_info>").
-hlds_out__cons_id_to_string(tabling_pointer_const(_, _), "<tabling_pointer>").
+hlds_out__cons_id_to_string(tabling_pointer_const(_, _),
+ "<tabling_pointer>").
hlds_out__write_cons_id(cons(SymName, Arity)) -->
prog_out__write_sym_name_and_arity(SymName / Arity).
@@ -2884,6 +2888,7 @@
{ proc_info_get_maybe_termination_info(Proc, MaybeTermination) },
{ proc_info_typeinfo_varmap(Proc, TypeInfoMap) },
{ proc_info_typeclass_info_varmap(Proc, TypeClassInfoMap) },
+ { proc_info_eval_method(Proc, EvalMethod) },
{ proc_info_is_address_taken(Proc, IsAddressTaken) },
{ proc_info_get_call_table_tip(Proc, MaybeCallTableTip) },
{ Indent1 is Indent + 1 },
@@ -2932,6 +2937,14 @@
io__write_string("% address is not taken\n")
),
+ ( { EvalMethod = eval_normal } ->
+ []
+ ;
+ io__write_string("% eval method: "),
+ hlds_out__write_eval_method(EvalMethod),
+ io__write_string("\n")
+ ),
+
( { MaybeCallTableTip = yes(CallTableTip) } ->
io__write_string("% call table tip: "),
mercury_output_var(CallTableTip, VarSet, AppendVarnums),
@@ -3059,6 +3072,17 @@
io__write_string("can_fail").
hlds_out__write_can_fail(cannot_fail) -->
io__write_string("cannot_fail").
+
+hlds_out__write_eval_method(eval_normal) -->
+ io__write_string("normal").
+hlds_out__write_eval_method(eval_loop_check) -->
+ io__write_string("loop_check").
+hlds_out__write_eval_method(eval_memo) -->
+ io__write_string("memo").
+hlds_out__write_eval_method(eval_minimal) -->
+ io__write_string("minimal").
+hlds_out__write_eval_method(eval_table_io) -->
+ io__write_string("table_io").
:- pred hlds_out__write_indent(int, io__state, io__state).
:- mode hlds_out__write_indent(in, di, uo) is det.
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.87
diff -u -b -r1.87 hlds_pred.m
--- compiler/hlds_pred.m 2000/11/23 04:32:22 1.87
+++ compiler/hlds_pred.m 2000/11/28 11:21:56
@@ -1514,6 +1514,21 @@
% manipulate typeclass_infos which don't need their type_infos.
:- pred no_type_info_builtin(module_name::in, string::in, int::in) is semidet.
+ % If the procedure has a input/output pair of io__state arguments,
+ % return the positions of those arguments in the argument list.
+ % The positions are given as argument numbers, with the first argument
+ % in proc_info_headvars being position 1, and so on. The first output
+ % argument gives the position of the input state, the second the
+ % position of the output state.
+ %
+ % Note that the automatically constructed unify, index and compare
+ % procedures for the io:state type are not counted as having io:state
+ % args, since they do not fall into the scheme of one input and one
+ % output arg. Since they should never be called, this should not
+ % matter.
+:- pred proc_info_has_io_state_pair(module_info::in, proc_info::in,
+ int::out, int::out) is semidet.
+
:- implementation.
:- type proc_info
@@ -1993,6 +2008,71 @@
no_type_info_builtin_2(table_builtin, "table_restore_any_ans", 3).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_enum", 4).
+proc_info_has_io_state_pair(ModuleInfo, ProcInfo, InArgNum, OutArgNum) :-
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_argmodes(ProcInfo, ArgModes),
+ assoc_list__from_corresponding_lists(HeadVars, ArgModes,
+ HeadVarsModes),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ proc_info_has_io_state_pair_2(HeadVarsModes, ModuleInfo, VarTypes,
+ 1, no, no, MaybeIn, MaybeOut),
+ ( MaybeIn = yes(In), MaybeOut = yes(Out) ->
+ InArgNum = In,
+ OutArgNum = Out
+ ;
+ fail
+ ).
+
+:- pred proc_info_has_io_state_pair_2(assoc_list(prog_var, mode)::in,
+ module_info::in, map(prog_var, type)::in,
+ int::in, maybe(int)::in, maybe(int)::in,
+ maybe(int)::out, maybe(int)::out) is semidet.
+
+proc_info_has_io_state_pair_2([], _, _, _,
+ MaybeIn, MaybeOut, MaybeIn, MaybeOut).
+proc_info_has_io_state_pair_2([Var - Mode | VarModes], ModuleInfo, VarTypes,
+ ArgNum, MaybeIn0, MaybeOut0, MaybeIn, MaybeOut) :-
+ (
+ map__lookup(VarTypes, Var, VarType),
+ type_util__type_is_io_state(VarType)
+ ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
+ (
+ MaybeIn0 = no,
+ MaybeIn1 = yes(ArgNum),
+ MaybeOut1 = MaybeOut0
+ ;
+ MaybeIn0 = yes(_),
+ % Procedures with two input arguments
+ % of type io__state (e.g. the automatically
+ % generated unification or comparison procedure
+ % for the io__state type) do not fall into
+ % the one input/one output pattern we are
+ % looking for.
+ fail
+ )
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
+ (
+ MaybeOut0 = no,
+ MaybeOut1 = yes(ArgNum),
+ MaybeIn1 = MaybeIn0
+ ;
+ MaybeOut0 = yes(_),
+ % Procedures with two output arguments of
+ % type io__state do not fall into the one
+ % input/one output pattern we are looking for.
+ fail
+ )
+ ;
+ fail
+ )
+ ;
+ MaybeIn1 = MaybeIn0,
+ MaybeOut1 = MaybeOut0
+ ),
+ proc_info_has_io_state_pair_2(VarModes, ModuleInfo, VarTypes,
+ ArgNum + 1, MaybeIn1, MaybeOut1, MaybeIn, MaybeOut).
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -2082,7 +2162,6 @@
).
%-----------------------------------------------------------------------------%
-
% Predicates to deal with record syntax.
:- interface.
@@ -2319,43 +2398,52 @@
:- import_module det_analysis.
valid_determinism_for_eval_method(eval_normal, _).
-valid_determinism_for_eval_method(eval_memo, _).
valid_determinism_for_eval_method(eval_loop_check, _).
+valid_determinism_for_eval_method(eval_table_io, _) :-
+ error("valid_determinism_for_eval_method called after tabling phase").
+valid_determinism_for_eval_method(eval_memo, _).
valid_determinism_for_eval_method(eval_minimal, Determinism) :-
determinism_components(Determinism, can_fail, _).
eval_method_to_string(eval_normal, "normal").
-eval_method_to_string(eval_memo, "memo").
eval_method_to_string(eval_loop_check, "loop_check").
+eval_method_to_string(eval_table_io, "table_io").
+eval_method_to_string(eval_memo, "memo").
eval_method_to_string(eval_minimal, "minimal_model").
eval_method_needs_stratification(eval_normal) = no.
eval_method_needs_stratification(eval_loop_check) = no.
+eval_method_needs_stratification(eval_table_io) = no.
eval_method_needs_stratification(eval_memo) = no.
eval_method_needs_stratification(eval_minimal) = yes.
eval_method_has_per_proc_tabling_pointer(eval_normal) = no.
eval_method_has_per_proc_tabling_pointer(eval_loop_check) = yes.
+eval_method_has_per_proc_tabling_pointer(eval_table_io) = no.
eval_method_has_per_proc_tabling_pointer(eval_memo) = yes.
eval_method_has_per_proc_tabling_pointer(eval_minimal) = yes.
eval_method_requires_tabling_transform(eval_normal) = no.
eval_method_requires_tabling_transform(eval_loop_check) = yes.
+eval_method_requires_tabling_transform(eval_table_io) = yes.
eval_method_requires_tabling_transform(eval_memo) = yes.
eval_method_requires_tabling_transform(eval_minimal) = yes.
eval_method_requires_ground_args(eval_normal) = no.
eval_method_requires_ground_args(eval_loop_check) = yes.
+eval_method_requires_ground_args(eval_table_io) = yes.
eval_method_requires_ground_args(eval_memo) = yes.
eval_method_requires_ground_args(eval_minimal) = yes.
eval_method_destroys_uniqueness(eval_normal) = no.
eval_method_destroys_uniqueness(eval_loop_check) = yes.
+eval_method_destroys_uniqueness(eval_table_io) = no.
eval_method_destroys_uniqueness(eval_memo) = yes.
eval_method_destroys_uniqueness(eval_minimal) = yes.
eval_method_change_determinism(eval_normal, Detism, Detism).
eval_method_change_determinism(eval_loop_check, Detism, Detism).
+eval_method_change_determinism(eval_table_io, Detism, Detism).
eval_method_change_determinism(eval_memo, Detism, Detism).
eval_method_change_determinism(eval_minimal, Det0, Det) :-
det_conjunction_detism(semidet, Det0, Det).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.95
diff -u -b -r1.95 live_vars.m
--- compiler/live_vars.m 2000/11/23 04:32:39 1.95
+++ compiler/live_vars.m 2000/11/27 23:59:14
@@ -79,7 +79,7 @@
LiveSets1 = LiveSets0
),
trace__do_we_need_maxfr_slot(Globals, ProcInfo0, ProcInfo1),
- trace__reserved_slots(ProcInfo1, Globals, NumReservedSlots,
+ trace__reserved_slots(ModuleInfo, ProcInfo1, Globals, NumReservedSlots,
MaybeReservedVarInfo),
( MaybeReservedVarInfo = yes(ResVar - _) ->
set__singleton_set(ResVarSet, ResVar),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.139
diff -u -b -r1.139 modules.m
--- compiler/modules.m 2000/11/17 17:48:15 1.139
+++ compiler/modules.m 2000/11/21 01:21:13
@@ -1411,7 +1411,7 @@
list(module_name), list(module_name)).
:- mode add_implicit_imports(in, in, in, in, out, out) is det.
-add_implicit_imports(Items, _Globals, ImportDeps0, UseDeps0,
+add_implicit_imports(Items, Globals, ImportDeps0, UseDeps0,
ImportDeps, UseDeps) :-
mercury_public_builtin_module(MercuryPublicBuiltin),
mercury_private_builtin_module(MercuryPrivateBuiltin),
@@ -1420,10 +1420,13 @@
UseDeps1 = [MercuryPrivateBuiltin | UseDeps0],
(
%
- % we should include MercuryTableBuiltin iff
- % the Items contain a tabling pragma
+ % we should include MercuryTableBuiltin if
+ % the Items contain a tabling pragma, or if
+ % --trace-table-io is specified
%
- contains_tabling_pragma(Items)
+ ( contains_tabling_pragma(Items)
+ ; globals__lookup_bool_option(Globals, trace_table_io, yes)
+ )
->
UseDeps = [MercuryTableBuiltin | UseDeps1]
;
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.301
diff -u -b -r1.301 options.m
--- compiler/options.m 2000/11/17 17:48:21 1.301
+++ compiler/options.m 2000/11/21 01:21:14
@@ -97,6 +97,8 @@
; assume_gmake
; trace
; trace_optimized
+ ; trace_table_io
+ ; trace_table_io_states
; suppress_trace
; stack_trace_higher_order
; generate_bytecode
@@ -498,6 +500,8 @@
assume_gmake - bool(yes),
trace - string("default"),
trace_optimized - bool(no),
+ trace_table_io - bool(no),
+ trace_table_io_states - bool(no),
suppress_trace - string(""),
stack_trace_higher_order - bool(no),
generate_bytecode - bool(no),
@@ -894,6 +898,8 @@
long_option("trace", trace).
long_option("trace-optimised", trace_optimized).
long_option("trace-optimized", trace_optimized).
+long_option("trace-table-io", trace_table_io).
+long_option("trace-table-io-states", trace_table_io_states).
long_option("suppress-trace", suppress_trace).
long_option("stack-trace-higher-order", stack_trace_higher_order).
long_option("generate-bytecode", generate_bytecode).
@@ -1702,6 +1708,13 @@
% "\tSuppress the named aspects of the execution tracing system.",
"--trace-optimized",
"\tDo not disable optimizations that can change the trace.",
+% "--trace-table-io",
+% "\tEnable the tabling of I/O actions, to allow the debugger",
+% "\tto execute retry commands across I/O actions.",
+% "--trace-table-io-states",
+% "\tWhen tabling I/O actions, table the io__state arguments",
+% "\ttogether with the others. This should be required iff",
+% "\tvalues of type io__state actually contain information.",
"--stack-trace-higher-order",
"\tEnable stack traces through predicates and functions with",
"\thigher-order arguments, even if stack tracing is not",
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.62
diff -u -b -r1.62 prog_data.m
--- compiler/prog_data.m 2000/11/17 17:48:32 1.62
+++ compiler/prog_data.m 2000/11/21 01:21:18
@@ -282,6 +282,7 @@
% evaluation
; eval_loop_check % loop check only
; eval_memo % memoing + loop check
+ ; eval_table_io % memoing I/O actions for debugging
; eval_minimal. % minimal model
% evaluation
%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.57
diff -u -b -r1.57 stack_layout.m
--- compiler/stack_layout.m 2000/11/10 01:00:52 1.57
+++ compiler/stack_layout.m 2000/11/28 11:24:51
@@ -88,6 +88,7 @@
% MR_int_least16_t MR_sle_max_var_num;
% MR_int_least16_t MR_sle_max_r_num;
% MR_int_least8_t MR_sle_maybe_from_full;
+% MR_int_least8_t MR_sle_maybe_io_seq;
% MR_int_least8_t MR_sle_maybe_trail;
% MR_int_least8_t MR_sle_maybe_maxfr;
% MR_EvalMethod MR_sle_eval_method:8;
@@ -140,6 +141,10 @@
% or not. (The determinism of the procedure decides whether the stack slot
% refers to a stackvar or a framevar.)
%
+% If the procedure has an I/O state argument, the maybe_io_seq field will
+% contain the number of the stack slot that holds the value the I/O action
+% counter had on entry to this procedure.
+%
% If trailing is not enabled, the maybe_trail field will contain a negative
% number. If it is enabled, it will contain number of the first of two stack
% slots used for checkpointing the state of the trail on entry to the
@@ -422,7 +427,8 @@
MR_Integer cur_offset;
MR_Word tmp;
- incr_hp_atomic(tmp, (ArenaSize + sizeof(MR_Word)) / sizeof(MR_Word));
+ MR_incr_hp_atomic(tmp,
+ (ArenaSize + sizeof(MR_Word)) / sizeof(MR_Word));
Arena = (char *) tmp;
cur_offset = 0;
@@ -842,8 +848,8 @@
data_addr(ModuleName, module_layout)))),
MaxTraceRegRval = yes(const(int_const(MaxTraceReg))),
TraceSlotInfo = trace_slot_info(MaybeFromFullSlot,
- MaybeDeclSlots, MaybeTrailSlots, MaybeMaxfrSlot,
- MaybeCallTableSlot),
+ MaybeIoSeqSlot, MaybeTrailSlots, MaybeMaxfrSlot,
+ MaybeCallTableSlot, MaybeDeclSlots),
EvalMethodInt =
stack_layout__represent_eval_method(EvalMethod),
EvalMethodRval = yes(const(int_const(EvalMethodInt))),
@@ -852,6 +858,11 @@
;
FromFullRval = yes(const(int_const(-1)))
),
+ ( MaybeIoSeqSlot = yes(IoSeqSlot) ->
+ IoSeqRval = yes(const(int_const(IoSeqSlot)))
+ ;
+ IoSeqRval = yes(const(int_const(-1)))
+ ),
( MaybeTrailSlots = yes(FirstTrailSlot) ->
TrailRval = yes(const(int_const(FirstTrailSlot)))
;
@@ -874,12 +885,12 @@
),
Rvals = [CallRval, ModuleRval, GoalRepRval, VarNameVector,
VarNameCount, MaxTraceRegRval,
- FromFullRval, TrailRval, MaxfrRval,
+ FromFullRval, IoSeqRval, TrailRval, MaxfrRval,
EvalMethodRval, CallTableRval, DeclRval],
ArgTypes = initial([
4 - yes(data_ptr),
2 - yes(int_least16),
- 6 - yes(int_least8)],
+ 7 - yes(int_least8)],
none)
}
;
@@ -894,7 +905,7 @@
stack_layout__represent_eval_method(eval_loop_check) = 1.
stack_layout__represent_eval_method(eval_memo) = 2.
stack_layout__represent_eval_method(eval_minimal) = 3.
-
+stack_layout__represent_eval_method(eval_table_io) = 4.
:- pred stack_layout__construct_var_name_vector(prog_varset::in,
map(int, string)::in, maybe(rval)::out, maybe(rval)::out,
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.26
diff -u -b -r1.26 table_gen.m
--- compiler/table_gen.m 2000/11/23 04:32:47 1.26
+++ compiler/table_gen.m 2000/12/04 03:59:16
@@ -4,12 +4,11 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
-% Main author: ohutch
-% Significant modifications by zs.
+% Main authors: ohutch, zs.
%
-% This module transforms HLDS code to implement loop detection, memoing
-% or minimal model evaluation. The transformation involves adding calls to
-% predicates defined in library/table_builtin.m and in
+% This module transforms HLDS code to implement loop detection, memoing,
+% minimal model evaluation, or I/O idempotence. The transformation involves
+% adding calls to predicates defined in library/table_builtin.m and in
% runtime/mercury_tabling.c.
%
% The loop detection transformation adds code to a procedure that allows
@@ -48,24 +47,25 @@
% The transformed code would be :
%
% p(A, B) :-
-% % Code to get a handle on the table
+% % Get a handle on the table.
% T0 = <table pointer for p/2>,
%
-% % Code to lookup input arguments
+% % Look up the input arguments.
% impure table_lookup_insert_int(T0, A, T1),
% impure table_lookup_insert_int(T1, B, T2),
% (if
% semipure table_simple_is_complete(T2)
% then
-% % True if the subgoal has already succeeded
+% % If the subgoal has already succeeded,
+% % just return.
% semipure table_simple_has_succeeded(T2)
% else
% (if
-% % Fail if we are already working on
-% % an ans for this subgoal
+% % If we are already working on
+% % an answer for this subgoal, fail.
% semipure table_simple_is_inactive(T2),
%
-% % Mark this subgoal as being evaluated
+% % Mark this subgoal as being evaluated.
% impure table_simple_mark_as_active(T2),
%
% (
@@ -94,24 +94,23 @@
% The transformed code would be :
%
% p(A, B) :-
-% % Code to get a handle on the table.
+% % Get a handle on the table.
% T0 = <table pointer for p/2>,
%
-% % Code to lookup input arguments and setup table.
+% % Look up the input arguments, and set up the table.
% impure table_lookup_insert_int(T0, A, T1),
% impure table_nondet_setup(T1, T2),
% (if
% semipure table_nondet_is_complete(T2)
% then
-% % Code to return all ans if we have found
-% % them.
+% % Return all the answers from the complete
+% % table.
% impure table_nondet_return_all_ans(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else if
% semipure table_nondet_is_active(T2)
% then
-% % Code to suspend the current computational
-% % branch.
+% % Suspend the current computational branch.
% impure table_nondet_suspend(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else
@@ -126,8 +125,7 @@
% %
% ),
%
-% % Code to check for duplicate
-% % answers.
+% % Check for duplicate answers.
% impure table_nondet_get_ans_table(T2, AT0),
% impure table_lookup_insert_int(AT0, B, AT1),
%
@@ -137,15 +135,14 @@
% semipure
% table_nondet_answer_is_not_duplicate(AT1),
%
-% % Code to save a new ans in the
-% % table.
+% % Save the new answer in the table.
% impure table_nondet_new_ans_slot(T2, AS),
% impure table_create_ans_block(AS, 1, AB),
% impure table_save_int_ans(AB, 0, B)
% ;
-% % Code to resume all suspended nodes,
-% % and then mark the current subgoal
-% % as totally evaluated.
+% % Mark this subgoal as completely
+% % evaluated, modulo any dependencies
+% % on other subgoals.
% impure table_nondet_resume(T2),
% fail
% )
@@ -157,6 +154,70 @@
% a loop check. And in the loop_check case the code for memoing answers is
% dropped and the loop handling code is modified to call an error predicate.
%
+% Example of transformation for tabling I/O, for I/O primitives (i.e.
+% predicates defined by pragma c_code that take an input/output pair of
+% io_state arguments) that have the tabled_for_io feature:
+%
+% :- pred p(int, string, io__state, io__state).
+% :- mode p(in, out, di, uo) is det.
+%
+% p(A, B, S0, S) :- $pragma(...)
+%
+% The transformed code would be :
+%
+% p(A, B, S0, S) :-
+% (if
+% % Get the global I/O table, the global I/O
+% % counter, and the starting point for tabling
+% % I/O actions, if we are in the tabled range.
+% table_io_in_range(T0, Counter, Start)
+% then
+% % Look up the input arguments.
+% impure table_lookup_insert_start_int(T0, Counter,
+% Start, T),
+% (if
+% semipure table_io_has_occurred(T)
+% then
+% impure table_restore_string_ans(T, 0, B)
+% table_io_copy_io_state(S0, S)
+% else
+% (
+% %
+% % Call original procedure
+% %
+% ),
+% % Save the answers in the table.
+% impure table_io_create_ans_block(T, 1, AnsBl),
+% impure table_save_string_ans(AnsBl, 0, B)
+% )
+% else
+% %
+% % Call original procedure
+% %
+% ).
+%
+% Note that copying the I/O state works only because variables of type
+% io__state don't actually contain any information; the information is actually
+% stored in global variables. However, if this ever changes, the transformation
+% can be fixed simply by changing the value of --trace-table-io-states to yes,
+% which will cause such values to be tabled along with the other output
+% arguments.
+%
+% For I/O primitives that do not have tabled_for_io, we should require that
+% they do not do any I/O in their own code, meaning that all their I/O is
+% inside any Mercury code they call. We can then leave such primitives
+% untransformed; the I/O primitives called from the inner Mercury engine
+% will do the right thing. For now, this requirement is not enforced,
+% which means that enabling I/O tabling (with --trace-table-io) does not
+% guarantee that *all* I/O actions are tabled. This can cause inconsistent
+% behavior after retry commands in mdb. This is the reason why retry across
+% I/O is experimental for now.
+%
+% The reason why we require I/O primitives to be marked manually by a
+% programmer with the tabled_for_io feature is to get the programmer to make
+% sure that the primitive meets the requirement. Unfortunately, this cannot be
+% automated, since automation would require analysis of arbitrary C code.
+%
%-----------------------------------------------------------------------------%
:- module table_gen.
@@ -202,8 +263,8 @@
table_gen__process_pred(PredId, Module0, Module1),
table_gen__process_preds(PredIds, Module1, Module).
-:- pred table_gen__process_pred(pred_id::in, module_info::in,
- module_info::out) is det.
+:- pred table_gen__process_pred(pred_id::in, module_info::in, module_info::out)
+ is det.
table_gen__process_pred(PredId, Module0, Module) :-
module_info_pred_info(Module0, PredId, PredInfo),
@@ -219,14 +280,31 @@
module_info_preds(Module0, PredTable),
map__lookup(PredTable, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
- map__lookup(ProcTable, ProcId, ProcInfo),
+ map__lookup(ProcTable, ProcId, ProcInfo0),
- proc_info_eval_method(ProcInfo, EvalMethod),
+ proc_info_eval_method(ProcInfo0, EvalMethod),
( eval_method_requires_tabling_transform(EvalMethod) = yes ->
- table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo,
+ table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0,
PredInfo, Module0, Module1)
;
+ module_info_globals(Module0, Globals),
+ globals__lookup_bool_option(Globals, trace_table_io, yes),
+ proc_info_has_io_state_pair(Module0, ProcInfo0,
+ _InArgNum, _OutArgNum),
+ proc_info_interface_code_model(ProcInfo0, model_det),
+ proc_info_goal(ProcInfo0, BodyGoal),
+ some [SubGoal] (
+ goal_contains_goal(BodyGoal, SubGoal),
+ SubGoal = pragma_foreign_code(Attrs, _,_,_,_,_,_)
+ - _,
+ tabled_for_io(Attrs, tabled_for_io)
+ )
+ ->
+ proc_info_set_eval_method(ProcInfo0, eval_table_io, ProcInfo1),
+ table_gen__process_proc(eval_table_io, PredId, ProcId,
+ ProcInfo1, PredInfo, Module0, Module1)
+ ;
Module1 = Module0
),
@@ -251,27 +329,37 @@
proc_info_goal(ProcInfo0, OrigGoal),
proc_info_argmodes(ProcInfo0, ArgModes),
+ ( EvalMethod = eval_table_io ->
+ module_info_globals(Module0, Globals),
+ globals__lookup_bool_option(Globals, trace_table_io_states,
+ TableIoStates),
+ table_gen__create_new_io_goal(OrigGoal, TableIoStates,
+ HeadVars, ArgModes, VarTypes0, VarTypes,
+ VarSet0, VarSet, TableInfo0, TableInfo, Goal),
+ MaybeCallTableTip = no
+ ;
(
CodeModel = model_det,
- table_gen__create_new_det_goal(EvalMethod, Detism, OrigGoal,
- PredId, ProcId, HeadVars, ArgModes,
+ table_gen__create_new_det_goal(EvalMethod, Detism,
+ OrigGoal, PredId, ProcId, HeadVars, ArgModes,
VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, CallTableTip, Goal),
MaybeCallTableTip = yes(CallTableTip)
;
CodeModel = model_semi,
- table_gen__create_new_semi_goal(EvalMethod, Detism, OrigGoal,
- PredId, ProcId, HeadVars, ArgModes,
+ table_gen__create_new_semi_goal(EvalMethod, Detism,
+ OrigGoal, PredId, ProcId, HeadVars, ArgModes,
VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, CallTableTip, Goal),
MaybeCallTableTip = yes(CallTableTip)
;
CodeModel = model_non,
- table_gen__create_new_non_goal(EvalMethod, Detism, OrigGoal,
- PredId, ProcId, HeadVars, ArgModes,
+ table_gen__create_new_non_goal(EvalMethod, Detism,
+ OrigGoal, PredId, ProcId, HeadVars, ArgModes,
VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, CallTableTip, Goal),
MaybeCallTableTip = yes(CallTableTip)
+ )
),
table_info_extract(TableInfo, Module1, PredInfo1, ProcInfo1),
@@ -286,6 +374,7 @@
% Some of the instmap_deltas generated in this module
% are pretty dodgy (especially those for if-then-elses), so
% recompute them here.
+
RecomputeAtomic = no,
recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo5, ProcInfo,
Module1, Module2),
@@ -300,6 +389,148 @@
%-----------------------------------------------------------------------------%
%
+ % Transform procedures that do I/O.
+ %
+
+:- pred table_gen__create_new_io_goal(hlds_goal::in, bool::in,
+ list(prog_var)::in, list(mode)::in,
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ prog_varset::in, prog_varset::out, table_info::in, table_info::out,
+ hlds_goal::out) is det.
+
+table_gen__create_new_io_goal(OrigGoal, TableIoStates, HeadVars, HeadVarModes,
+ VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
+ Goal) :-
+ OrigGoal = _ - OrigGoalInfo,
+ goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
+ goal_info_get_context(OrigGoalInfo, Context),
+
+ table_info_get_module_info(TableInfo0, Module),
+
+ get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars,
+ OutputVars),
+ (
+ TableIoStates = yes,
+ IoStateAssignToVars = [],
+ SavedOutputVars = OutputVars
+ ;
+ TableIoStates = no,
+ list__filter(table_gen__var_is_io_state(VarTypes0),
+ OutputVars, IoStateAssignToVars, SavedOutputVars)
+ ),
+
+ generate_new_table_var("TableVar0", VarTypes0, VarTypes1,
+ VarSet0, VarSet1, TableVar0),
+ generate_new_table_var("CounterVar", VarTypes1, VarTypes2,
+ VarSet1, VarSet2, CounterVar),
+ generate_new_table_var("StartVar", VarTypes2, VarTypes3,
+ VarSet2, VarSet3, StartVar),
+ generate_call("table_io_in_range", [TableVar0, CounterVar, StartVar],
+ semidet, yes(impure), [TableVar0 - ground(shared, none),
+ CounterVar - ground(shared, none),
+ StartVar - ground(shared, none)],
+ Module, Context, InRangeGoal),
+
+ generate_new_table_var("TableVar", VarTypes3, VarTypes4,
+ VarSet3, VarSet4, TableVar),
+ generate_call("table_lookup_insert_start_int",
+ [TableVar0, StartVar, CounterVar, TableVar],
+ det, yes(impure), [TableVar - ground(unique, none)],
+ Module, Context, LookupGoal),
+
+ generate_call("table_io_has_occurred", [TableVar],
+ semidet, yes(semipure), [], Module, Context, OccurredGoal),
+
+ generate_restore_goal(SavedOutputVars, TableVar, Module, Context,
+ VarTypes4, VarTypes6, VarSet4, VarSet6, RestoreAnsGoal0),
+
+ list__filter(table_gen__var_is_io_state(VarTypes), InputVars,
+ IoStateAssignFromVars, _SavedInputVars),
+ (
+ TableIoStates = yes,
+ RestoreAnsGoal = RestoreAnsGoal0
+ ;
+ TableIoStates = no,
+ (
+ IoStateAssignFromVars = [IoStateAssignFromVarPrime],
+ IoStateAssignToVars = [IoStateAssignToVarPrime]
+ ->
+ IoStateAssignFromVar = IoStateAssignFromVarPrime,
+ IoStateAssignToVar = IoStateAssignToVarPrime
+ ;
+ % The call to proc_info_has_io_state_pair in
+ % table_gen__process_procs should ensure that we
+ % never get here.
+ error("create_new_io_goal: one in / one out violation")
+ ),
+
+ generate_call("table_io_copy_io_state",
+ [IoStateAssignFromVar, IoStateAssignToVar], det, no,
+ [IoStateAssignFromVar - ground(clobbered, none),
+ IoStateAssignToVar - ground(unique, none)],
+ Module, Context, IoStateAssignGoal),
+
+ RestoreAnsGoalEx = conj([RestoreAnsGoal0, IoStateAssignGoal]),
+ create_instmap_delta([RestoreAnsGoal0, IoStateAssignGoal],
+ RestoreAnsInstMapDelta0),
+ RestoreAnsGoal0 = _ - RestoreAnsGoal0Info,
+ goal_info_get_nonlocals(RestoreAnsGoal0Info,
+ RestoreAns0NonLocals),
+ set__insert_list(RestoreAns0NonLocals,
+ [IoStateAssignFromVar, IoStateAssignToVar],
+ RestoreAnsNonLocals),
+ instmap_delta_restrict(RestoreAnsInstMapDelta0,
+ RestoreAnsNonLocals, RestoreAnsInstMapDelta),
+ init_goal_info(RestoreAnsNonLocals, RestoreAnsInstMapDelta,
+ det, Context, RestoreAnsGoalInfo),
+ RestoreAnsGoal = RestoreAnsGoalEx - RestoreAnsGoalInfo
+ ),
+ generate_save_goal(OutputVars, TableVar, Context, VarTypes6, VarTypes,
+ VarSet6, VarSet, TableInfo0, TableInfo, SaveAnsGoal),
+
+ CallSaveAnsGoalEx = conj([OrigGoal, SaveAnsGoal]),
+ create_instmap_delta([OrigGoal, SaveAnsGoal], CallSaveAnsInstMapDelta0),
+ set__insert(OrigNonLocals, TableVar, CallSaveAnsNonLocals),
+ instmap_delta_restrict(CallSaveAnsInstMapDelta0,
+ CallSaveAnsNonLocals, CallSaveAnsInstMapDelta),
+ init_goal_info(CallSaveAnsNonLocals, CallSaveAnsInstMapDelta, det,
+ Context, CallSaveAnsGoalInfo),
+ CallSaveAnsGoal = CallSaveAnsGoalEx - CallSaveAnsGoalInfo,
+
+ map__init(StoreMap),
+ GenIfNecGoalEx = if_then_else([], OccurredGoal,
+ RestoreAnsGoal, CallSaveAnsGoal, StoreMap),
+ create_instmap_delta([OccurredGoal, RestoreAnsGoal,
+ CallSaveAnsGoal], GenIfNecInstMapDelta0),
+ set__insert(OrigNonLocals, TableVar, GenIfNecNonLocals),
+ instmap_delta_restrict(GenIfNecInstMapDelta0, GenIfNecNonLocals,
+ GenIfNecInstMapDelta),
+ init_goal_info(GenIfNecNonLocals, GenIfNecInstMapDelta, det, Context,
+ GenIfNecGoalInfo),
+ GenIfNecGoal = GenIfNecGoalEx - GenIfNecGoalInfo,
+
+ CheckAndGenAnsGoalEx = conj([LookupGoal, GenIfNecGoal]),
+ create_instmap_delta([LookupGoal, GenIfNecGoal],
+ CheckAndGenAnsInstMapDelta0),
+ set__insert_list(OrigNonLocals, [TableVar0, CounterVar, StartVar],
+ CheckAndGenAnsNonLocals),
+ instmap_delta_restrict(CheckAndGenAnsInstMapDelta0,
+ CheckAndGenAnsNonLocals, CheckAndGenAnsInstMapDelta),
+ init_goal_info(CheckAndGenAnsNonLocals, CheckAndGenAnsInstMapDelta,
+ det, Context, CheckAndGenAnsGoalInfo),
+ CheckAndGenAnsGoal = CheckAndGenAnsGoalEx - CheckAndGenAnsGoalInfo,
+
+ BodyGoalEx = if_then_else([], InRangeGoal, CheckAndGenAnsGoal,
+ OrigGoal, StoreMap),
+ create_instmap_delta([InRangeGoal, CheckAndGenAnsGoal, OrigGoal],
+ BodyInstMapDelta0),
+ instmap_delta_restrict(BodyInstMapDelta0, OrigNonLocals,
+ BodyInstMapDelta),
+ init_goal_info(OrigNonLocals, BodyInstMapDelta, det, Context,
+ BodyGoalInfo),
+ Goal = BodyGoalEx - BodyGoalInfo.
+
+ %
% Transform deterministic procedures.
%
:- pred table_gen__create_new_det_goal(eval_method::in, determinism::in,
@@ -329,13 +560,13 @@
VarTypes0, VarTypes1, VarSet0, VarSet1, TableInfo0, TableInfo1,
TableVar, LookUpGoal),
generate_call("table_simple_is_complete", [TableVar], semidet,
- semipure, [], Module, Context, CompleteCheckGoal),
+ yes(semipure), [], Module, Context, CompleteCheckGoal),
generate_save_goal(OutputVars, TableVar, Context, VarTypes1, VarTypes2,
VarSet1, VarSet2, TableInfo1, TableInfo, SaveAnsGoal0),
generate_restore_goal(OutputVars, TableVar, Module, Context,
VarTypes2, VarTypes3, VarSet2, VarSet3, RestoreAnsGoal0),
generate_call("table_simple_mark_as_inactive", [TableVar], det,
- impure, [], Module, Context, MarkAsInactiveGoal),
+ yes(impure), [], Module, Context, MarkAsInactiveGoal),
generate_loop_error_goal(TableInfo, Context, VarTypes3, VarTypes,
VarSet3, VarSet, LoopErrorGoal),
( Detism = erroneous ->
@@ -361,9 +592,9 @@
),
generate_call("table_simple_is_active", [TableVar], semidet,
- semipure, [], Module, Context, ActiveCheckGoal),
+ yes(semipure), [], Module, Context, ActiveCheckGoal),
generate_call("table_simple_mark_as_active", [TableVar], det,
- impure, [], Module, Context, MarkAsActiveGoal),
+ yes(impure), [], Module, Context, MarkAsActiveGoal),
NoLoopGenAnsGoalEx = conj([MarkAsActiveGoal, OrigGoal, SaveAnsGoal]),
create_instmap_delta([MarkAsActiveGoal, OrigGoal, SaveAnsGoal],
@@ -432,8 +663,8 @@
generate_simple_lookup_goal(InputVars, PredId, ProcId, Context,
VarTypes0, VarTypes1, VarSet0, VarSet1, TableInfo0, TableInfo1,
TableVar, LookUpGoal),
- generate_call("table_simple_is_complete", [TableVar],
- semidet, semipure, [], Module, Context, CompleteCheckGoal),
+ generate_call("table_simple_is_complete", [TableVar], semidet,
+ yes(semipure), [], Module, Context, CompleteCheckGoal),
generate_save_goal(OutputVars, TableVar, Context, VarTypes1, VarTypes2,
VarSet1, VarSet2, TableInfo1, TableInfo, SaveAnsGoal0),
generate_restore_goal(OutputVars, TableVar, Module, Context,
@@ -441,12 +672,12 @@
generate_loop_error_goal(TableInfo, Context,
VarTypes3, VarTypes, VarSet3, VarSet, LoopErrorGoal),
generate_call("table_simple_mark_as_failed", [TableVar],
- det, impure, [], Module, Context, MarkAsFailedGoal0),
+ det, yes(impure), [], Module, Context, MarkAsFailedGoal0),
append_fail(MarkAsFailedGoal0, MarkAsFailedGoal),
- generate_call("table_simple_has_succeeded", [TableVar],
- semidet, semipure, [], Module, Context, HasSucceededCheckGoal),
+ generate_call("table_simple_has_succeeded", [TableVar], semidet,
+ yes(semipure), [], Module, Context, HasSucceededCheckGoal),
generate_call("table_simple_mark_as_inactive", [TableVar],
- det, impure, [], Module, Context, MarkAsInactiveGoal),
+ det, yes(impure), [], Module, Context, MarkAsInactiveGoal),
set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),
@@ -466,9 +697,9 @@
SaveAnsGoal = SaveAnsGoal0
),
generate_call("table_simple_is_active", [TableVar], semidet,
- semipure, [], Module, Context, ActiveCheckGoal),
+ yes(semipure), [], Module, Context, ActiveCheckGoal),
generate_call("table_simple_mark_as_active", [TableVar], det,
- impure, [], Module, Context, MarkAsActiveGoal),
+ yes(impure), [], Module, Context, MarkAsActiveGoal),
NoLoopGenAnsGoalEx = conj([MarkAsActiveGoal, OrigGoal]),
create_instmap_delta([MarkAsActiveGoal, OrigGoal],
@@ -495,10 +726,10 @@
SaveAnsGoal = SaveAnsGoal0,
generate_call("table_simple_is_inactive", [TableVar], semidet,
- semipure, [], Module, Context, InactiveCheckGoal),
+ yes(semipure), [], Module, Context, InactiveCheckGoal),
generate_call("table_simple_mark_as_active", [TableVar], det,
- impure, [], Module, Context, MarkAsActiveGoal),
+ yes(impure), [], Module, Context, MarkAsActiveGoal),
GenTrueAnsGoalEx = conj([InactiveCheckGoal,
MarkAsActiveGoal, OrigGoal]),
@@ -599,22 +830,22 @@
generate_non_lookup_goal(InputVars, PredId, ProcId, Context,
VarTypes0, VarTypes1, VarSet0, VarSet1, TableInfo0, TableInfo1,
TableVar, LookUpGoal),
- generate_call("table_nondet_is_complete", [TableVar], semidet, semipure,
- [], Module, Context, CompleteCheckGoal),
+ generate_call("table_nondet_is_complete", [TableVar], semidet,
+ yes(semipure), [], Module, Context, CompleteCheckGoal),
generate_non_save_goal(OutputVars, TableVar, Context,
VarTypes1, VarTypes2, VarSet1, VarSet2, TableInfo1, TableInfo,
SaveAnsGoal0),
generate_restore_all_goal(Detism, OutputVars, TableVar, Module, Context,
VarTypes2, VarTypes3, VarSet2, VarSet3, RestoreAllAnsGoal),
- generate_call("table_nondet_is_active", [TableVar], semidet, semipure,
- [], Module, Context, IsActiveCheckGoal),
+ generate_call("table_nondet_is_active", [TableVar], semidet,
+ yes(semipure), [], Module, Context, IsActiveCheckGoal),
generate_suspend_goal(OutputVars, TableVar, Module, Context,
VarTypes3, VarTypes4, VarSet3, VarSet4, SuspendGoal),
generate_loop_error_goal(TableInfo, Context, VarTypes4, VarTypes,
VarSet4, VarSet, LoopErrorGoal),
- generate_call("table_nondet_mark_as_active", [TableVar], det, impure,
- [], Module, Context, MarkAsActiveGoal),
- generate_call("table_nondet_resume", [TableVar], det, impure,
+ generate_call("table_nondet_mark_as_active", [TableVar], det,
+ yes(impure), [], Module, Context, MarkAsActiveGoal),
+ generate_call("table_nondet_resume", [TableVar], det, yes(impure),
[], Module, Context, ResumeGoal0),
append_fail(ResumeGoal0, ResumeGoal1),
@@ -684,6 +915,15 @@
%-----------------------------------------------------------------------------%
+:- pred table_gen__var_is_io_state(map(prog_var, type)::in, prog_var::in)
+ is semidet.
+
+table_gen__var_is_io_state(VarTypes, Var) :-
+ map__lookup(VarTypes, Var, VarType),
+ type_util__type_is_io_state(VarType).
+
+%-----------------------------------------------------------------------------%
+
:- pred generate_get_table_goal(pred_id::in, proc_id::in,
map(prog_var, type)::in, map(prog_var, type)::out,
prog_varset::in, prog_varset::out,
@@ -708,13 +948,11 @@
generate_simple_lookup_goal(Vars, PredId, ProcId, Context, VarTypes0, VarTypes,
VarSet0, VarSet, TableInfo0, TableInfo, TableVar, Goal) :-
-
generate_get_table_goal(PredId, ProcId, VarTypes0, VarTypes1,
VarSet0, VarSet1, PredTableVar, GetTableGoal),
generate_lookup_goals(Vars, Context, PredTableVar, TableVar,
VarTypes1, VarTypes, VarSet1, VarSet, TableInfo0, TableInfo,
LookupGoals),
-
GoalEx = conj([GetTableGoal | LookupGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, Vars, NonLocals),
@@ -733,7 +971,6 @@
generate_non_lookup_goal(Vars, PredId, ProcId, Context, VarTypes0, VarTypes,
VarSet0, VarSet, TableInfo0, TableInfo, SubgoalVar, Goal) :-
table_info_get_module_info(TableInfo0, Module),
-
generate_get_table_goal(PredId, ProcId, VarTypes0, VarTypes1,
VarSet0, VarSet1, PredTableVar, GetTableGoal),
generate_lookup_goals(Vars, Context, PredTableVar, TableNodeVar,
@@ -742,7 +979,7 @@
generate_new_table_var("SubgoalVar", VarTypes2, VarTypes,
VarSet2, VarSet, SubgoalVar),
generate_call("table_nondet_setup", [TableNodeVar, SubgoalVar],
- det, impure, [SubgoalVar - ground(unique, none)],
+ det, yes(impure), [SubgoalVar - ground(unique, none)],
Module, Context, SetupGoal),
list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals),
@@ -813,7 +1050,7 @@
NextTableVar),
generate_call("table_lookup_insert_enum",
[TableVar, RangeVar, ArgVar, NextTableVar],
- det, impure,
+ det, yes(impure),
[NextTableVar - ground(unique, none)],
Module, Context, LookupGoal),
set__init(NonLocals0),
@@ -848,7 +1085,7 @@
generate_call(LookupPredName,
[TypeInfoVar, TableVar, ArgVar, NextTableVar],
- det, impure, InstMapAL, Module, Context,
+ det, yes(impure), InstMapAL, Module, Context,
CallGoal),
list__append(ExtraGoals, [CallGoal], ConjList),
@@ -860,7 +1097,7 @@
LookupPredName),
generate_call(LookupPredName,
[TableVar, ArgVar, NextTableVar],
- det, impure, InstMapAL, Module, Context,
+ det, yes(impure), InstMapAL, Module, Context,
Goal),
VarTypes = VarTypes1,
VarSet = VarSet1,
@@ -891,7 +1128,8 @@
VarSet1, VarSet2, AnsTableVar),
generate_call("table_create_ans_block",
- [TableVar, NumAnsVarsVar, AnsTableVar], det, impure,
+ [TableVar, NumAnsVarsVar, AnsTableVar], det,
+ yes(impure),
[AnsTableVar - ground(unique, none)], Module, Context,
CreateAnsBlockGoal),
@@ -913,7 +1151,7 @@
VarTypes = VarTypes0,
VarSet = VarSet0,
generate_call("table_simple_mark_as_succeeded", [TableVar], det,
- impure, [], Module, Context, Goal),
+ yes(impure), [], Module, Context, Goal),
TableInfo = TableInfo0
).
@@ -929,18 +1167,18 @@
generate_new_table_var("AnswerTableVar", VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar0),
generate_call("table_nondet_get_ans_table", [TableVar, AnsTableVar0],
- det, impure, [AnsTableVar0 - ground(unique, none)],
+ det, yes(impure), [AnsTableVar0 - ground(unique, none)],
Module, Context, GetAnsTableGoal),
generate_lookup_goals(AnsList, Context, AnsTableVar0, AnsTableVar1,
VarTypes1, VarTypes2, VarSet1, VarSet2, TableInfo0, TableInfo1,
LookupAnsGoals),
generate_call("table_nondet_answer_is_not_duplicate", [AnsTableVar1],
- semidet, impure, [], Module, Context, DuplicateCheckGoal),
+ semidet, yes(impure), [], Module, Context, DuplicateCheckGoal),
generate_new_table_var("AnswerSlotVar", VarTypes2, VarTypes3,
VarSet2, VarSet3, AnsSlotVar),
generate_call("table_nondet_new_ans_slot", [TableVar, AnsSlotVar], det,
- impure, [AnsSlotVar - ground(unique, none)],
+ yes(impure), [AnsSlotVar - ground(unique, none)],
Module, Context, NewAnsSlotGoal),
list__length(AnsList, NumAnsVars),
@@ -949,7 +1187,7 @@
generate_new_table_var("AnswerBlock", VarTypes4, VarTypes5,
VarSet4, VarSet5, AnsBlockVar),
generate_call("table_create_ans_block",
- [AnsSlotVar, NumAnsVarsVar, AnsBlockVar], det, impure,
+ [AnsSlotVar, NumAnsVarsVar, AnsBlockVar], det, yes(impure),
[AnsBlockVar - ground(unique, none)],
Module, Context, CreateAnsBlockGoal),
@@ -1008,16 +1246,22 @@
VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
Goal) :-
table_info_get_module_info(TableInfo0, Module),
- (
- not_builtin_type(TypeCat)
- ->
+ ( type_util__type_is_io_state(Type) ->
+ LookupPredName = "table_save_io_state_ans",
+ generate_call(LookupPredName, [TableVar, OffsetVar, Var],
+ det, yes(impure), [], Module, Context, Goal),
+
+ VarTypes = VarTypes0,
+ VarSet = VarSet0,
+ TableInfo = TableInfo0
+ ; not_builtin_type(TypeCat) ->
make_type_info_var(Type, Context, VarTypes0, VarTypes,
VarSet0, VarSet, TableInfo0, TableInfo,
TypeInfoVar, ExtraGoals),
generate_call("table_save_any_ans",
[TypeInfoVar, TableVar, OffsetVar, Var],
- det, impure, [], Module, Context, CallGoal),
+ det, yes(impure), [], Module, Context, CallGoal),
list__append(ExtraGoals, [CallGoal], ConjList),
CallGoal = _ - GoalInfo,
@@ -1027,7 +1271,7 @@
string__append_list(["table_save_", CatString, "_ans"],
LookupPredName),
generate_call(LookupPredName, [TableVar, OffsetVar, Var],
- det, impure, [], Module, Context, Goal),
+ det, yes(impure), [], Module, Context, Goal),
VarTypes = VarTypes0,
VarSet = VarSet0,
@@ -1073,7 +1317,7 @@
error("generate_restore_all_goal: invalid determinism")
),
generate_call(ReturnAllAns, [TableVar, AnsTableVar],
- Detism, semipure, [AnsTableVar - ground(unique, none)],
+ Detism, yes(semipure), [AnsTableVar - ground(unique, none)],
Module, Context, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context,
@@ -1116,19 +1360,20 @@
prog_var::in, prog_var::in, prog_var::in, module_info::in,
term__context::in, hlds_goal::out) is det.
-gen_restore_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module,
+gen_restore_call_for_type(TypeCat, Type, TableVar, Var, OffsetVar, Module,
Context, Goal) :-
- (
- not_builtin_type(TypeCat)
- ->
+ ( type_util__type_is_io_state(Type) ->
+ LookupPredName = "table_restore_io_state_ans"
+ ; not_builtin_type(TypeCat) ->
LookupPredName = "table_restore_any_ans"
;
builtin_type_to_string(TypeCat, CatString),
string__append_list(["table_restore_", CatString, "_ans"],
LookupPredName)
),
- generate_call(LookupPredName, [TableVar, OffsetVar, Var], det, impure,
- [Var - ground(shared, none)], Module, Context, Goal).
+ generate_call(LookupPredName, [TableVar, OffsetVar, Var], det,
+ yes(impure), [Var - ground(shared, none)],
+ Module, Context, Goal).
%-----------------------------------------------------------------------------%
@@ -1143,7 +1388,7 @@
generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar),
generate_call("table_nondet_suspend", [TableVar, AnsTableVar],
- nondet, semipure, [AnsTableVar - ground(unique, none)],
+ nondet, yes(semipure), [AnsTableVar - ground(unique, none)],
Module, Context, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context,
@@ -1182,7 +1427,7 @@
gen_string_construction("MessageS", Message, VarTypes0, VarTypes,
VarSet0, VarSet, MessageVar, MessageConsGoal),
generate_call("table_loopcheck_error", [MessageVar], erroneous,
- impure, [], ModuleInfo, Context, CallGoal),
+ yes(impure), [], ModuleInfo, Context, CallGoal),
GoalEx = conj([MessageConsGoal, CallGoal]),
set__init(NonLocals),
@@ -1204,10 +1449,10 @@
map__set(VarTypes0, Var, Type, VarTypes).
:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
- goal_feature::in, assoc_list(prog_var, inst)::in, module_info::in,
- term__context::in, hlds_goal::out) is det.
+ maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
+ module_info::in, term__context::in, hlds_goal::out) is det.
-generate_call(PredName, Args, Detism, Feature, InstMap, Module, Context,
+generate_call(PredName, Args, Detism, MaybeFeature, InstMap, Module, Context,
CallGoal) :-
list__length(Args, Arity),
mercury_table_builtin_module(BuiltinModule),
@@ -1259,10 +1504,17 @@
),
init_goal_info(NonLocals, InstMapDelta, Detism, Context,
CallGoalInfo0),
- goal_info_add_feature(CallGoalInfo0, Feature, CallGoalInfo),
+ (
+ MaybeFeature = yes(Feature),
+ goal_info_add_feature(CallGoalInfo0, Feature, CallGoalInfo)
+ ;
+ MaybeFeature = no,
+ CallGoalInfo = CallGoalInfo0
+ ),
CallGoal = Call - CallGoalInfo.
:- pred append_fail(hlds_goal::in, hlds_goal::out) is det.
+
append_fail(Goal, GoalAndThenFail) :-
Goal = _ - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
@@ -1310,14 +1562,10 @@
get_input_output_vars([], [_|_], _, _, _) :-
error("get_input_output_vars: lists not same length").
get_input_output_vars([Var | RestV], [Mode | RestM], Module, InVars, OutVars) :-
- (
- mode_is_fully_input(Module, Mode)
- ->
+ ( mode_is_fully_input(Module, Mode) ->
get_input_output_vars(RestV, RestM, Module, InVars0, OutVars),
InVars = [Var | InVars0]
- ;
- mode_is_fully_output(Module, Mode)
- ->
+ ; mode_is_fully_output(Module, Mode) ->
get_input_output_vars(RestV, RestM, Module, InVars, OutVars0),
OutVars = [Var | OutVars0]
;
@@ -1329,7 +1577,6 @@
create_instmap_delta([], IMD) :-
instmap_delta_from_assoc_list([], IMD).
-
create_instmap_delta([Goal | Rest], IMD) :-
Goal = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, IMD0),
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.40
diff -u -b -r1.40 trace.m
--- compiler/trace.m 2000/11/23 04:32:49 1.40
+++ compiler/trace.m 2000/12/04 04:26:29
@@ -82,13 +82,12 @@
% value of the from-full flag at call.
% Otherwise, it will be no.
- slot_decl :: maybe(int),
- % If --trace-decl is set, this will
- % be yes(M), where stack slots M
- % and M+1 are reserved for the runtime
- % system to use in building proof
- % trees for the declarative debugger.
- % Otherwise, it will be no.
+ slot_io :: maybe(int),
+ % If the procedure has io state
+ % arguments this will be yes(N), where
+ % stack slot N is the slot that holds
+ % the saved value of the io sequence
+ % number. Otherwise, it will be no.
slot_trail :: maybe(int),
% If --use-trail is set, this will
@@ -108,13 +107,21 @@
% at the time of the call. Otherwise,
% it will be no.
- slot_call_table :: maybe(int)
+ slot_call_table :: maybe(int),
% If the procedure's evaluation method
% is memo, loopcheck or minimal model,
% this will be yes(M), where stack slot
% M holds the variable that represents
% the tip of the call table. Otherwise,
% it will be no.
+
+ slot_decl :: maybe(int)
+ % If --trace-decl is set, this will
+ % be yes(M), where stack slots M
+ % and M+1 are reserved for the runtime
+ % system to use in building proof
+ % trees for the declarative debugger.
+ % Otherwise, it will be no.
).
% Return the set of input variables whose values should be preserved
@@ -137,16 +144,17 @@
% It is possible that one of these reserved slots contains a variable.
% If so, the variable and its slot number are returned in the last
% argument.
-:- pred trace__reserved_slots(proc_info::in, globals::in, int::out,
- maybe(pair(prog_var, int))::out) is det.
+:- pred trace__reserved_slots(module_info::in, proc_info::in, globals::in,
+ int::out, maybe(pair(prog_var, int))::out) is det.
% Construct and return an abstract struct that represents the
% tracing-specific part of the code generator state. Return also
% info about the non-fixed slots used by the tracing system,
% for eventual use in the constructing the procedure's layout
% structure.
-:- pred trace__setup(proc_info::in, globals::in, trace_slot_info::out,
- trace_info::out, code_info::in, code_info::out) is det.
+:- pred trace__setup(module_info::in, proc_info::in, globals::in,
+ trace_slot_info::out, trace_info::out, code_info::in, code_info::out)
+ is det.
% Generate code to fill in the reserved stack slots.
:- pred trace__generate_slot_fill_code(trace_info::in, code_tree::out,
@@ -285,7 +293,14 @@
% in the maybe_decl_debug field in the proc layout;
% if there are no such slots, that field will contain -1.
%
- % stage 5: If --use-trail is set (given or implied), allocate
+ % stage 5: If --trace-table-io is given, allocate the next slot
+ % to hold the saved value of the io sequence number,
+ % for use in implementing retry. The number of this slot
+ % is recorded in the maybe_io_seq field in the proc
+ % layout; if there is no such slot, that field will
+ % contain -1.
+ %
+ % stage 6: If --use-trail is set (given or implied), allocate
% two slots to hold the saved value of the trail pointer
% and the ticket counter at the point of the call, for
% use in implementing retry. The number of the first of
@@ -293,7 +308,7 @@
% in the proc layout; if there are no such slots, that
% field will contain -1.
%
- % stage 6: If the procedure lives on the det stack but can put
+ % stage 7: If the procedure lives on the det stack but can put
% frames on the nondet stack, allocate a slot to hold
% the saved value of maxfr at the point of the call,
% for use in implementing retry. The number of this
@@ -301,7 +316,7 @@
% layout; if there is no such slot, that field will
% contain -1.
%
- % stage 7: If the procedure's evaluation method is memo, loopcheck
+ % stage 8: If the procedure's evaluation method is memo, loopcheck
% or minimal model, we allocate a slot to hold the
% variable that represents the tip of the call table.
% The debugger needs this, because when it executes a
@@ -334,9 +349,11 @@
% which answers such questions, for later inclusion in the
% procedure's layout structure.
-trace__reserved_slots(ProcInfo, Globals, ReservedSlots, MaybeTableVarInfo) :-
+trace__reserved_slots(_ModuleInfo, ProcInfo, Globals, ReservedSlots,
+ MaybeTableVarInfo) :-
globals__get_trace_level(Globals, TraceLevel),
globals__get_trace_suppress(Globals, TraceSuppress),
+ globals__lookup_bool_option(Globals, trace_table_io, TraceTableIo),
FixedSlots = trace_level_needs_fixed_slots(TraceLevel),
(
FixedSlots = no,
@@ -363,6 +380,11 @@
;
DeclDebug = 0
),
+ ( TraceTableIo = yes ->
+ IoSeq = 1
+ ;
+ IoSeq = 0
+ ),
globals__lookup_bool_option(Globals, use_trail, UseTrail),
( UseTrail = yes ->
Trail = 2
@@ -377,8 +399,8 @@
NeedMaxfr = no,
Maxfr = 0
),
- ReservedSlots0 = Fixed + RedoLayout + FromFull + DeclDebug +
- Trail + Maxfr,
+ ReservedSlots0 = Fixed + RedoLayout + FromFull + IoSeq
+ + Trail + Maxfr + DeclDebug,
proc_info_get_call_table_tip(ProcInfo, MaybeCallTableVar),
( MaybeCallTableVar = yes(CallTableVar) ->
ReservedSlots = ReservedSlots0 + 1,
@@ -389,10 +411,11 @@
)
).
-trace__setup(ProcInfo, Globals, TraceSlotInfo, TraceInfo) -->
+trace__setup(_ModuleInfo, ProcInfo, Globals, TraceSlotInfo, TraceInfo) -->
code_info__get_proc_model(CodeModel),
{ globals__get_trace_level(Globals, TraceLevel) },
{ globals__get_trace_suppress(Globals, TraceSuppress) },
+ { globals__lookup_bool_option(Globals, trace_table_io, TraceTableIo) },
{ trace_needs_port(TraceLevel, TraceSuppress, redo) = TraceRedo },
(
{ TraceRedo = yes },
@@ -429,18 +452,31 @@
MaybeDeclSlots = no,
NextSlotAfterDecl = NextSlotAfterFromFull
},
+ {
+ TraceTableIo = yes,
+ MaybeIoSeqSlot = yes(NextSlotAfterDecl),
+ IoSeqLval = llds__stack_slot_num_to_lval(CodeModel,
+ NextSlotAfterDecl),
+ MaybeIoSeqLval = yes(IoSeqLval),
+ NextSlotAfterIoSeq = NextSlotAfterDecl + 1
+ ;
+ TraceTableIo = no,
+ MaybeIoSeqSlot = no,
+ MaybeIoSeqLval = no,
+ NextSlotAfterIoSeq = NextSlotAfterDecl
+ },
{ globals__lookup_bool_option(Globals, use_trail, yes) ->
- MaybeTrailSlot = yes(NextSlotAfterDecl),
+ MaybeTrailSlot = yes(NextSlotAfterIoSeq),
TrailLval = llds__stack_slot_num_to_lval(CodeModel,
- NextSlotAfterDecl),
+ NextSlotAfterIoSeq),
TicketLval = llds__stack_slot_num_to_lval(CodeModel,
- NextSlotAfterDecl + 1),
+ NextSlotAfterIoSeq + 1),
MaybeTrailLvals = yes(TrailLval - TicketLval),
- NextSlotAfterTrail = NextSlotAfterDecl + 2
+ NextSlotAfterTrail = NextSlotAfterIoSeq + 2
;
MaybeTrailSlot = no,
MaybeTrailLvals = no,
- NextSlotAfterTrail = NextSlotAfterDecl
+ NextSlotAfterTrail = NextSlotAfterIoSeq
},
{ proc_info_get_need_maxfr_slot(ProcInfo, NeedMaxfr) },
{
@@ -465,16 +501,18 @@
MaybeCallTableSlot = no,
MaybeCallTableLval = no
},
- { TraceSlotInfo = trace_slot_info(MaybeFromFullSlot, MaybeDeclSlots,
- MaybeTrailSlot, MaybeMaxfrSlot, MaybeCallTableSlot) },
+ { TraceSlotInfo = trace_slot_info(MaybeFromFullSlot, MaybeIoSeqSlot,
+ MaybeTrailSlot, MaybeMaxfrSlot, MaybeCallTableSlot,
+ MaybeDeclSlots) },
{ TraceInfo = trace_info(TraceLevel, TraceSuppress,
- MaybeFromFullSlotLval, MaybeTrailLvals, MaybeMaxfrLval,
- MaybeCallTableLval, MaybeRedoLayoutLabel) }.
+ MaybeFromFullSlotLval, MaybeIoSeqLval, MaybeTrailLvals,
+ MaybeMaxfrLval, MaybeCallTableLval, MaybeRedoLayoutLabel) }.
trace__generate_slot_fill_code(TraceInfo, TraceCode) -->
code_info__get_proc_model(CodeModel),
{
MaybeFromFullSlot = TraceInfo ^ from_full_lval,
+ MaybeIoSeqSlot = TraceInfo ^ io_seq_lval,
MaybeTrailLvals = TraceInfo ^ trail_lvals,
MaybeMaxfrLval = TraceInfo ^ maxfr_lval,
MaybeCallTableLval = TraceInfo ^ call_table_tip_lval,
@@ -490,20 +528,33 @@
"\t\t", CallNumStr, " = MR_trace_incr_seq();\n",
"\t\t", CallDepthStr, " = MR_trace_incr_depth();"
], FillThreeSlots),
- ( MaybeRedoLabel = yes(RedoLayoutLabel) ->
+ (
+ MaybeIoSeqSlot = yes(IoSeqLval),
+ trace__stackref_to_string(IoSeqLval, IoSeqStr),
+ string__append_list([
+ FillThreeSlots, "\n",
+ "\t\t", IoSeqStr, " = MR_io_tabling_counter;"
+ ], FillSlotsUptoIoSeq)
+ ;
+ MaybeIoSeqSlot = no,
+ FillSlotsUptoIoSeq = FillThreeSlots
+ ),
+ (
+ MaybeRedoLabel = yes(RedoLayoutLabel),
trace__redo_layout_slot(CodeModel, RedoLayoutLval),
trace__stackref_to_string(RedoLayoutLval, RedoLayoutStr),
llds_out__make_stack_layout_name(RedoLayoutLabel,
LayoutAddrStr),
string__append_list([
- FillThreeSlots, "\n",
+ FillSlotsUptoIoSeq, "\n",
"\t\t", RedoLayoutStr,
" = (MR_Word) (const MR_Word *) &",
LayoutAddrStr, ";"
- ], FillFourSlots),
+ ], FillSlotsUptoRedo),
MaybeLayoutLabel = yes(RedoLayoutLabel)
;
- FillFourSlots = FillThreeSlots,
+ MaybeRedoLabel = no,
+ FillSlotsUptoRedo = FillSlotsUptoIoSeq,
MaybeLayoutLabel = no
),
(
@@ -515,13 +566,13 @@
trace__stackref_to_string(TrailLval, TrailLvalStr),
trace__stackref_to_string(TicketLval, TicketLvalStr),
string__append_list([
- FillFourSlots, "\n",
+ FillSlotsUptoRedo, "\n",
"\t\tMR_mark_ticket_stack(", TicketLvalStr, ");\n",
"\t\tMR_store_ticket(", TrailLvalStr, ");"
- ], FillSixSlots)
+ ], FillSlotsUptoTrail)
;
MaybeTrailLvals = no,
- FillSixSlots = FillFourSlots
+ FillSlotsUptoTrail = FillSlotsUptoRedo
),
(
% This could be done by generating proper LLDS instead of C.
@@ -531,12 +582,12 @@
MaybeMaxfrLval = yes(MaxfrLval),
trace__stackref_to_string(MaxfrLval, MaxfrLvalStr),
string__append_list([
- FillSixSlots,
+ FillSlotsUptoTrail,
"\n\t\t", MaxfrLvalStr, " = (MR_Word) MR_maxfr;"
- ], FillCondSlots)
+ ], FillSlotsUptoMaxfr)
;
MaybeMaxfrLval = no,
- FillCondSlots = FillSixSlots
+ FillSlotsUptoMaxfr = FillSlotsUptoTrail
),
(
MaybeFromFullSlot = yes(CallFromFullSlot),
@@ -545,14 +596,14 @@
string__append_list([
"\t\t", CallFromFullSlotStr, " = MR_trace_from_full;\n",
"\t\tif (MR_trace_from_full) {\n",
- FillCondSlots, "\n",
+ FillSlotsUptoMaxfr, "\n",
"\t\t} else {\n",
"\t\t\t", CallDepthStr, " = MR_trace_call_depth;\n",
"\t\t}"
], TraceStmt1)
;
MaybeFromFullSlot = no,
- TraceStmt1 = FillCondSlots
+ TraceStmt1 = FillSlotsUptoMaxfr
),
TraceCode1 = node([
pragma_c([], [pragma_c_raw_code(TraceStmt1)],
@@ -758,7 +809,7 @@
set__list_to_set(VarInfoList, VarInfoSet),
LayoutLabelInfo = layout_label_info(VarInfoSet, TvarDataMap),
llds_out__get_label(Label, yes, LabelStr),
- DeclStmt = "\t\tCode *MR_jumpaddr;\n",
+ DeclStmt = "\t\tMR_Code *MR_jumpaddr;\n",
SaveStmt = "\t\tMR_save_transient_registers();\n",
RestoreStmt = "\t\tMR_restore_transient_registers();\n",
GotoStmt = "\t\tif (MR_jumpaddr != NULL) MR_GOTO(MR_jumpaddr);"
@@ -1005,6 +1056,11 @@
% If the trace level is shallow,
% the lval of the slot that holds the
% from-full flag.
+ io_seq_lval :: maybe(lval),
+ % If the procedure has I/O state
+ % arguments, the lval of the slot
+ % that holds the initial value of the
+ % I/O action counter.
trail_lvals :: maybe(pair(lval)),
% If trailing is enabled, the lvals
% of the slots that hold the value
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.53
diff -u -b -r1.53 compiler_design.html
--- compiler/notes/compiler_design.html 2000/11/16 08:45:48 1.53
+++ compiler/notes/compiler_design.html 2000/11/21 01:21:33
@@ -484,6 +484,9 @@
The first pass of this stage does tabling transformations (table_gen.m).
This involves the insertion of several calls to tabling predicates
defined in mercury_builtin.m and the addition of some scaffolding structure.
+Note that this pass can change the evaluation methods of some procedures to
+eval_table_io, so it should come before any passes that require definitive
+evaluation methods (e.g. inlining).
<p>
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing library
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.214
diff -u -b -r1.214 io.m
--- library/io.m 2000/11/28 05:50:41 1.214
+++ library/io.m 2000/11/30 02:25:38
@@ -1126,7 +1126,7 @@
MR_Word ML_io_stream_names;
MR_Word ML_io_user_globals;
#if 0
- extern MR_Word ML_io_ops_table;
+ MR_Word ML_io_ops_table;
#endif
").
@@ -1366,7 +1366,7 @@
:- pragma c_code(io__read_line_as_string_2(File::in, Res :: out,
RetString::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"
#define ML_IO_READ_LINE_GROW(n) ((n) * 3 / 2)
#define ML_IO_BYTES_TO_WORDS(n) (((n) + sizeof(MR_Word) - 1) / sizeof(MR_Word))
@@ -1512,7 +1512,7 @@
% same as ANSI C's clearerr().
:- pragma c_code(io__clear_err(Stream::in, _IO0::di, _IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
@@ -1540,7 +1540,7 @@
:- pragma c_code(ferror(Stream::in, RetVal::out, RetStr::out,
_IO0::di, _IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
@@ -1562,7 +1562,7 @@
:- mode io__make_err_msg(in, out, di, uo) is det.
:- pragma c_code(make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, tabled_for_io],
"{
ML_maybe_make_err_msg(TRUE, Msg0, MR_PROC_LABEL, Msg);
}").
@@ -1586,7 +1586,7 @@
:- pragma c_code(io__stream_file_size(Stream::in, Size::out,
_IO0::di, _IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
#if defined(HAVE_FSTAT) && \
@@ -1618,7 +1618,7 @@
:- pred io__alloc_buffer(int::in, buffer::uo) is det.
:- pragma c_code(io__alloc_buffer(Size::in, Buffer::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MR_incr_hp_atomic_msg(Buffer,
(Size * sizeof(MR_Char) + sizeof(MR_Word) - 1)
@@ -1629,7 +1629,7 @@
:- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
:- pragma c_code(io__resize_buffer(Buffer0::di, OldSize::in, NewSize::in,
Buffer::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MR_Char *buffer0 = (MR_Char *) Buffer0;
MR_Char *buffer;
@@ -1666,7 +1666,7 @@
:- pred io__buffer_to_string(buffer::di, int::in, string::uo) is det.
:- pragma c_code(io__buffer_to_string(Buffer::di, Len::in, Str::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
Str = (MR_String) Buffer;
Str[Len] = '\\0';
@@ -1674,7 +1674,7 @@
:- pred io__buffer_to_string(buffer::di, string::uo) is det.
:- pragma c_code(io__buffer_to_string(Buffer::di, Str::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
Str = (MR_String) Buffer;
}").
@@ -1685,7 +1685,7 @@
:- pragma c_code(io__read_into_buffer(Stream::in,
Buffer0::di, Pos0::in, Size::in,
Buffer::uo, Pos::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
char *buffer = (MR_Char *) Buffer0;
@@ -2487,7 +2487,8 @@
:- mode io__get_stream_names(out, di, uo) is det.
:- pragma c_code(io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
StreamNames = ML_io_stream_names;
update_io(IO0, IO);
").
@@ -2496,7 +2497,8 @@
:- mode io__set_stream_names(in, di, uo) is det.
:- pragma c_code(io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
ML_io_stream_names = StreamNames;
update_io(IO0, IO);
").
@@ -2526,13 +2528,15 @@
% and io__get_globals/3: the `Globals::uo' mode here is a lie.
:- pragma c_code(io__get_globals(Globals::uo, IOState0::di, IOState::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
Globals = ML_io_user_globals;
update_io(IOState0, IOState);
").
:- pragma c_code(io__set_globals(Globals::di, IOState0::di, IOState::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
/* XXX need to globalize the memory */
ML_io_user_globals = Globals;
update_io(IOState0, IOState);
@@ -2654,7 +2658,9 @@
:- mode io__gc_init(in, in, di, uo) is det.
:- pragma c_code(io__gc_init(StreamNamesType::in, UserGlobalsType::in,
- IO0::di, IO::uo), will_not_call_mercury, "
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
/* for Windows DLLs, we need to call GC_INIT() from each DLL */
#ifdef CONSERVATIVE_GC
GC_INIT();
@@ -3108,13 +3114,15 @@
/* input predicates */
:- pragma c_code(io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
CharCode = mercury_getc((MercuryFile *) File);
update_io(IO0, IO);
").
:- pragma c_code(io__putback_char(File::in, Character::in, IO0::di, IO::uo),
- may_call_mercury, "{
+ [may_call_mercury, tabled_for_io],
+"{
MercuryFile* mf = (MercuryFile *) File;
if (Character == '\\n') {
MR_line_number(*mf)--;
@@ -3127,7 +3135,8 @@
}").
:- pragma c_code(io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
- may_call_mercury, "{
+ [may_call_mercury, tabled_for_io],
+"{
MercuryFile* mf = (MercuryFile *) File;
/* XXX should work even if ungetc() fails */
if (MR_UNGETCH(*mf, Character) == EOF) {
@@ -3139,13 +3148,15 @@
/* output predicates - with output to mercury_current_text_output */
:- pragma c_code(io__write_string(Message::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
mercury_print_string(mercury_current_text_output, Message);
update_io(IO0, IO);
").
:- pragma c_code(io__write_char(Character::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
if (MR_PUTCH(*mercury_current_text_output, Character) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -3156,7 +3167,8 @@
").
:- pragma c_code(io__write_int(Val::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
if (ML_fprintf(mercury_current_text_output, ""%ld"", (long) Val) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -3164,7 +3176,8 @@
").
:- pragma c_code(io__write_float(Val::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
if (ML_fprintf(mercury_current_text_output, ""%#.15g"", Val) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -3172,7 +3185,8 @@
").
:- pragma c_code(io__write_byte(Byte::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
/* call putc with a strictly non-negative byte-sized integer */
if (MR_PUTCH(*mercury_current_binary_output,
(int) ((unsigned char) Byte)) < 0)
@@ -3183,13 +3197,15 @@
").
:- pragma c_code(io__write_bytes(Message::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
mercury_print_binary_string(mercury_current_binary_output, Message);
update_io(IO0, IO);
}").
:- pragma c_code(io__flush_output(IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
if (MR_FLUSH(*mercury_current_text_output) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -3197,7 +3213,8 @@
").
:- pragma c_code(io__flush_binary_output(IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
if (MR_FLUSH(*mercury_current_binary_output) < 0) {
mercury_output_error(mercury_current_binary_output);
}
@@ -3220,7 +3237,8 @@
:- mode io__seek_binary_2(in, in, in, di, uo) is det.
:- pragma c_code(io__seek_binary_2(Stream::in, Flag::in, Off::in,
- IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3237,7 +3255,8 @@
}").
:- pragma c_code(io__binary_stream_offset(Stream::in, Offset::out,
- IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
/* XXX should check for failure */
@@ -3255,7 +3274,7 @@
/* output predicates - with output to the specified stream */
:- pragma c_code(io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe],
+ [may_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
mercury_print_string(stream, Message);
@@ -3263,7 +3282,7 @@
}").
:- pragma c_code(io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe],
+ [may_call_mercury, tabled_for_io, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
if (MR_PUTCH(*stream, Character) < 0) {
@@ -3276,7 +3295,8 @@
}").
:- pragma c_code(io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
if (ML_fprintf(stream, ""%ld"", (long) Val) < 0) {
mercury_output_error(stream);
@@ -3285,7 +3305,8 @@
}").
:- pragma c_code(io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
if (ML_fprintf(stream, ""%#.15g"", Val) < 0) {
mercury_output_error(stream);
@@ -3294,7 +3315,8 @@
}").
:- pragma c_code(io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
/* call putc with a strictly non-negative byte-sized integer */
if (MR_PUTCH(*stream, (int) ((unsigned char) Byte)) < 0) {
@@ -3304,14 +3326,16 @@
}").
:- pragma c_code(io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
mercury_print_binary_string(stream, Message);
update_io(IO0, IO);
}").
:- pragma c_code(io__flush_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
if (MR_FLUSH(*stream) < 0) {
mercury_output_error(stream);
@@ -3320,7 +3344,8 @@
}").
:- pragma c_code(io__flush_binary_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "{
+ [may_call_mercury, tabled_for_io, thread_safe],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
if (MR_FLUSH(*stream) < 0) {
mercury_output_error(stream);
@@ -3335,110 +3360,127 @@
:- pragma export(io__stderr_stream(out, di, uo), "ML_io_stderr_stream").
:- pragma c_code(io__stdin_stream(Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
Stream = (MR_Word) &mercury_stdin;
update_io(IO0, IO);
").
:- pragma c_code(io__stdout_stream(Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
Stream = (MR_Word) &mercury_stdout;
update_io(IO0, IO);
").
:- pragma c_code(io__stderr_stream(Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
Stream = (MR_Word) &mercury_stderr;
update_io(IO0, IO);
").
:- pragma c_code(io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
Stream = (MR_Word) &mercury_stdin_binary;
update_io(IO0, IO);
").
:- pragma c_code(io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
Stream = (MR_Word) &mercury_stdout_binary;
update_io(IO0, IO);
").
:- pragma c_code(io__input_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
Stream = (MR_Word) mercury_current_text_input;
update_io(IO0, IO);
").
:- pragma c_code(io__output_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
Stream = (MR_Word) mercury_current_text_output;
update_io(IO0, IO);
").
:- pragma c_code(io__binary_input_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
Stream = (MR_Word) mercury_current_binary_input;
update_io(IO0, IO);
").
:- pragma c_code(io__binary_output_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
Stream = (MR_Word) mercury_current_binary_output;
update_io(IO0, IO);
").
:- pragma c_code(io__get_line_number(LineNum::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
LineNum = MR_line_number(*mercury_current_text_input);
update_io(IO0, IO);
").
:- pragma c_code(
io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, tabled_for_io],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
LineNum = MR_line_number(*stream);
update_io(IO0, IO);
}").
:- pragma c_code(io__set_line_number(LineNum::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
MR_line_number(*mercury_current_text_input) = LineNum;
update_io(IO0, IO);
").
:- pragma c_code(
io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, tabled_for_io],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
MR_line_number(*stream) = LineNum;
update_io(IO0, IO);
}").
:- pragma c_code(io__get_output_line_number(LineNum::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
LineNum = MR_line_number(*mercury_current_text_output);
update_io(IO0, IO);
").
:- pragma c_code(
io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, tabled_for_io],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
LineNum = MR_line_number(*stream);
update_io(IO0, IO);
}").
:- pragma c_code(io__set_output_line_number(LineNum::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
MR_line_number(*mercury_current_text_output) = LineNum;
update_io(IO0, IO);
").
-:- pragma c_code(
- io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+:- pragma c_code(io__set_output_line_number(Stream::in, LineNum::in,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"{
MercuryFile *stream = (MercuryFile *) Stream;
MR_line_number(*stream) = LineNum;
update_io(IO0, IO);
@@ -3447,33 +3489,37 @@
% io__set_input_stream(NewStream, OldStream, IO0, IO1)
% Changes the current input stream to the stream specified.
% Returns the previous stream.
-:- pragma c_code(
- io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+:- pragma c_code(io__set_input_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
OutStream = (MR_Word) mercury_current_text_input;
mercury_current_text_input = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
-:- pragma c_code(
- io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+:- pragma c_code(io__set_output_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
OutStream = (MR_Word) mercury_current_text_output;
mercury_current_text_output = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
-:- pragma c_code(
- io__set_binary_input_stream(NewStream::in, OutStream::out,
- IO0::di, IO::uo), will_not_call_mercury, "
+:- pragma c_code(io__set_binary_input_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
OutStream = (MR_Word) mercury_current_binary_input;
mercury_current_binary_input = (MercuryFile *) NewStream;
update_io(IO0, IO);
").
-:- pragma c_code(
- io__set_binary_output_stream(NewStream::in, OutStream::out,
- IO0::di, IO::uo), will_not_call_mercury, "
+:- pragma c_code(io__set_binary_output_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
OutStream = (MR_Word) mercury_current_binary_output;
mercury_current_binary_output = (MercuryFile *) NewStream;
update_io(IO0, IO);
@@ -3484,10 +3530,9 @@
% io__do_open(File, Mode, ResultCode, Stream, IO0, IO1).
% Attempts to open a file in the specified mode.
% ResultCode is 0 for success, -1 for failure.
-:- pragma c_code(
- io__do_open(FileName::in, Mode::in, ResultCode::out,
+:- pragma c_code(io__do_open(FileName::in, Mode::in, ResultCode::out,
Stream::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"
Stream = (MR_Word) mercury_open(FileName, Mode);
ResultCode = (Stream ? 0 : -1);
@@ -3495,25 +3540,29 @@
").
:- pragma c_code(io__close_input(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_input(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, thread_safe], "
+ [may_call_mercury, tabled_for_io, thread_safe],
+"
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
@@ -3522,7 +3571,8 @@
:- pragma c_code(
io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
if (MR_progname) {
/*
** The silly casting below is needed to avoid
@@ -3542,7 +3592,8 @@
").
:- pragma c_code(io__command_line_arguments(Args::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
/* convert mercury_argv from a vector to a list */
{ int i = mercury_argc;
Args = MR_list_empty_msg(MR_PROC_LABEL);
@@ -3555,20 +3606,23 @@
").
:- pragma c_code(io__get_exit_status(ExitStatus::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
ExitStatus = mercury_exit_status;
update_io(IO0, IO);
").
:- pragma c_code(io__set_exit_status(ExitStatus::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, tabled_for_io],
+"
mercury_exit_status = ExitStatus;
update_io(IO0, IO);
").
-:- pragma c_code(
- io__call_system_code(Command::in, Status::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+:- pragma c_code(io__call_system_code(Command::in, Status::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io],
+"
Status = system(Command);
if ( Status == -1 || Status == 127 ) {
/*
@@ -3604,12 +3658,16 @@
/* io__getenv and io__putenv, from io.m */
-:- pragma c_code(io__getenv(Var::in, Value::out), will_not_call_mercury, "{
+:- pragma c_code(io__getenv(Var::in, Value::out),
+ [will_not_call_mercury, tabled_for_io],
+"{
Value = getenv(Var);
SUCCESS_INDICATOR = (Value != 0);
}").
-:- pragma c_code(io__putenv(VarAndValue::in), will_not_call_mercury, "
+:- pragma c_code(io__putenv(VarAndValue::in),
+ [will_not_call_mercury, tabled_for_io],
+"
SUCCESS_INDICATOR = (putenv(VarAndValue) == 0);
").
@@ -3647,7 +3705,8 @@
/*---------------------------------------------------------------------------*/
-:- pred io__do_make_temp(string, string, string, int, string, io__state, io__state).
+:- pred io__do_make_temp(string, string, string, int, string,
+ io__state, io__state).
:- mode io__do_make_temp(in, in, out, out, out, di, uo) is det.
/*
@@ -3679,7 +3738,7 @@
:- pragma c_code(io__do_make_temp(Dir::in, Prefix::in, FileName::out,
Error::out, ErrorMessage::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
/*
** Constructs a temporary name by concatenating Dir, `/',
@@ -3785,7 +3844,8 @@
:- mode io__remove_file_2(in, out, out, di, uo) is det.
:- pragma c_code(io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
- IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
RetVal = remove(FileName);
ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "",
@@ -3806,7 +3866,7 @@
:- pragma c_code(io__rename_file_2(OldFileName::in, NewFileName::in,
RetVal::out, RetStr::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, tabled_for_io, thread_safe],
"{
#ifdef _MSC_VER
/* VC++ runtime fix */
@@ -3827,4 +3887,3 @@
io__error_message(Error) = Msg :-
io__error_message(Error, Msg).
-
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.207
diff -u -b -r1.207 std_util.m
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.3
diff -u -b -r1.3 table_builtin.m
--- library/table_builtin.m 2000/11/23 02:00:17 1.3
+++ library/table_builtin.m 2000/12/04 03:50:02
@@ -316,7 +316,145 @@
:- interface.
+:- import_module io.
+
+ % This procedure should be called exactly once for each I/O action.
+ % If I/O tabling is enabled, this predicate will increment the I/O
+ % action counter, and will check if this action should be tabled.
+ % If not, it fails. If yes, it succeeds, and binds the output
+ % arguments, which are, in order:
+ %
+ % - The root trie node for all I/O actions. This is similar to
+ % the per-procedure tabling pointers, but it is shared by all
+ % I/O actions.
+ % - the I/O action number of this action.
+ % - The I/O action number of the first action in the tabled range.
+ %
+ % After the first tabled action, the root trie node will point to a
+ % (dynamically expandable) array of trie nodes. The trie node for
+ % I/O action number Counter is at offset Counter - Start in this array,
+ % where Start is the I/O action number of the first tabled action.
+ % The three output parameters together specify this location.
+
+:- impure pred table_io_in_range(ml_table::out, int::out, int::out) is semidet.
+
+ % This procedure should be called exactly once for each I/O action
+ % for which table_io_in_range returns true. Given the trie node
+ % for a given I/O action number, it returns true iff that action has
+ % been carried out before (i.e. the action is now being reexecuted
+ % after a retry command in the debugger).
+
+:- impure pred table_io_has_occurred(ml_table::in) is semidet.
+
+ % This predicate simply copies the input I/O state to become the output
+ % I/O state. It is used only because it is easier to get the insts
+ % right by calling this procedure than by hand-writing insts for a
+ % unification.
+
+:- pred table_io_copy_io_state(io__state::di, io__state::uo) is det.
+
+ % N.B. interface continued below
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+% For purposes of I/O tabling, we divide the program's execution into four
+% phases.
%
+% Phase UNINIT consists of Mercury code executed prior to the first debugger
+% event. Even if main/2 is traced, this will include the initialization of the
+% I/O system itself. During this phase, MR_io_tabling_enabled will be FALSE.
+%
+% Phase BEFORE consists of Mercury code during whose execution the user does
+% not need safe retry across I/O, probably because he/she does not require
+% retry at all. During this phase, MR_io_tabling_enabled will be TRUE while
+% we ensure that table_io_range returns FALSE by setting MR_io_tabling_start
+% to the highest possible value.
+%
+% Phase DURING consists of Mercury code during whose execution the user does
+% need safe retry across I/O. During this phase, MR_io_tabling_enabled will be
+% TRUE, and MR_io_tabling_start will be set to the value of
+% MR_io_tabling_counter on entry to phase DURING. We will ensure that
+% table_io_in_range returns TRUE by setting MR_io_tabling_end to the highest
+% possible value.
+%
+% Phase AFTER again consists of Mercury code during whose execution the user
+% does not need safe retry across I/O. During this phase, MR_io_tabling_enabled
+% will be TRUE, MR_io_tabling_start will contain the value of
+% MR_io_tabling_counter at the time of the entry to phase DURING, while
+% MR_io_tabling_end will contain the value of MR_io_tabling_counter at the end
+% of phase DURING, thus ensuring that table_io_in_range again returns FALSE.
+%
+% The transition from phase UNINIT to phase BEFORE will occur during the
+% initialization of the debugger, at the first trace event.
+%
+% The transition from phase BEFORE to phase DURING will occur when the user
+% issues the "table_io start" command, while the transition from phase DURING
+% to phase AFTER will occur when the user issues the "table_io end" command.
+% The user may automate entry into phase DURING by putting "table_io start"
+% into a .mdbrc file. Of course the program will never enter phase DURING or
+% phase AFTER if the user never gives the commands that start those phases.
+%
+% The debugger itself invokes Mercury code e.g. to print the values of
+% variables. During such calls it will set MR_io_tabling_enabled to FALSE,
+% since the I/O actions executed during such times do not belong to the user
+% program.
+
+:- pragma c_code(table_io_in_range(T::out, Counter::out, Start::out),
+ [will_not_call_mercury],
+"
+ if (MR_io_tabling_enabled) {
+ MR_io_tabling_counter++;
+
+ if (MR_io_tabling_start < MR_io_tabling_counter
+ && MR_io_tabling_counter <= MR_io_tabling_end)
+ {
+ T = (MR_Word) &MR_io_tabling_pointer;
+ Counter = MR_io_tabling_counter;
+ Start = MR_io_tabling_start;
+ if (MR_io_tabling_counter > MR_io_tabling_counter_hwm)
+ {
+ MR_io_tabling_counter_hwm =
+ MR_io_tabling_counter;
+ }
+
+ SUCCESS_INDICATOR = TRUE;
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+").
+
+:- pragma c_code(table_io_has_occurred(T::in),
+ [will_not_call_mercury],
+"
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking %p for previous execution: %p\\n"",
+ table, &table->MR_answerblock);
+ }
+#endif
+ SUCCESS_INDICATOR = (table->MR_answerblock != NULL);
+").
+
+:- pragma c_code(table_io_copy_io_state(S0::di, S::uo),
+ [will_not_call_mercury],
+"
+ S = S0;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+%
% Predicates that manage the tabling of model_non subgoals.
%
@@ -652,6 +790,7 @@
#endif
")
).
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -667,10 +806,15 @@
% is a pointer to the leaf of the trie reached by the lookup. From the
% returned leaf another trie may be connected.
%
+
% Lookup or insert an integer in the given table.
:- impure pred table_lookup_insert_int(ml_table::in, int::in, ml_table::out)
is det.
+ % Lookup or insert an integer in the given table.
+:- impure pred table_lookup_insert_start_int(ml_table::in, int::in, int::in,
+ ml_table::out) is det.
+
% Lookup or insert a character in the given trie.
:- impure pred table_lookup_insert_char(ml_table::in, character::in,
ml_table::out) is det.
@@ -715,6 +859,10 @@
:- impure pred table_save_float_ans(ml_answer_block::in, int::in, float::in)
is det.
+ % Save an I/O state in the given answer block at the given offset.
+:- impure pred table_save_io_state_ans(ml_answer_block::in, int::in,
+ io__state::ui) is det.
+
% Save any type of answer in the given answer block at the given
% offset.
:- impure pred table_save_any_ans(ml_answer_block::in, int::in, T::in) is det.
@@ -739,6 +887,10 @@
:- semipure pred table_restore_float_ans(ml_answer_block::in, int::in,
float::out) is det.
+ % Restore an I/O state from the given answer block at the given offset.
+:- semipure pred table_restore_io_state_ans(ml_answer_block::in, int::in,
+ io__state::uo) is det.
+
% Restore any type of answer from the given answer block at the
% given offset.
:- semipure pred table_restore_any_ans(ml_answer_block::in, int::in, T::out)
@@ -786,6 +938,16 @@
T = (MR_Word) table;
").
+:- pragma c_code(table_lookup_insert_start_int(T0::in, S::in, I::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_START_INT(table, table0,
+ (MR_Integer) S, (MR_Integer) I);
+ T = (MR_Word) table;
+").
+
:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -883,6 +1045,15 @@
#endif
").
+:- pragma c_code(table_save_io_state_ans(T::in, Offset::in, S::ui),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, (MR_Word) S,
+ &mercury_data_io__type_ctor_info_state_0);
+").
+
:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -925,6 +1096,14 @@
#else
F = MR_word_to_float(MR_TABLE_GET_ANSWER(table, Offset));
#endif
+").
+
+:- pragma c_code(table_restore_io_state_ans(T::in, Offset::in, V::uo),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ V = (MR_Word) MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.44
diff -u -b -r1.44 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 2000/11/23 02:00:38 1.44
+++ runtime/mercury_stack_layout.h 2000/11/27 23:59:45
@@ -345,7 +345,8 @@
MR_EVAL_METHOD_NORMAL,
MR_EVAL_METHOD_LOOP_CHECK,
MR_EVAL_METHOD_MEMO,
- MR_EVAL_METHOD_MINIMAL
+ MR_EVAL_METHOD_MINIMAL,
+ MR_EVAL_METHOD_TABLE_IO
} MR_EvalMethod;
/*
@@ -376,6 +377,7 @@
MR_int_least16_t MR_sle_max_var_num;
MR_int_least16_t MR_sle_max_r_num;
MR_int_least8_t MR_sle_maybe_from_full;
+ MR_int_least8_t MR_sle_maybe_io_seq;
MR_int_least8_t MR_sle_maybe_trail;
MR_int_least8_t MR_sle_maybe_maxfr;
MR_EvalMethodInt MR_sle_eval_method_CAST_ME;
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h 2000/08/03 06:18:59 1.5
+++ runtime/mercury_tabling_macros.h 2000/10/21 12:49:37
@@ -25,6 +25,9 @@
#define MR_RAW_TABLE_ENUM(table, range, value) \
MR_int_fix_index_lookup_or_add((table), (range), (value))
+#define MR_RAW_TABLE_START_INT(table, start, value) \
+ MR_int_start_index_lookup_or_add((table), (start), (value));
+
#define MR_RAW_TABLE_WORD(table, value) \
MR_int_hash_lookup_or_add((table), (value));
@@ -105,6 +108,24 @@
} \
} while (0)
+#define MR_DEBUG_NEW_TABLE_START_INT(table, table0, start, value) \
+ do { \
+ (table) = MR_RAW_TABLE_START_INT((table0), (start), (value));\
+ if (MR_tabledebug) { \
+ printf("TABLE %p: int %d - %d => %p\n", \
+ (table0), (value), (start), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_START_INT(table, start, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_START_INT((table), (start), (value));\
+ if (MR_tabledebug) { \
+ printf("TABLE %p: int %d - %d => %p\n", \
+ prev_table, (value), (start), (table)); \
+ } \
+ } while (0)
+
#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
do { \
(table) = MR_RAW_TABLE_WORD((table0), (value)); \
@@ -260,6 +281,15 @@
#define MR_DEBUG_TABLE_ENUM(table, count, value) \
do { \
(table) = MR_RAW_TABLE_ENUM((table), (count), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_START_INT(table, table0, start, value) \
+ do { \
+ (table) = MR_RAW_TABLE_START_INT((table0), (start), (value));\
+ } while (0)
+#define MR_DEBUG_TABLE_START_INT(table, start, value) \
+ do { \
+ (table) = MR_RAW_TABLE_START_INT((table), (start), (value));\
} while (0)
#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_trace_base.c
--- runtime/mercury_trace_base.c 2000/11/28 04:31:48 1.30
+++ runtime/mercury_trace_base.c 2000/11/28 04:20:02
@@ -83,10 +83,10 @@
/*
** MR_trace_from_full is a boolean that is set before every call;
-** it states whether the caller is being fully traced, or only interface
-** traced. If the called code is interface traced, it will generate
-** call, exit and fail trace events only if MR_trace_from_full is true.
-** (It will never generate internal events.) If the called code is fully
+** it states whether the caller is being deep traced, or only shallow
+** traced. If the called code is shallow traced, it will generate
+** interface trace events only if MR_trace_from_full is true.
+** (It will never generate internal events.) If the called code is deep
** traced, it will always generate all trace events, external and internal,
** regardless of the setting of this variable on entry.
**
@@ -95,6 +95,18 @@
*/
MR_Bool MR_trace_from_full = TRUE;
+
+/*
+** I/O tabling is documented in library/table_builtin.m
+*/
+
+MR_IoTablingPhase MR_io_tabling_phase = MR_IO_TABLING_UNINIT;
+bool MR_io_tabling_enabled = FALSE;
+MR_TableNode MR_io_tabling_pointer = { 0 };
+MR_Unsigned MR_io_tabling_counter = 0;
+MR_Unsigned MR_io_tabling_counter_hwm = 0;
+MR_Unsigned MR_io_tabling_start = 0;
+MR_Unsigned MR_io_tabling_end = 0;
#ifdef MR_TRACE_HISTOGRAM
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.14
diff -u -b -r1.14 mercury_trace_base.h
--- runtime/mercury_trace_base.h 2000/08/03 06:19:00 1.14
+++ runtime/mercury_trace_base.h 2000/11/28 10:05:47
@@ -18,6 +18,7 @@
#include <stdio.h>
#include "mercury_stack_layout.h"
#include "mercury_std.h"
+#include "mercury_tabling.h" /* for MR_TableNode */
/*
** This enum should EXACTLY match the definition of the `trace_port_type'
@@ -48,7 +49,8 @@
#define MR_trace_incr_seq() ((MR_Word) ++MR_trace_call_seqno)
#define MR_trace_incr_depth() ((MR_Word) ++MR_trace_call_depth)
-#define MR_trace_reset_depth(d) (MR_trace_call_depth = (MR_Unsigned) (d))
+#define MR_trace_reset_depth(d) (MR_trace_call_depth = \
+ (MR_Unsigned) (d))
/*
** MR_trace is called from Mercury modules compiled with tracing.
@@ -110,6 +112,48 @@
extern MR_Unsigned MR_trace_event_number;
extern MR_Bool MR_trace_from_full;
+
+/*
+** The details of I/O tabling are documented in library/table_builtin.m.
+*/
+
+typedef enum {
+ /* from program start to first debugger event */
+ MR_IO_TABLING_UNINIT,
+
+ /* from first debugger event to "table_io start" command */
+ MR_IO_TABLING_BEFORE,
+
+ /* from "table_io start" command to "table_io end" command */
+ MR_IO_TABLING_DURING,
+
+ /* from "table_io end" command to program exit */
+ MR_IO_TABLING_AFTER
+} MR_IoTablingPhase;
+
+typedef MR_Unsigned MR_IoActionNum;
+
+#define MR_IO_ACTION_MAX ((MR_IoActionNum) -1)
+
+extern MR_IoTablingPhase MR_io_tabling_phase;
+
+/* True iff I/O tabling is enabled. */
+extern bool MR_io_tabling_enabled;
+
+/* The root of the trie that we use for tabling I/O. */
+extern MR_TableNode MR_io_tabling_pointer;
+
+/* The I/O action number of the last I/O action. */
+extern MR_IoActionNum MR_io_tabling_counter;
+
+/* The highest I/O action number ever reached ("hwm" = "high water mark"). */
+extern MR_IoActionNum MR_io_tabling_counter_hwm;
+
+/* The highest I/O action number which is too early to be tabled. */
+extern MR_IoActionNum MR_io_tabling_start;
+
+/* The highest I/O action number which is to be tabled. */
+extern MR_IoActionNum MR_io_tabling_end;
/*
** These functions will report the number of the last event,
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.45
diff -u -b -r1.45 Mmakefile
--- tests/debugger/Mmakefile 2000/11/01 04:23:02 1.45
+++ tests/debugger/Mmakefile 2000/11/02 01:14:47
@@ -35,7 +35,8 @@
queens \
resume_typeinfos \
retry \
- shallow
+ shallow \
+ tabled_read
# The following tests are disabled, since currently they get some spurious
# failures if readline support is enabled:
@@ -43,6 +44,7 @@
# Note that some of the make rules for interactive are disabled too.
MCFLAGS-shallow = --trace shallow
+MCFLAGS-tabled_read = --trace-table-io
MCFLAGS = --trace deep
MLFLAGS = --trace
C2INITFLAGS = --trace
@@ -200,6 +202,9 @@
shallow.out: shallow shallow.inp
$(MDB) ./shallow < shallow.inp > shallow.out 2>&1
+
+tabled_read.out: tabled_read tabled_read.inp
+ $(MDB) ./tabled_read < tabled_read.inp > tabled_read.out 2>&1
# Note that interactive.out.orig depends on $(interactive.ints) because
# interactive.inp contains interactive queries that require interactive.ints
Index: tests/debugger/tabled_read.data
===================================================================
RCS file: tabled_read.data
diff -N tabled_read.data
--- /dev/null Thu Sep 2 15:00:04 1999
+++ tabled_read.data Mon Dec 4 15:20:21 2000
@@ -0,0 +1,3 @@
+123
+456
+789
Index: tests/debugger/tabled_read.exp
===================================================================
RCS file: tabled_read.exp
diff -N tabled_read.exp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ tabled_read.exp Tue Oct 31 22:23:15 2000
@@ -0,0 +1,34 @@
+ 1: 1 1 CALL pred tabled_read:main/2-0 (det) tabled_read.m:14
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break tabled_read__test
+ 0: + stop interface pred tabled_read:test/5-0 (det)
+mdb> table_io start
+io tabling started
+mdb> continue
+ 3: 2 2 CALL pred tabled_read:test/5-0 (det) tabled_read.m:27 (tabled_read.m:17)
+mdb> finish -n
+ 30: 2 2 EXIT pred tabled_read:test/5-0 (det) tabled_read.m:27 (tabled_read.m:17)
+mdb> print *
+ HeadVar__1 '<<c_pointer>>'
+ HeadVar__2 0
+ HeadVar__3 123
+ HeadVar__5 state('<<c_pointer>>')
+mdb> table_io
+io tabling has started
+mdb> retry
+ 3: 2 2 CALL pred tabled_read:test/5-0 (det) tabled_read.m:27 (tabled_read.m:17)
+mdb> print *
+ HeadVar__1 '<<c_pointer>>'
+ HeadVar__2 0
+ HeadVar__4 state('<<c_pointer>>')
+mdb> finish -n
+ 30: 2 2 EXIT pred tabled_read:test/5-0 (det) tabled_read.m:27 (tabled_read.m:17)
+mdb> print *
+ HeadVar__1 '<<c_pointer>>'
+ HeadVar__2 0
+ HeadVar__3 123
+ HeadVar__5 state('<<c_pointer>>')
+mdb> continue -S
+123
Index: tests/debugger/tabled_read.inp
===================================================================
RCS file: tabled_read.inp
diff -N tabled_read.inp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ tabled_read.inp Mon Dec 4 15:31:24 2000
@@ -0,0 +1,21 @@
+echo on
+register --quiet
+context none
+table_io
+break tabled_read__test
+table_io start
+continue
+finish -n
+print *
+retry
+print *
+finish -n
+print *
+table_io end
+continue
+finish -n
+print *
+retry
+finish -n
+print *
+continue -S
Index: tests/debugger/tabled_read.m
===================================================================
RCS file: tabled_read.m
diff -N tabled_read.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ tabled_read.m Mon Dec 4 15:19:58 2000
@@ -0,0 +1,73 @@
+% We define our own I/O primitives, in case the library was compiled without
+% IO tabling.
+
+:- module tabled_read.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module char, int.
+
+main -->
+ tabled_read__open_input("tabled_read.data", Res, Stream),
+ ( { Res = 0 } ->
+ tabled_read__test(Stream, 0, N),
+ tabled_read__write_int(N),
+ tabled_read__test(Stream, 0, M),
+ tabled_read__write_int(M)
+ ;
+ io__write_string("could not open tabled_read.data\n")
+ ).
+
+:- pred tabled_read__test(c_pointer::in, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read__test(Stream, SoFar, N) -->
+ tabled_read__read_char_code(Stream, CharCode),
+ (
+ { char__to_int(Char, CharCode) },
+ { char__is_digit(Char) },
+ { char__digit_to_int(Char, CharInt) }
+ ->
+ tabled_read__test(Stream, SoFar * 10 + CharInt, N)
+ ;
+ { N = SoFar }
+ ).
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred tabled_read__open_input(string::in, int::out, c_pointer::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma c_code(tabled_read__open_input(FileName::in, Res::out, Stream::out,
+ IO0::di, IO::uo), [will_not_call_mercury, tabled_for_io],
+"
+ Stream = (MR_Word) fopen((const char *) FileName, ""r"");
+ Res = Stream? 0 : -1;
+ IO = IO0;
+").
+
+:- pred tabled_read__read_char_code(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma c_code(tabled_read__read_char_code(Stream::in, CharCode::out,
+ IO0::di, IO::uo), [will_not_call_mercury, tabled_for_io],
+"
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred tabled_read__write_int(int::in, io__state::di, io__state::uo) is det.
+
+:- pragma c_code(tabled_read__write_int(N::in,
+ IO0::di, IO::uo), [may_call_mercury, thread_safe],
+"{
+ printf(""%d\n"", (int) N);
+ IO = IO0;
+}").
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.31
diff -u -b -r1.31 mercury_trace.c
--- trace/mercury_trace.c 2000/11/23 02:01:05 1.31
+++ trace/mercury_trace.c 2000/11/28 00:00:32
@@ -61,19 +61,26 @@
};
MR_Code *MR_trace_real(const MR_Stack_Layout_Label *layout);
-static MR_Code *MR_trace_event(MR_Trace_Cmd_Info *cmd, bool interactive,
+static MR_Code *MR_trace_event(MR_Trace_Cmd_Info *cmd,
+ bool interactive,
const MR_Stack_Layout_Label *layout,
MR_Trace_Port port, MR_Unsigned seqno,
MR_Unsigned depth);
+static bool MR_is_io_state(MR_PseudoTypeInfo pti);
+static MR_Unsigned MR_find_saved_io_counter(
+ const MR_Stack_Layout_Label *call_label,
+ MR_Word *base_sp, MR_Word *base_curfr);
static const MR_Stack_Layout_Label *MR_unwind_stacks_for_retry(
const MR_Stack_Layout_Label *top_layout,
int ancestor_level, MR_Word **base_sp_ptr,
- MR_Word **base_curfr_ptr, MR_Word **base_maxfr_ptr,
+ MR_Word **base_curfr_ptr,
+ MR_Word **base_maxfr_ptr,
const char **problem);
static const char *MR_undo_updates_of_maxfr(const MR_Stack_Layout_Entry
*level_layout, MR_Word *sp, MR_Word *curfr,
MR_Word **maxfr_ptr);
-static MR_Word MR_trace_find_input_arg(const MR_Stack_Layout_Label *label,
+static MR_Word MR_trace_find_input_arg(
+ const MR_Stack_Layout_Label *label,
MR_Word *saved_regs,
MR_Word *base_sp, MR_Word *base_curfr,
MR_uint_least16_t var_num, bool *succeeded);
@@ -458,6 +465,8 @@
int i;
bool succeeded;
MR_Word *saved_regs;
+ bool has_io_state;
+ MR_Unsigned saved_io_state_counter;
#ifdef MR_USE_MINIMAL_MODEL
MR_Retry_Result result;
#endif
@@ -515,6 +524,10 @@
arg_max = 0;
+ has_io_state = FALSE;
+ /* just to prevent uninitialized variable warnings */
+ saved_io_state_counter = 0;
+
for (i = 0; i < MR_all_desc_var_count(input_args); i++) {
arg_value = MR_trace_find_input_arg(return_label_layout,
saved_regs, base_sp, base_curfr,
@@ -522,10 +535,18 @@
&succeeded);
if (! succeeded) {
- *problem = "Cannot perform retry because the values "
- "of some input arguments are missing.";
+ if (MR_is_io_state(MR_var_pti(input_args, i))) {
+ has_io_state = TRUE;
+ saved_io_state_counter =
+ MR_find_saved_io_counter(call_label,
+ base_sp, base_curfr);
+ } else {
+ *problem = "Cannot perform retry because the "
+ "values of some input arguments "
+ "are missing.";
goto report_problem;
}
+ }
if (i < MR_long_desc_var_count(input_args)) {
arg_num = MR_get_register_number_long(
@@ -665,6 +686,10 @@
MR_saved_reg(saved_regs, i) = args[i];
}
+ if (has_io_state) {
+ MR_io_tabling_counter = saved_io_state_counter;
+ }
+
event_info->MR_max_mr_num = max(event_info->MR_max_mr_num, arg_max);
*jumpaddr = level_layout->MR_sle_code_addr;
@@ -697,6 +722,45 @@
return MR_RETRY_ERROR;
}
+static bool
+MR_is_io_state(MR_PseudoTypeInfo pti)
+{
+ MR_TypeCtorInfo type_ctor_info;
+
+ if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti)) {
+ return FALSE;
+ }
+
+ type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti);
+
+ return (streq(type_ctor_info->type_ctor_module_name, "io")
+ && streq(type_ctor_info->type_ctor_name, "state"));
+}
+
+static MR_Unsigned
+MR_find_saved_io_counter(const MR_Stack_Layout_Label *call_label,
+ MR_Word *base_sp, MR_Word *base_curfr)
+{
+ const MR_Stack_Layout_Entry *level_layout;
+ MR_Unsigned saved_io_counter;
+
+ level_layout = call_label->MR_sll_entry;
+ if (level_layout->MR_sle_maybe_io_seq <= 0) {
+ MR_fatal_error("MR_trace_retry: "
+ "missing io seq number slot");
+ }
+
+ if (MR_DETISM_DET_STACK(level_layout->MR_sle_detism)) {
+ saved_io_counter = MR_based_stackvar(base_sp,
+ level_layout->MR_sle_maybe_io_seq);
+ } else {
+ saved_io_counter = MR_based_framevar(base_curfr,
+ level_layout->MR_sle_maybe_io_seq);
+ }
+
+ return saved_io_counter;
+}
+
/*
** This function figures out the state of the stacks (i.e. the values of sp,
** curfr and maxfr) just after entry to the procedure specified by the given
@@ -1090,6 +1154,9 @@
** not here.
*/
+ return;
+
+ case MR_EVAL_METHOD_TABLE_IO:
return;
}
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.88
diff -u -b -r1.88 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2000/11/25 10:42:07 1.88
+++ trace/mercury_trace_internal.c 2000/12/04 04:24:07
@@ -155,6 +155,8 @@
static MR_Next MR_trace_handle_cmd(char **words, int word_count,
MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
MR_Event_Details *event_details, MR_Code **jumpaddr);
+static void MR_print_unsigned_var(FILE *fp, const char *var,
+ MR_Unsigned value);
static bool MR_parse_source_locn(char *word, const char **file, int *line);
static bool MR_trace_options_strict_print(MR_Trace_Cmd_Info *cmd,
char ***words, int *word_count,
@@ -208,6 +210,8 @@
static bool MR_trace_valid_command(const char *word);
+bool MR_saved_io_tabling_enabled;
+
MR_Code *
MR_trace_event_internal(MR_Trace_Cmd_Info *cmd, bool interactive,
MR_Event_Info *event_info)
@@ -231,12 +235,15 @@
/*
** We want to make sure that the Mercury code used to implement some
** of the debugger's commands (a) doesn't generate any trace events,
- ** and (b) doesn't generate any unwanted debugging output.
+ ** (b) doesn't generate any unwanted debugging output, and (c) doesn't
+ ** do any I/O tabling.
*/
MR_trace_enabled = FALSE;
saved_tabledebug = MR_tabledebug;
MR_tabledebug = FALSE;
+ MR_saved_io_tabling_enabled = MR_io_tabling_enabled;
+ MR_io_tabling_enabled = FALSE;
MR_trace_internal_ensure_init();
@@ -276,6 +283,7 @@
MR_scroll_next = 0;
MR_trace_enabled = TRUE;
MR_tabledebug = saved_tabledebug;
+ MR_io_tabling_enabled = MR_saved_io_tabling_enabled;
return jumpaddr;
}
@@ -332,6 +340,11 @@
MR_trace_internal_init_from_local();
MR_trace_internal_init_from_home_dir();
+ MR_saved_io_tabling_enabled = TRUE;
+ MR_io_tabling_phase = MR_IO_TABLING_BEFORE;
+ MR_io_tabling_start = MR_IO_ACTION_MAX;
+ MR_io_tabling_end = MR_IO_ACTION_MAX;
+
MR_trace_internal_initialized = TRUE;
}
}
@@ -1050,7 +1063,7 @@
; /* the usage message has already been printed */
} else if (word_count == 1) {
const char *msg;
- do_init_modules();
+ MR_do_init_modules();
msg = MR_dump_stack_from_layout(MR_mdb_out, layout,
MR_saved_sp(saved_regs),
MR_saved_curfr(saved_regs),
@@ -1820,7 +1833,7 @@
#endif /* MR_TRACE_HISTOGRAM */
} else if (streq(words[0], "nondet_stack")) {
if (word_count == 1) {
- do_init_modules();
+ MR_do_init_modules();
MR_dump_nondet_stack_from_layout(MR_mdb_out,
MR_saved_maxfr(saved_regs));
} else {
@@ -1831,7 +1844,7 @@
if (word_count == 1) {
bool saved_tabledebug;
- do_init_modules();
+ MR_do_init_modules();
saved_tabledebug = MR_tabledebug;
MR_tabledebug = TRUE;
MR_print_gen_stack(MR_mdb_out);
@@ -1856,6 +1869,74 @@
} else {
MR_trace_usage("developer", "all_regs");
}
+ } else if (streq(words[0], "table_io")) {
+ if (word_count == 1) {
+ if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has not yet started\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has started\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has finished\n");
+ } else {
+ MR_fatal_error(
+ "io tabling in impossible phase\n");
+ }
+ } else if (word_count == 2 && streq(words[1], "start")) {
+ if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
+ MR_io_tabling_phase = MR_IO_TABLING_DURING;
+ MR_io_tabling_start = MR_io_tabling_counter;
+ MR_io_tabling_end = MR_IO_ACTION_MAX;
+ fprintf(MR_mdb_out, "io tabling started\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has already started\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has already ended\n");
+ } else {
+ MR_fatal_error(
+ "io tabling in impossible phase\n");
+ }
+ } else if (word_count == 2 && streq(words[1], "end")) {
+ if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has not yet started\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING)
+ {
+ MR_io_tabling_phase = MR_IO_TABLING_AFTER;
+ MR_io_tabling_end = MR_io_tabling_counter_hwm;
+ fprintf(MR_mdb_out, "io tabling ended\n");
+ } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER)
+ {
+ fprintf(MR_mdb_out,
+ "io tabling has already ended\n");
+ } else {
+ MR_fatal_error(
+ "io tabling in impossible phase\n");
+ }
+ } else if (word_count == 2 && streq(words[1], "stats")) {
+ fprintf(MR_mdb_out, "phase = %d\n",
+ MR_io_tabling_phase);
+ MR_print_unsigned_var(MR_mdb_out, "counter",
+ MR_io_tabling_counter);
+ MR_print_unsigned_var(MR_mdb_out, "hwm",
+ MR_io_tabling_counter_hwm);
+ MR_print_unsigned_var(MR_mdb_out, "start",
+ MR_io_tabling_start);
+ MR_print_unsigned_var(MR_mdb_out, "end",
+ MR_io_tabling_end);
+ } else {
+ MR_trace_usage("developer", "table_io");
+ }
} else if (streq(words[0], "source")) {
bool ignore_errors;
@@ -2002,6 +2083,12 @@
return KEEP_INTERACTING;
}
+static void
+MR_print_unsigned_var(FILE *fp, const char *var, MR_Unsigned value)
+{
+ fprintf(fp, "%s = %" MR_INTEGER_LENGTH_MODIFIER "u\n", var, value);
+}
+
static bool
MR_parse_source_locn(char *word, const char **file, int *line)
{
@@ -2945,6 +3032,7 @@
#endif
{ "developer", "stack_regs" },
{ "developer", "all_regs" },
+ { "developer", "table_io" },
{ "misc", "source" },
{ "misc", "save" },
{ "misc", "quit" },
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list