[m-dev.] for review: retry across I/O
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Nov 6 16:17:04 AEDT 2000
For review by Mark and/or Fergus. Note that this is still work in progress,
and things that are likely to change are not as polished as they should be yet.
OTOH, they should not impact regular users either.
Add tabling of I/O actions for the debugger.
compiler/options.m:
Add a new option, --trace-table-io, that enables the tabling of I/O
actions, and another, --trace-table-io-states, that governs whether the
tabling includes the I/O state variables themselves. (You want to table
these variables iff they contain meaningful information that is not
stored in global variables.) These options are for developers only
for now.
compiler/modules.m:
Implicitly import table_builtin if --trace-table-io is specified.
compiler/prog_data.m:
Add eval_table_io as a new eval method.
compiler/hlds_pred.m:
Add a mechanism for checking whether a predicate has a pair of
io__state args.
Extend the tables indexed by eval_method to handle eval_table_io.
compiler/hlds_out.m:
Print the eval method in HLDS dumps.
compiler/table_gen.m:
If a procedure has a pair of I/O state args and is defined using pragma
C code that has the tabled_for_io marker, then perform I/O tabling on
it and mark it as tabled.
compiler/notes/compiler_design.m:
Document that table_gen.m can now change the evaluation methods of
procedures (to eval_table_io).
compiler/stack_layout.m:
runtime/mercury_stack_layout.h:
Add an extra field to proc layouts. If debugging is enabled and a
procedure has I/O state arguments, this field gives the number of the
stack slot which will be filled with the I/O action counter at the
time of the call, so that on retry the debugger can reset the I/O
action counter to this value.
compiler/trace.m:
Add code to reserve and fill this stack slot.
Make the order of fields in the trace_slots structure match the order
in proc layouts.
compiler/code_info.m:
compiler/live_vars.m:
Pass a module_info to trace__setup and trace__reserved_slots.
library/io.m:
Mark the relevant procedures with the tabled_for_io feature.
Standardize the formatting of predicates defined by pragma C codes.
library/table_builtin.m:
Define the predicates that perform I/O tabling, to which calls are
inserted in I/O tabled predicates. These depend on knowing what the
maximum MR_Unsigned value is.
configure.in:
runtime/mercury_conf.h.in:
Detect the proper value of two new macros, MR_{INTEGER,UNSIGNED}_MAX.
library/table_builtin.m:
runtime/mercury_tabling_macros.h:
Table nodes implementing a simple kind of trie, which can also be
viewed as a hash table with the hash function hash(n) = hash - start
were already supported by mercury_tabling.c. They are used to
implement I/O tabling, since I/O the tabled action numbers form a
contiguous sequence. Now allow that functionality to be accessed
from the library through macros.
runtime/mercury_wrapper.[ch]:
Add the global variables required by I/O tabling.
trace/mercury_trace.c:
Implement retry across I/O by resetting the I/O counter to the value
it had on entry to the retried call.
trace/mercury_trace_internal.c:
Add commands to start and stop I/O tabling. For now, they are for use
by developers only and are undocumented; I expect they will change
significantly before being let loose on users.
tests/debugger/tabled_read.{m,inp,exp,data}:
A new test case to check retry across tabled I/O.
tests/debugger/Mmakefile:
Enable the new test case.
Zoltan.
cvs diff: Diffing .
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.230
diff -u -b -r1.230 configure.in
--- configure.in 2000/10/20 10:23:45 1.230
+++ configure.in 2000/10/30 10:53:19
@@ -844,10 +844,81 @@
if test "$mercury_cv_word_type" = int; then
AC_DEFINE_UNQUOTED(MR_INTEGER_LENGTH_MODIFIER, "")
+ AC_DEFINE_UNQUOTED(MR_INTEGER_MAX, INT_MAX)
+ AC_DEFINE_UNQUOTED(MR_UNSIGNED_MAX, UINT_MAX)
elif test "$mercury_cv_word_type" = long; then
AC_DEFINE_UNQUOTED(MR_INTEGER_LENGTH_MODIFIER, "l")
+ AC_DEFINE_UNQUOTED(MR_INTEGER_MAX, LONG_MAX)
+ AC_DEFINE_UNQUOTED(MR_UNSIGNED_MAX, ULONG_MAX)
elif test "$mercury_cv_word_type" = "long long"; then
AC_DEFINE_UNQUOTED(MR_INTEGER_LENGTH_MODIFIER, "ll")
+ AC_TRY_RUN([
+ #include <stdio.h>
+
+ extern void signed_size(FILE *fp);
+ extern void unsigned_size(FILE *fp);
+
+ int main(void)
+ {
+ FILE *fp;
+
+ fp = fopen("conftest.intmax", "w");
+ if (fp == NULL)
+ return 1;
+ signed_size(fp);
+
+ fp = fopen("conftest.uintmax", "w");
+ if (fp == NULL)
+ return 1;
+ unsigned_size(fp);
+
+ return 0;
+ }
+
+ void signed_size(FILE *fp)
+ {
+ long long cur, prev;
+
+ cur = 1;
+ prev = 0;
+
+ while (cur > prev) {
+ prev = cur;
+ cur = (cur << 1) + 1;
+ }
+
+ fprintf(fp, "%lld\n", prev);
+ }
+
+ void unsigned_size(FILE *fp)
+ {
+ long long unsigned cur, prev;
+
+ cur = 1;
+ prev = 0;
+
+ while (cur > prev) {
+ prev = cur;
+ cur = (cur << 1) + 1;
+ }
+
+ fprintf(fp, "%llu\n", prev);
+ }
+ }],
+ [mercury_cv_int_max=`cat conftest.intmax` ;
+ mercury_cv_uint_max=`cat conftest.uintmax`],
+ [mercury_cv_int_max=unknown ; mercury_cv_uint_max=unknown],
+ [mercury_cv_int_max=unknown ; mercury_cv_uint_max=unknown])
+ if test "$mercury_cv_int_max" = "unknown"; then
+ AC_MSG_ERROR("Cannot determine the maximum MR_Integer value.")
+ else
+ AC_DEFINE_UNQUOTED(MR_INTEGER_MAX, LONG_MAX)
+ fi
+ if test "$mercury_cv_uint_max" = "unknown"; then
+ AC_MSG_ERROR("Cannot determine the maximum MR_Unsigned value.")
+ else
+ AC_DEFINE_UNQUOTED(MR_UNSIGNED_MAX, ULONG_MAX)
+ fi
else
AC_MSG_ERROR("Cannot determine the length modifier for the MR_Integer type.")
fi
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.257
diff -u -b -r1.257 code_info.m
--- compiler/code_info.m 2000/10/13 04:04:14 1.257
+++ compiler/code_info.m 2000/10/13 04:55:31
@@ -388,7 +388,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,
@@ -418,21 +418,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.249
diff -u -b -r1.249 hlds_out.m
--- compiler/hlds_out.m 2000/11/03 03:11:45 1.249
+++ compiler/hlds_out.m 2000/11/06 01:49:32
@@ -134,6 +134,9 @@
:- pred hlds_out__write_code_model(code_model, io__state, io__state).
:- mode hlds_out__write_code_model(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.
@@ -288,7 +291,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).
@@ -2869,6 +2873,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 },
@@ -2917,6 +2922,10 @@
io__write_string("% address is not taken\n")
),
+ 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),
@@ -3051,6 +3060,17 @@
io__write_string("model_semi").
hlds_out__write_code_model(model_non) -->
io__write_string("model_non").
+
+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.86
diff -u -b -r1.86 hlds_pred.m
--- compiler/hlds_pred.m 2000/11/03 03:11:47 1.86
+++ compiler/hlds_pred.m 2000/11/06 01:49:32
@@ -1505,6 +1505,18 @@
% 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 pair of io:state arguments, return the index
+ % of those arguments. The first output argument gives the index of the
+ % input state, the second 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_args(module_info::in, proc_info::in,
+ int::out, int::out) is semidet.
+
:- implementation.
:- type proc_info
@@ -1988,6 +2000,74 @@
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_args(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_args_2(HeadVarsModes, ModuleInfo, VarTypes,
+ 1, no, no, MaybeIn, MaybeOut),
+ ( MaybeIn = yes(In), MaybeOut = yes(Out) ->
+ InArgNum = In,
+ OutArgNum = Out
+ ; MaybeIn = no, MaybeOut = no ->
+ fail
+ ;
+ % We must be processing the automatically generated index
+ % procedure for the io_state type. Since this predicate
+ % should never be called, any transformation meant for
+ % procedures with io:states would be inappropriate.
+ fail
+ ).
+
+:- pred proc_info_has_io_state_args_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 det.
+
+proc_info_has_io_state_args_2([], _, _, _,
+ MaybeIn, MaybeOut, MaybeIn, MaybeOut).
+proc_info_has_io_state_args_2([Var - Mode | VarModes], ModuleInfo, VarTypes,
+ ArgNum, MaybeIn0, MaybeOut0, MaybeIn, MaybeOut) :-
+ (
+ map__lookup(VarTypes, Var, VarType),
+ type_to_type_id(VarType, TypeCtor, []),
+ type_util__type_id_module(ModuleInfo, TypeCtor,
+ unqualified("io")),
+ type_util__type_id_name(ModuleInfo, TypeCtor, "state"),
+ type_util__type_id_arity(ModuleInfo, TypeCtor, 0)
+ ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
+ ( MaybeIn0 = no ->
+ MaybeIn1 = yes(ArgNum),
+ MaybeOut1 = MaybeOut0
+ ;
+ % We must be processing the automatically
+ % generated unification or comparison procedure
+ % for the io_state type. Since these predicates
+ % should never be called, any transformation
+ % meant for procedures with io:states would
+ % be inappropriate. We therefore effectively
+ % forget both io:state arguments.
+ MaybeIn1 = no,
+ MaybeOut1 = MaybeOut0
+ )
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
+ require(unify(MaybeOut0, no),
+ "proc_info_has_io_state_args_2: two io:state outputs"),
+ MaybeOut1 = yes(ArgNum),
+ MaybeIn1 = MaybeIn0
+ ;
+ error("proc_info_has_io_state_args_2: bad io:state mode")
+ )
+ ;
+ MaybeIn1 = MaybeIn0,
+ MaybeOut1 = MaybeOut0
+ ),
+ proc_info_has_io_state_args_2(VarModes, ModuleInfo, VarTypes,
+ ArgNum + 1, MaybeIn1, MaybeOut1, MaybeIn, MaybeOut).
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -2077,7 +2157,6 @@
).
%-----------------------------------------------------------------------------%
-
% Predicates to deal with record syntax.
:- interface.
@@ -2277,7 +2356,7 @@
% the given code model.
:- pred valid_code_model_for_eval_method(eval_method, code_model).
:- mode valid_code_model_for_eval_method(in, in) is semidet.
-:- mode valid_code_model_for_eval_method(in, out) is multidet.
+:- mode valid_code_model_for_eval_method(in, out) is multi.
% Convert an evaluation method to a string.
:- pred eval_method_to_string(eval_method, string).
@@ -2323,41 +2402,49 @@
valid_code_model_for_eval_method(eval_loop_check, model_det).
valid_code_model_for_eval_method(eval_loop_check, model_semi).
valid_code_model_for_eval_method(eval_loop_check, model_non).
+valid_code_model_for_eval_method(eval_table_io, model_det).
valid_code_model_for_eval_method(eval_minimal, model_semi).
valid_code_model_for_eval_method(eval_minimal, model_non).
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.93
diff -u -b -r1.93 live_vars.m
--- compiler/live_vars.m 2000/10/13 04:04:47 1.93
+++ compiler/live_vars.m 2000/10/13 05:46:54
@@ -64,7 +64,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.136
diff -u -b -r1.136 modules.m
--- compiler/modules.m 2000/11/01 05:12:05 1.136
+++ compiler/modules.m 2000/11/02 01:14:03
@@ -1407,7 +1407,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),
@@ -1416,10 +1416,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.296
diff -u -b -r1.296 options.m
--- compiler/options.m 2000/11/03 06:12:20 1.296
+++ compiler/options.m 2000/11/06 01:49:35
@@ -97,6 +97,8 @@
; assume_gmake
; trace
; trace_optimized
+ ; trace_table_io
+ ; trace_table_io_states
; suppress_trace
; stack_trace_higher_order
; generate_bytecode
@@ -486,6 +488,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),
@@ -875,6 +879,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).
@@ -1678,6 +1684,9 @@
% "\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.",
"--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.61
diff -u -b -r1.61 prog_data.m
--- compiler/prog_data.m 2000/11/01 05:12:10 1.61
+++ compiler/prog_data.m 2000/11/02 01:14:04
@@ -280,6 +280,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.56
diff -u -b -r1.56 stack_layout.m
--- compiler/stack_layout.m 2000/10/16 01:33:37 1.56
+++ compiler/stack_layout.m 2000/10/16 02:12:22
@@ -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
@@ -841,8 +846,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))),
@@ -851,6 +856,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)))
;
@@ -873,12 +883,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)
}
;
@@ -893,7 +903,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.25
diff -u -b -r1.25 table_gen.m
--- compiler/table_gen.m 2000/10/13 13:55:59 1.25
+++ compiler/table_gen.m 2000/11/06 03:19:29
@@ -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,54 @@
% 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 that have
+% tabled_for_io:
+%
+% :- 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)
+% impure table_restore_any_ans(T, 1, S)
+% else
+% (
+% %
+% % Call original procedure
+% %
+% ),
+% % Save the answers in the table.
+% impure table_io_create_ans_block(T, 2, AB),
+% impure table_save_string_ans(AB, 0, B)
+% impure table_save_any_ans(AB, 1, S)
+% )
+% else
+% %
+% % Call original procedure
+% %
+% ).
+%
+% For I/O primitives that have not_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
+% the 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.
+%
%-----------------------------------------------------------------------------%
:- module table_gen.
@@ -201,8 +246,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),
@@ -218,14 +263,30 @@
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_args(Module0, ProcInfo0,
+ _InArgNum, _OutArgNum),
+ 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
),
@@ -250,27 +311,39 @@
proc_info_goal(ProcInfo0, OrigGoal),
proc_info_argmodes(ProcInfo0, ArgModes),
+ ( EvalMethod = eval_table_io ->
+ require(unify(CodeModel, model_det),
+ "tabled io proc not det"),
+ 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),
@@ -285,10 +358,13 @@
% 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),
+ % RecomputeAtomic = no,
+ % recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo5, ProcInfo,
+ % Module1, Module2),
+ ProcInfo = ProcInfo5,
+ Module2 = Module1,
+
pred_info_procedures(PredInfo1, ProcTable1),
map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
@@ -299,6 +375,145 @@
%-----------------------------------------------------------------------------%
%
+ % 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(Module, 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(Module, VarTypes), InputVars,
+ IoStateAssignFromVars, _SavedInputVars),
+ (
+ TableIoStates = yes,
+ RestoreAnsGoal = RestoreAnsGoal0
+ ;
+ TableIoStates = no,
+ (
+ IoStateAssignFromVars = [IoStateAssignFromVarPrime],
+ IoStateAssignToVars = [IoStateAssignToVarPrime]
+ ->
+ IoStateAssignFromVar = IoStateAssignFromVarPrime,
+ IoStateAssignToVar = IoStateAssignToVarPrime
+ ;
+ 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,
@@ -328,13 +543,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 ->
@@ -360,9 +575,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],
@@ -431,8 +646,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,
@@ -440,12 +655,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),
@@ -465,9 +680,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],
@@ -494,10 +709,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]),
@@ -598,22 +813,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),
@@ -683,6 +898,23 @@
%-----------------------------------------------------------------------------%
+:- pred table_gen__var_is_io_state(module_info::in, map(prog_var, type)::in,
+ prog_var::in) is semidet.
+
+table_gen__var_is_io_state(ModuleInfo, VarTypes, Var) :-
+ map__lookup(VarTypes, Var, VarType),
+ table_gen__type_is_io_state(ModuleInfo, VarType).
+
+:- pred table_gen__type_is_io_state(module_info::in, (type)::in) is semidet.
+
+table_gen__type_is_io_state(ModuleInfo, Type) :-
+ type_to_type_id(Type, TypeCtor, []),
+ type_util__type_id_module(ModuleInfo, TypeCtor, unqualified("io")),
+ type_util__type_id_name(ModuleInfo, TypeCtor, "state"),
+ type_util__type_id_arity(ModuleInfo, TypeCtor, 0).
+
+%-----------------------------------------------------------------------------%
+
:- 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,
@@ -707,13 +939,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),
@@ -732,7 +962,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,
@@ -741,7 +970,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),
@@ -812,7 +1041,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),
@@ -847,7 +1076,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),
@@ -859,7 +1088,7 @@
LookupPredName),
generate_call(LookupPredName,
[TableVar, ArgVar, NextTableVar],
- det, impure, InstMapAL, Module, Context,
+ det, yes(impure), InstMapAL, Module, Context,
Goal),
VarTypes = VarTypes1,
VarSet = VarSet1,
@@ -890,7 +1119,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),
@@ -912,7 +1142,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
).
@@ -928,18 +1158,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),
@@ -948,7 +1178,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),
@@ -1007,16 +1237,22 @@
VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
Goal) :-
table_info_get_module_info(TableInfo0, Module),
- (
- not_builtin_type(TypeCat)
- ->
+ ( table_gen__type_is_io_state(Module, 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,
@@ -1026,7 +1262,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,
@@ -1072,7 +1308,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,
@@ -1115,19 +1351,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)
- ->
+ ( table_gen__type_is_io_state(Module, 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).
%-----------------------------------------------------------------------------%
@@ -1142,7 +1379,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,
@@ -1181,7 +1418,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),
@@ -1203,10 +1440,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),
@@ -1258,10 +1495,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),
@@ -1309,14 +1553,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]
;
@@ -1328,7 +1568,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.37
diff -u -b -r1.37 trace.m
--- compiler/trace.m 2000/10/13 04:05:17 1.37
+++ compiler/trace.m 2000/10/13 06:21:11
@@ -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,
@@ -281,7 +289,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 the procedure has io state arguments, 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
@@ -330,7 +345,8 @@
% 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),
FixedSlots = trace_level_needs_fixed_slots(TraceLevel),
@@ -359,6 +375,11 @@
;
DeclDebug = 0
),
+ ( proc_info_has_io_state_args(ModuleInfo, ProcInfo, _, _) ->
+ IoSeq = 1
+ ;
+ IoSeq = 0
+ ),
globals__lookup_bool_option(Globals, use_trail, UseTrail),
( UseTrail = yes ->
Trail = 2
@@ -373,8 +394,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,
@@ -385,7 +406,7 @@
)
).
-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) },
@@ -425,18 +446,29 @@
MaybeDeclSlots = no,
NextSlotAfterDecl = NextSlotAfterFromFull
},
+ { proc_info_has_io_state_args(ModuleInfo, ProcInfo, _, _) ->
+ MaybeIoSeqSlot = yes(NextSlotAfterDecl),
+ IoSeqLval = llds__stack_slot_num_to_lval(CodeModel,
+ NextSlotAfterDecl),
+ MaybeIoSeqLval = yes(IoSeqLval),
+ NextSlotAfterIoSeq = NextSlotAfterDecl + 1
+ ;
+ 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) },
{
@@ -461,16 +493,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,
@@ -486,19 +520,32 @@
"\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, " = (Word) (const Word *) &",
LayoutAddrStr, ";"
- ], FillFourSlots),
+ ], FillSlotsUptoRedo),
MaybeLayoutLabel = yes(RedoLayoutLabel)
;
- FillFourSlots = FillThreeSlots,
+ MaybeRedoLabel = no,
+ FillSlotsUptoRedo = FillSlotsUptoIoSeq,
MaybeLayoutLabel = no
),
(
@@ -510,13 +557,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.
@@ -526,12 +573,12 @@
MaybeMaxfrLval = yes(MaxfrLval),
trace__stackref_to_string(MaxfrLval, MaxfrLvalStr),
string__append_list([
- FillSixSlots,
+ FillSlotsUptoTrail,
"\n\t\t", MaxfrLvalStr, " = (Word) MR_maxfr;"
- ], FillCondSlots)
+ ], FillSlotsUptoMaxfr)
;
MaybeMaxfrLval = no,
- FillCondSlots = FillSixSlots
+ FillSlotsUptoMaxfr = FillSlotsUptoTrail
),
(
MaybeFromFullSlot = yes(CallFromFullSlot),
@@ -540,14 +587,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)],
@@ -1000,6 +1047,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.51
diff -u -b -r1.51 compiler_design.html
--- compiler/notes/compiler_design.html 2000/10/14 04:00:35 1.51
+++ compiler/notes/compiler_design.html 2000/11/06 03:24:48
@@ -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/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing library
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.211
diff -u -b -r1.211 io.m
--- library/io.m 2000/11/03 05:01:39 1.211
+++ library/io.m 2000/11/06 03:32:24
@@ -1125,7 +1125,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
").
@@ -1365,7 +1365,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))
@@ -1511,7 +1511,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;
@@ -1539,7 +1539,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;
@@ -1561,7 +1561,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);
}").
@@ -1585,7 +1585,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) && \
@@ -1617,7 +1617,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],
"{
incr_hp_atomic_msg(Buffer,
(Size * sizeof(MR_Char) + sizeof(MR_Word) - 1)
@@ -1628,7 +1628,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;
@@ -1665,7 +1665,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';
@@ -1673,7 +1673,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;
}").
@@ -1684,7 +1684,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;
@@ -2486,7 +2486,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);
").
@@ -2495,7 +2496,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);
").
@@ -2525,13 +2527,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);
@@ -2653,7 +2657,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();
@@ -3107,13 +3113,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)--;
@@ -3126,7 +3134,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) {
@@ -3138,13 +3147,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);
}
@@ -3155,7 +3166,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);
}
@@ -3163,7 +3175,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);
}
@@ -3171,7 +3184,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)
@@ -3182,13 +3196,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);
}
@@ -3196,7 +3212,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);
}
@@ -3219,7 +3236,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;
@@ -3236,7 +3254,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 */
@@ -3254,7 +3273,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);
@@ -3262,7 +3281,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) {
@@ -3275,7 +3294,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);
@@ -3284,7 +3304,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);
@@ -3293,7 +3314,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) {
@@ -3303,14 +3325,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);
@@ -3319,7 +3343,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);
@@ -3334,110 +3359,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);
@@ -3446,33 +3488,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);
@@ -3483,10 +3529,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);
@@ -3494,34 +3539,39 @@
").
:- 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);
").
/* miscellaneous predicates */
-:- pragma c_code(
- io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
- [will_not_call_mercury, thread_safe], "
+:- pragma c_code(io__progname(DefaultProgname::in, PrognameOut::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, tabled_for_io, thread_safe],
+"
if (progname) {
/*
** The silly casting below is needed to avoid
@@ -3541,7 +3591,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);
@@ -3554,20 +3605,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 ) {
/*
@@ -3603,12 +3657,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);
").
@@ -3646,7 +3704,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.
/*
@@ -3678,7 +3737,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, `/',
@@ -3784,7 +3843,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: "",
@@ -3805,7 +3865,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 */
@@ -3835,4 +3895,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.203
diff -u -b -r1.203 std_util.m
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.2
diff -u -b -r1.2 table_builtin.m
--- library/table_builtin.m 2000/10/16 01:33:52 1.2
+++ library/table_builtin.m 2000/11/01 08:16:00
@@ -316,6 +316,112 @@
:- interface.
+:- import_module io.
+
+:- impure pred table_io_in_range(ml_table::out, int::out, int::out) is semidet.
+
+:- impure pred table_io_has_occurred(ml_table::in) is semidet.
+
+:- pred table_io_copy_io_state(io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+% For purposes of I/O tabling, we divide the program's execution into four
+% phases.
+%
+% Phase 0 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 1 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 2 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 2. We will ensure that table_io_in_range returns TRUE by
+% setting MR_io_tabling_end to the highest possible value.
+%
+% Phase 3 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 2, while MR_io_tabling_end will contain the
+% value of MR_io_tabling_counter at the end of phase 2, thus ensuring that
+% table_io_in_range again returns FALSE.
+%
+% The transition from phase 0 to phase 1 will occur during the initialization
+% of the debugger, at the first trace event.
+%
+% The transition from phase 1 to phase 2 will occur when the user issues the
+% "table_io start" command, while the transition from phase 2 to phase 3 will
+% occur when the user issues the "table_io end" command. The user may automate
+% entry into phase 2 by putting "table_io start" into a .mdbrc file. Of course
+% the program will never enter phase 2 or phase 3 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 = (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 +758,7 @@
#endif
")
).
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -667,10 +774,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.
@@ -717,6 +829,11 @@
% Save any type of answer 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.
% Restore an integer answer from the given answer block at the
@@ -741,6 +858,11 @@
% Restore any type of answer 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)
is det.
@@ -786,6 +908,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 +1015,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 +1066,14 @@
#else
F = 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_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.32
diff -u -b -r1.32 mercury_conf.h.in
--- runtime/mercury_conf.h.in 2000/08/17 09:58:06 1.32
+++ runtime/mercury_conf.h.in 2000/10/30 10:54:39
@@ -50,6 +50,13 @@
*/
#undef MR_INTEGER_LENGTH_MODIFIER
+/*
+** MR_INTEGER_MAX: the maximum MR_Integer value.
+** MR_UNSIGNED_MAX: the maximum MR_Unsigned value.
+*/
+#undef MR_INTEGER_MAX
+#undef MR_UNSIGNED_MAX
+
/*
** MR_INT_LEAST64_TYPE:
** This must be a C integral type (e.g. int, long, long long)
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 2000/10/16 03:31:01 1.41
+++ runtime/mercury_stack_layout.h 2000/10/16 03:47:14
@@ -342,7 +342,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;
/*
@@ -373,6 +374,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.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_tabling.h
--- runtime/mercury_tabling.h 2000/10/11 03:00:26 1.23
+++ runtime/mercury_tabling.h 2000/10/22 22:51:00
@@ -65,7 +65,7 @@
** important that all members be the same size; this is why the simple table
** status field is an (unsigned) integer, not an enum.
**
-** The integer field is by generic code that does not know what kind of node
+** The integer field is for generic code that does not know what kind of node
** the node will be; this means initialization. A value of zero means the node
** is uninitialized; this must be true for all members. (Also, see below on
** duplicate detection.)
@@ -86,7 +86,7 @@
** the chain of trie nodes given by the input arguments of the tabled subgoal,
** will be overwritten by a pointer to the answer block containing the output
** arguments when the goal succeeds; the MR_SIMPLETABLE_SUCCEEDED status code
-** is used only when the goal has no outputs, and this no answer block.
+** is used only when the goal has no outputs, and thus no answer block.
** This is why MR_SIMPLETABLE_SUCCEEDED must have the highest value, and
** why code looking at MR_simpletable_status must test for success with
** "table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED".
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.28
diff -u -b -r1.28 mercury_trace_base.c
--- runtime/mercury_trace_base.c 2000/10/16 01:34:03 1.28
+++ runtime/mercury_trace_base.c 2000/10/16 02:12:42
@@ -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.
**
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.76
diff -u -b -r1.76 mercury_wrapper.c
--- runtime/mercury_wrapper.c 2000/11/05 12:04:18 1.76
+++ runtime/mercury_wrapper.c 2000/11/06 01:49:57
@@ -207,11 +207,13 @@
void (*MR_io_print_to_cur_stream)(MR_Word, MR_Word);
void (*MR_io_print_to_stream)(MR_Word, MR_Word, MR_Word);
-void (*MR_DI_output_current_ptr)(MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String,
- MR_String, MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_Word, MR_Word);
+void (*MR_DI_output_current_ptr)(MR_Integer, MR_Integer, MR_Integer,
+ MR_Word, MR_String, MR_String, MR_Integer, MR_Integer,
+ MR_Integer, MR_Word, MR_String, MR_Word, MR_Word);
/* normally ML_DI_output_current (output_current/13) */
-bool (*MR_DI_found_match)(MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_String,
- MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_Word);
+bool (*MR_DI_found_match)(MR_Integer, MR_Integer, MR_Integer, MR_Word,
+ MR_String, MR_String, MR_Integer, MR_Integer, MR_Integer,
+ MR_Word, MR_String, MR_Word);
/* normally ML_DI_found_match (output_current/12) */
void (*MR_DI_read_request_from_socket)(MR_Word, MR_Word *, MR_Integer *);
@@ -229,6 +231,18 @@
void (*MR_address_of_trace_interrupt_handler)(void);
void (*MR_register_module_layout)(const MR_Module_Layout *);
+
+/*
+** These variables are documented in library/table_builtin.m.
+*/
+
+int MR_io_tabling_phase = 0;
+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 USE_GCC_NONLOCAL_GOTOS
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.37
diff -u -b -r1.37 mercury_wrapper.h
--- runtime/mercury_wrapper.h 2000/11/05 12:04:19 1.37
+++ runtime/mercury_wrapper.h 2000/11/06 01:49:57
@@ -153,6 +153,14 @@
*/
extern void (*MR_register_module_layout)(const MR_Module_Layout *);
+extern int MR_io_tabling_phase;
+extern bool MR_io_tabling_enabled;
+extern MR_TableNode MR_io_tabling_pointer;
+extern MR_Unsigned MR_io_tabling_counter;
+extern MR_Unsigned MR_io_tabling_counter_hwm;
+extern MR_Unsigned MR_io_tabling_start;
+extern MR_Unsigned MR_io_tabling_end;
+
extern void do_init_modules(void);
extern void do_init_modules_type_tables(void);
extern void do_init_modules_debugger(void);
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 Tue Oct 31 10:01:46 2000
@@ -0,0 +1 @@
+123
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 Tue Oct 31 10:10:16 2000
@@ -0,0 +1,13 @@
+echo on
+register --quiet
+break tabled_read__test
+table_io start
+continue
+finish -n
+print *
+table_io
+retry
+print *
+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 Wed Oct 25 16:49:30 2000
@@ -0,0 +1,61 @@
+:- 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 -->
+ io__open_input("tabled_read.data", Res),
+ ( { Res = ok(Stream) } ->
+ tabled_read__test(Stream, 0, N),
+ io__write_int(N),
+ io__write_string("\n")
+ ;
+ io__write_string("could not open tabled_read.data\n")
+ ).
+
+:- pred tabled_read__test(io__input_stream::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 }
+ ).
+
+% We define our own version of io__read_char_code, in case the library
+% was compiled without IO tabling.
+
+:- pred tabled_read__read_char_code(io__input_stream::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma c_code(tabled_read__read_char_code(File::in, CharCode::out,
+ IO0::di, IO::uo), [will_not_call_mercury], "
+ extern int mercury_getc(MercuryFile* mf);
+ CharCode = mercury_getc((MercuryFile *) File);
+ IO = IO0;
+").
+
+% % We define our own version of io__write_string, in case the library
+% % was compiled without IO tabling.
+%
+% :- pragma c_code(tabled_read__write_string(Stream::in, Message::in,
+% IO0::di, IO::uo), [may_call_mercury, thread_safe],
+% "{
+% MercuryFile *stream = (MercuryFile *) Stream;
+% mercury_print_string(stream, Message);
+% update_io(IO0, IO);
+% }").
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.30
diff -u -b -r1.30 mercury_trace.c
--- trace/mercury_trace.c 2000/10/16 23:56:07 1.30
+++ trace/mercury_trace.c 2000/10/17 00:01:16
@@ -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);
@@ -457,6 +464,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
@@ -514,6 +523,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,
@@ -521,10 +534,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(
@@ -664,6 +685,10 @@
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;
@@ -696,6 +721,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
@@ -1089,6 +1153,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.86
diff -u -b -r1.86 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2000/11/01 04:03:07 1.86
+++ trace/mercury_trace_internal.c 2000/11/06 03:47:17
@@ -154,6 +154,9 @@
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 void MR_print_unsigned(FILE *fp, 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,
@@ -207,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)
@@ -230,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();
@@ -275,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;
}
@@ -331,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 = 1;
+ MR_io_tabling_start = MR_UNSIGNED_MAX;
+ MR_io_tabling_end = MR_UNSIGNED_MAX;
+
MR_trace_internal_initialized = TRUE;
}
}
@@ -1857,6 +1871,66 @@
} else {
MR_trace_usage("developer", "all_regs");
}
+ } else if (streq(words[0], "table_io")) {
+ if (word_count == 1) {
+ if (MR_io_tabling_phase == 1) {
+ fprintf(MR_mdb_out,
+ "io tabling has not yet started\n");
+ } else if (MR_io_tabling_phase == 2) {
+ fprintf(MR_mdb_out,
+ "io tabling has started\n");
+ } else if (MR_io_tabling_phase == 3) {
+ 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 == 1) {
+ MR_io_tabling_phase = 2;
+ MR_io_tabling_start = MR_io_tabling_counter;
+ MR_io_tabling_end = MR_UNSIGNED_MAX;
+ fprintf(MR_mdb_out, "io tabling started\n");
+ } else if (MR_io_tabling_phase == 2) {
+ fprintf(MR_mdb_out,
+ "io tabling has already started\n");
+ } else if (MR_io_tabling_phase == 3) {
+ 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 == 1) {
+ fprintf(MR_mdb_out,
+ "io tabling has not yet started\n");
+ } else if (MR_io_tabling_phase == 2) {
+ MR_io_tabling_phase = 3;
+ MR_io_tabling_end = MR_io_tabling_counter_hwm;
+ fprintf(MR_mdb_out, "io tabling ended\n");
+ } else if (MR_io_tabling_phase == 3) {
+ 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;
@@ -2003,6 +2077,23 @@
return KEEP_INTERACTING;
}
+static void
+MR_print_unsigned_var(FILE *fp, const char *var, MR_Unsigned value)
+{
+ fprintf(fp, "%s = ", var);
+ MR_print_unsigned(fp, value);
+ fprintf(fp, "\n");
+}
+
+static void
+MR_print_unsigned(FILE *fp, MR_Unsigned value)
+{
+ char buf[20];
+
+ sprintf(buf, "%%%su", MR_INTEGER_LENGTH_MODIFIER);
+ fprintf(fp, buf, value);
+}
+
static bool
MR_parse_source_locn(char *word, const char **file, int *line)
{
@@ -2946,6 +3037,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