[m-rev.] for review: model_non lookup switches
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 24 14:35:33 AEST 2006
For review by anyone. The difference that the new version of frameopt makes
in the generated code can be found in ~zs/tmp/DIFF.{library,compiler}.
Zoltan.
Implement lookup switches in which a switch arm may contain more than one
solution, such as this code here:
p(d, "four", f1, 4.4).
p(e, "five", f2, 5.5).
p(e, "five2", f3(5), 55.5).
p(f, "six", f4("hex"), 6.6).
p(g, "seven", f5(77.7), 7.7).
p(g, "seven2", f1, 777.7).
p(g, "seven3", f2, 7777.7).
Such code occurs frequently in benchmark programs used to evaluate the
performance of tabled logic programming systems.
Change frameopt.m, which previously worked only on det and semidet code,
to also work for nondet code. For predicates such as the one above, frameopt
can now arrange for the predicate's nondet stack frame to be created only
when a switch arm that has more than one solution is selected.
compiler/lookup_switch.m:
Extend the existing code for recognizing and implementing lookup
switches to recognize and implement them even if they are model_non.
compiler/lookup_util.m:
New module containing utility predicates useful for implementing
both lookup switches, and in the future, lookup disjunctions (i.e.
disjunctions that correspond to a nondet arm of a lookup switch).
compiler/ll_backend.m:
Include the new module.
compiler/global_data.m:
Move the job of filling in dummy slots to our caller, in this case
lookup_switch.m.
compiler/frameopt.m:
Generalize the existing code for delaying stack frame creation,
which worked only on predicates that live on the det stack, to work
also on predicates that live on the nondet stack. Without this,
predicates whose bodies are model_non lookup switches would create
a nonstack stack frame before the switch is ever entered, which
is wasteful if the selected switch arm has at most one solution.
Since the structure of model_non predicates is more complex (you can
cause a branch to a label by storing its address in a redoip slot,
you can succeed from the frame without removing the frame), this
required considerable extra work. To make the new code debuggable,
record, for each basic block that needs a stack frame, *why* it
needs that stack frame.
compiler/opt_util.m:
Be more conservative about what refers to the stack. Export some
previously internal functionality for frameopt. Turn some predicates
into functions, and rename them to better reflect their purpose.
compiler/opt_debug.m:
Print much more information about pragma_c and call LLDS instructions.
compiler/prog_data.m:
Add an extra attribute to foreign_procs that says that the code
of the foreign_proc assumes the existence of a stack frame.
This is needed to avoid frameopt optimizing the stack frame away.
compiler/add_pragma.m:
When processing fact tables, we create foreign_procs that assume
the existence of the stack frame, so set the new attribute.
compiler/pragma_c_gen.m:
When processing foreign_procs, transmit the information in the
attribute to the generated LLDS code.
compiler/llds.m:
Rename the function symbols referring to the fixed slots in nondet
stack frames to make them clearer and to avoid overloading function
symbols such as curfr and succip.
Rename the function symbols of the call_model type to avoid overloading
the function symbols of the code_model type.
Add a new field to the c_procedure type giving the code_model of the
procedure, and give names to all the fields.
Describe the stack slots used by lookup switches to the debugger
and native gc.
compiler/options.m:
doc/user_guide.texi:
Add a new option, --debug-opt-pred-name, that does when the existing
--debug-opt-pred-id options does, but taking a user-friendly predicate
name rather than a pred_id as its argument.
compiler/handle_options.m:
Process --debug-opt-pred-name, and make --frameopt-comments imply
--auto-comments, since it is not useful without it.
Reformat some existing comments that were written in the days of
8-space indentation.
compiler/optimize.m:
Implement the new option.
Use the new field of the c_procedure type to try only the version
of frameopt appropriate for the code model of the current procedure.
Do a peephole pass after frameopt, since frameopt can generate code
sequences that peephole can optimize.
Make the mechanism for recording the process of optimizing procedure
bodies more easily usable by including the name of the optimization
that created a given version of the code in the name of the file
that contains that version of the code, and ensuring that all numbers
are two characters long, so that "vi procname*.opt*" looks at the
relevant files in the proper chronological sequence, instead of having
version 11 appear before version 2.
compiler/peephole.m:
Add a new optimization pattern: a "mkframe, goto fail" pair (which
can be generated by frameopt) should be replaced by a simple "goto
redo".
compiler/code_gen.m:
Factor out some common code.
compiler/llds_out.m:
Ensure that C comments nested inside comment(_) LLDS instructions
aren't emitted as nested C comments, since C compilers cannot handle
these.
compiler/code_info.m:
compiler/code_util.m:
compiler/continuation_info.m:
compiler/dupelim.m:
compiler/exprn_aux.m:
compiler/jumpopt.m:
compiler/livemap.m:
compiler/llds_out.m:
compiler/mercury_compile.m:
compiler/middle_rec.m:
compiler/ml_code_gen.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/peephole.m:
compiler/stack_layout.m:
compiler/transform_llds.m:
compiler/var_locn.m:
Conform to the change to prog_data.m, opt_util.m and/or llds.m.
tests/hard_coded/dense_lookup_switch_non.{m,exp}:
New test case to exercise the new algorithm.
tests/hard_coded/Mmakefile:
Enable the new test case.
tests/hard_coded/cycles.m:
Make this test case conform to our coding convention.
cvs diff: Diffing .
cvs diff: Diffing analysis
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/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.30
diff -u -b -r1.30 add_pragma.m
--- compiler/add_pragma.m 20 Apr 2006 05:36:48 -0000 1.30
+++ compiler/add_pragma.m 22 Apr 2006 08:28:55 -0000
@@ -1954,12 +1954,12 @@
fact_table_generate_c_code(SymName, PragmaVars, ProcID, PrimaryProcID,
ProcInfo, ArgTypes, !.ModuleInfo, C_ProcCode, C_ExtraCode, !IO),
- % XXX this should be modified to use nondet pragma c_code.
Attrs0 = default_attributes(c),
set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
set_thread_safe(thread_safe, Attrs1, Attrs2),
% Fact tables procedures should be considered pure.
- set_purity(purity_pure, Attrs2, Attrs),
+ set_purity(purity_pure, Attrs2, Attrs3),
+ add_extra_attribute(refers_to_llds_stack, Attrs3, Attrs),
module_add_pragma_foreign_proc(Attrs, SymName, PredOrFunc, PragmaVars,
ProgVarSet, InstVarSet, ordinary(C_ProcCode, no), Status, Context,
!ModuleInfo, !QualInfo, !IO),
@@ -2114,7 +2114,9 @@
is_applicable_for_current_backend(_CurrentBackend, []) = yes.
is_applicable_for_current_backend(CurrentBackend, [Attr | Attrs]) = Result :-
(
- Attr = max_stack_size(_),
+ ( Attr = max_stack_size(_)
+ ; Attr = refers_to_llds_stack
+ ),
Result = is_applicable_for_current_backend(CurrentBackend, Attrs)
;
Attr = backend(Backend),
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.174
diff -u -b -r1.174 call_gen.m
--- compiler/call_gen.m 29 Mar 2006 08:06:36 -0000 1.174
+++ compiler/call_gen.m 12 Apr 2006 08:18:49 -0000
@@ -372,14 +372,14 @@
code_info.succip_is_used(!CI),
(
CodeModel = model_det,
- CallModel = det
+ CallModel = call_model_det
;
CodeModel = model_semi,
- CallModel = semidet
+ CallModel = call_model_semidet
;
CodeModel = model_non,
code_info.may_use_nondet_tailcall(!.CI, TailCallStatus),
- CallModel = nondet(TailCallStatus),
+ CallModel = call_model_nondet(TailCallStatus),
code_info.set_resume_point_and_frame_to_unknown(!CI)
),
trace.prepare_for_call(!.CI, TraceCode).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.158
diff -u -b -r1.158 code_gen.m
--- compiler/code_gen.m 20 Apr 2006 05:36:49 -0000 1.158
+++ compiler/code_gen.m 20 Apr 2006 05:43:15 -0000
@@ -397,7 +397,7 @@
globals.lookup_bool_option(Globals, generate_bytecode, GenBytecode),
(
% XXX: There is a mass of calls above that the bytecode doesn't need;
- % work out which is and isn't needed and put % inside the else case
+ % work out which is and isn't needed and put inside the else case
% below.
GenBytecode = yes,
% We don't generate bytecode for unify and compare preds.
@@ -406,18 +406,17 @@
% compare predicates, we *assume* their correctness for now
% (perhaps not wisely).
\+ is_unify_or_compare_pred(PredInfo),
- % Don't generate bytecode for procs with foreign code
+ % Don't generate bytecode for procs with foreign code.
goal_has_foreign(Goal) = no
->
- EmptyLabelCounter = counter.init(0),
- bytecode_stub(ModuleInfo, PredId, ProcId,
- BytecodeInstructions),
- Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
- BytecodeInstructions, ProcLabel, EmptyLabelCounter, MayAlterRtti)
+ bytecode_stub(ModuleInfo, PredId, ProcId, ProcInstructions),
+ ProcLabelCounter = counter.init(0)
;
- Proc = c_procedure(Name, Arity, proc(PredId, ProcId),
- Instructions, ProcLabel, LabelCounter, MayAlterRtti)
- ).
+ ProcInstructions = Instructions,
+ ProcLabelCounter = LabelCounter
+ ),
+ Proc = c_procedure(Name, Arity, proc(PredId, ProcId), CodeModel,
+ ProcInstructions, ProcLabel, ProcLabelCounter, MayAlterRtti).
:- pred maybe_set_trace_level(pred_info::in,
module_info::in, module_info::out) is det.
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.319
diff -u -b -r1.319 code_info.m
--- compiler/code_info.m 31 Mar 2006 03:32:09 -0000 1.319
+++ compiler/code_info.m 12 Apr 2006 08:18:08 -0000
@@ -214,8 +214,7 @@
:- pred get_zombies(code_info::in, set(prog_var)::out) is det.
-:- pred set_zombies(set(prog_var)::in,
- code_info::in, code_info::out) is det.
+:- pred set_zombies(set(prog_var)::in, code_info::in, code_info::out) is det.
:- pred get_var_locn_info(code_info::in, var_locn_info::out) is det.
@@ -224,27 +223,22 @@
:- pred get_temps_in_use(code_info::in, set(lval)::out) is det.
-:- pred set_temps_in_use(set(lval)::in,
- code_info::in, code_info::out) is det.
+:- pred set_temps_in_use(set(lval)::in, code_info::in, code_info::out) is det.
:- pred get_fail_info(code_info::in, fail_info::out) is det.
-:- pred set_fail_info(fail_info::in,
- code_info::in, code_info::out) is det.
+:- pred set_fail_info(fail_info::in, code_info::in, code_info::out) is det.
-:- pred set_label_counter(counter::in,
- code_info::in, code_info::out) is det.
+:- pred set_label_counter(counter::in, code_info::in, code_info::out) is det.
-:- pred set_succip_used(bool::in,
- code_info::in, code_info::out) is det.
+:- pred set_succip_used(bool::in, code_info::in, code_info::out) is det.
:- pred set_layout_info(proc_label_layout_info::in,
code_info::in, code_info::out) is det.
:- pred get_max_temp_slot_count(code_info::in, int::out) is det.
-:- pred set_max_temp_slot_count(int::in,
- code_info::in, code_info::out) is det.
+:- pred set_max_temp_slot_count(int::in, code_info::in, code_info::out) is det.
:- pred get_temp_content_map(code_info::in,
map(lval, slot_contents)::out) is det.
@@ -260,8 +254,7 @@
:- pred set_closure_seq_counter(counter::in,
code_info::in, code_info::out) is det.
-:- pred set_created_temp_frame(bool::in,
- code_info::in, code_info::out) is det.
+:- pred set_created_temp_frame(bool::in, code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
@@ -738,8 +731,7 @@
:- pred get_next_label(label::out, code_info::in, code_info::out)
is det.
- % Note that the succip slot is used, and thus cannot be
- % optimized away.
+ % Note that the succip slot is used, and thus cannot be optimized away.
%
:- pred succip_is_used(code_info::in, code_info::out) is det.
@@ -761,9 +753,8 @@
:- pred add_scalar_static_cell_natural_types(list(rval)::in,
data_addr::out, code_info::in, code_info::out) is det.
-:- pred add_vector_static_cell(list(llds_type)::in,
- list(maybe(list(rval)))::in, data_addr::out,
- code_info::in, code_info::out) is det.
+:- pred add_vector_static_cell(list(llds_type)::in, list(list(rval))::in,
+ data_addr::out, code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
@@ -1245,9 +1236,8 @@
%
:- type ite_hijack_info.
-:- pred prepare_for_ite_hijack(code_model::in,
- ite_hijack_info::out, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred prepare_for_ite_hijack(code_model::in, ite_hijack_info::out,
+ code_tree::out, code_info::in, code_info::out) is det.
:- pred ite_enter_then(ite_hijack_info::in,
code_tree::out, code_tree::out, code_info::in, code_info::out) is det.
@@ -1307,29 +1297,26 @@
% Return the details of the resume point currently on top of the
% failure continuation stack.
%
-:- pred top_resume_point(code_info::in, resume_point_info::out)
- is det.
+:- pred top_resume_point(code_info::in, resume_point_info::out) is det.
% Call this predicate to say "we have just left a disjunction;
% we don't know what address the following code will need to
% backtrack to".
%
-:- pred set_resume_point_to_unknown(code_info::in, code_info::out)
- is det.
+:- pred set_resume_point_to_unknown(code_info::in, code_info::out) is det.
% Call this predicate to say "we have just returned from a model_non
% call; we don't know what address the following code will need to
% backtrack to, and there may now be nondet frames on top of ours
% that do not have their redofr slots pointing to our frame".
%
-:- pred set_resume_point_and_frame_to_unknown(code_info::in,
- code_info::out) is det.
+:- pred set_resume_point_and_frame_to_unknown(code_info::in, code_info::out)
+ is det.
% Generate code for executing a failure that is appropriate for the
% current failure environment.
%
-:- pred generate_failure(code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred generate_failure(code_tree::out, code_info::in, code_info::out) is det.
% Generate code that checks if the given rval is false, and if yes,
% executes a failure that is appropriate for the current failure
@@ -1341,21 +1328,19 @@
% Checks whether the appropriate code for failure in the current
% failure environment is a direct branch.
%
-:- pred failure_is_direct_branch(code_info::in, code_addr::out)
- is semidet.
+:- pred failure_is_direct_branch(code_info::in, code_addr::out) is semidet.
% Checks under what circumstances the current failure environment
% would allow a model_non call at this point to be turned into a
% tail call, provided of course that the return from the call is
% followed immediately by succeed().
%
-:- pred may_use_nondet_tailcall(code_info::in,
- nondet_tail_call::out) is det.
+:- pred may_use_nondet_tailcall(code_info::in, nondet_tail_call::out) is det.
% Materialize the given variables into registers or stack slots.
%
-:- pred produce_vars(set(prog_var)::in, resume_map::out,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred produce_vars(set(prog_var)::in, resume_map::out, code_tree::out,
+ code_info::in, code_info::out) is det.
% Put the variables needed in enclosing failure continuations
% into their stack slots.
@@ -1365,26 +1350,23 @@
% Set up the resume_point_info structure.
%
-:- pred make_resume_point(set(prog_var)::in, resume_locs::in,
- resume_map::in, resume_point_info::out, code_info::in, code_info::out)
- is det.
+:- pred make_resume_point(set(prog_var)::in, resume_locs::in, resume_map::in,
+ resume_point_info::out, code_info::in, code_info::out) is det.
% Generate the code for a resume point.
%
-:- pred generate_resume_point(resume_point_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_resume_point(resume_point_info::in, code_tree::out,
+ code_info::in, code_info::out) is det.
% List the variables that need to be preserved for the given resume point.
%
-:- pred resume_point_vars(resume_point_info::in,
- list(prog_var)::out) is det.
+:- pred resume_point_vars(resume_point_info::in, list(prog_var)::out) is det.
% See whether the given resume point includes a code address that presumes
% all the resume point variables to be in their stack slots. If yes,
% return that code address; otherwise, abort the compiler.
%
-:- pred resume_point_stack_addr(resume_point_info::in,
- code_addr::out) is det.
+:- pred resume_point_stack_addr(resume_point_info::in, code_addr::out) is det.
%---------------------------------------------------------------------------%
@@ -1509,23 +1491,23 @@
->
% Here ResumeKnown must be resume_point_unknown
% or resume_point_known(wont_be_done).
- acquire_temp_slot(lval(redoip(lval(curfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(curfr))), RedoipSlot, !CI),
HijackInfo = disj_half_hijack(RedoipSlot),
Code = node([
- assign(RedoipSlot, lval(redoip(lval(curfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(curfr))))
- "prepare for half disj hijack"
])
;
% Here CurfrMaxfr must be may_be_different.
- acquire_temp_slot(lval(redoip(lval(maxfr))), RedoipSlot, !CI),
- acquire_temp_slot(lval(redofr(lval(maxfr))), RedofrSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(maxfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redofr_slot(lval(maxfr))), RedofrSlot, !CI),
HijackInfo = disj_full_hijack(RedoipSlot, RedofrSlot),
Code = node([
- assign(RedoipSlot, lval(redoip(lval(maxfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(maxfr))))
- "prepare for full disj hijack",
- assign(RedofrSlot, lval(redofr(lval(maxfr))))
+ assign(RedofrSlot, lval(redofr_slot(lval(maxfr))))
- "prepare for full disj hijack",
- assign(redofr(lval(maxfr)), lval(curfr))
+ assign(redofr_slot(lval(maxfr)), lval(curfr))
- "prepare for full disj hijack"
])
).
@@ -1540,7 +1522,7 @@
;
HijackInfo = disj_temp_frame,
Code = node([
- assign(maxfr, lval(prevfr(lval(maxfr))))
+ assign(maxfr, lval(prevfr_slot(lval(maxfr))))
- "restore maxfr for temp frame disj"
])
;
@@ -1552,7 +1534,7 @@
LabelConst = const(code_addr_const(StackLabel)),
% peephole.m looks for the "curfr==maxfr" pattern in the comment.
Code = node([
- assign(redoip(lval(curfr)), LabelConst)
+ assign(redoip_slot(lval(curfr)), LabelConst)
- "restore redoip for quarter disj hijack (curfr==maxfr)"
])
;
@@ -1563,7 +1545,7 @@
"maxfr may differ from curfr in disj_half_hijack"),
% peephole.m looks for the "curfr==maxfr" pattern in the comment.
Code = node([
- assign(redoip(lval(curfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(curfr)), lval(RedoipSlot))
- "restore redoip for half disj hijack (curfr==maxfr)"
])
;
@@ -1571,9 +1553,9 @@
expect(unify(CurfrMaxfr, may_be_different), this_file,
"maxfr same as curfr in disj_full_hijack"),
Code = node([
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for full disj hijack",
- assign(redofr(lval(maxfr)), lval(RedofrSlot))
+ assign(redofr_slot(lval(maxfr)), lval(RedofrSlot))
- "restore redofr for full disj hijack"
])
),
@@ -1651,26 +1633,26 @@
CurfrMaxfr = must_be_equal
->
% Here ResumeKnown must be resume_point_unknown.
- acquire_temp_slot(lval(redoip(lval(curfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(curfr))), RedoipSlot, !CI),
HijackType = ite_half_hijack(RedoipSlot),
Code = node([
- assign(RedoipSlot, lval(redoip(lval(curfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(curfr))))
- "prepare for half ite hijack"
])
;
% Here CurfrMaxfr must be may_be_different.
- acquire_temp_slot(lval(redoip(lval(maxfr))), RedoipSlot, !CI),
- acquire_temp_slot(lval(redofr(lval(maxfr))), RedofrSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(maxfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redofr_slot(lval(maxfr))), RedofrSlot, !CI),
acquire_temp_slot(lval(maxfr), MaxfrSlot, !CI),
HijackType = ite_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
Code = node([
assign(MaxfrSlot, lval(maxfr))
- "prepare for full ite hijack",
- assign(RedoipSlot, lval(redoip(lval(maxfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(maxfr))))
- "prepare for full ite hijack",
- assign(RedofrSlot, lval(redofr(lval(maxfr))))
+ assign(RedofrSlot, lval(redofr_slot(lval(maxfr))))
- "prepare for full ite hijack",
- assign(redofr(lval(maxfr)), lval(curfr))
+ assign(redofr_slot(lval(maxfr)), lval(curfr))
- "prepare for full ite hijack"
])
),
@@ -1694,12 +1676,13 @@
HijackType = ite_temp_frame(MaxfrSlot),
ThenCode = node([
% We can't remove the frame, it may not be on top.
- assign(redoip(lval(MaxfrSlot)), const(code_addr_const(do_fail)))
+ assign(redoip_slot(lval(MaxfrSlot)),
+ const(code_addr_const(do_fail)))
- "soft cut for temp frame ite"
]),
ElseCode = node([
% XXX, search /assign(maxfr
- assign(maxfr, lval(prevfr(lval(MaxfrSlot))))
+ assign(maxfr, lval(prevfr_slot(lval(MaxfrSlot))))
- "restore maxfr for temp frame ite"
])
;
@@ -1708,7 +1691,7 @@
( maybe_pick_stack_resume_point(ResumePoint, _, StackLabel) ->
LabelConst = const(code_addr_const(StackLabel)),
ThenCode = node([
- assign(redoip(lval(curfr)), LabelConst)
+ assign(redoip_slot(lval(curfr)), LabelConst)
- "restore redoip for quarter ite hijack"
])
;
@@ -1719,22 +1702,22 @@
;
HijackType = ite_half_hijack(RedoipSlot),
ThenCode = node([
- assign(redoip(lval(curfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(curfr)), lval(RedoipSlot))
- "restore redoip for half ite hijack"
]),
ElseCode = ThenCode
;
HijackType = ite_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
ThenCode = node([
- assign(redoip(lval(MaxfrSlot)), lval(RedoipSlot))
+ assign(redoip_slot(lval(MaxfrSlot)), lval(RedoipSlot))
- "restore redoip for full ite hijack",
- assign(redofr(lval(MaxfrSlot)), lval(RedofrSlot))
+ assign(redofr_slot(lval(MaxfrSlot)), lval(RedofrSlot))
- "restore redofr for full ite hijack"
]),
ElseCode = node([
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for full ite hijack",
- assign(redofr(lval(maxfr)), lval(RedofrSlot))
+ assign(redofr_slot(lval(maxfr)), lval(RedofrSlot))
- "restore redofr for full ite hijack"
])
),
@@ -1777,7 +1760,7 @@
make_fake_resume_map([], ResumeMap, ResumeMap).
make_fake_resume_map([Var | Vars], ResumeMap0, ResumeMap) :-
- % a visibly fake location
+ % A visibly fake location.
set.singleton_set(Locns, reg(r, -1)),
map.det_insert(ResumeMap0, Var, Locns, ResumeMap1),
make_fake_resume_map(Vars, ResumeMap1, ResumeMap).
@@ -1926,7 +1909,7 @@
->
HijackInfo = commit_quarter_hijack,
HijackCode = node([
- assign(redoip(lval(curfr)), StackLabelConst)
+ assign(redoip_slot(lval(curfr)), StackLabelConst)
- "hijack the redofr slot"
])
;
@@ -1935,30 +1918,30 @@
% Here ResumeKnown must be resume_point_unknown or
% resume_point_known(wont_be_done).
- acquire_temp_slot(lval(redoip(lval(curfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(curfr))), RedoipSlot, !CI),
HijackInfo = commit_half_hijack(RedoipSlot),
HijackCode = node([
- assign(RedoipSlot, lval(redoip(lval(curfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(curfr))))
- "prepare for half commit hijack",
- assign(redoip(lval(curfr)), StackLabelConst)
+ assign(redoip_slot(lval(curfr)), StackLabelConst)
- "hijack the redofr slot"
])
;
% Here CurfrMaxfr must be may_be_different.
- acquire_temp_slot(lval(redoip(lval(maxfr))), RedoipSlot, !CI),
- acquire_temp_slot(lval(redofr(lval(maxfr))), RedofrSlot, !CI),
+ acquire_temp_slot(lval(redoip_slot(lval(maxfr))), RedoipSlot, !CI),
+ acquire_temp_slot(lval(redofr_slot(lval(maxfr))), RedofrSlot, !CI),
acquire_temp_slot(lval(maxfr), MaxfrSlot, !CI),
HijackInfo = commit_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
HijackCode = node([
- assign(RedoipSlot, lval(redoip(lval(maxfr))))
+ assign(RedoipSlot, lval(redoip_slot(lval(maxfr))))
- "prepare for full commit hijack",
- assign(RedofrSlot, lval(redofr(lval(maxfr))))
+ assign(RedofrSlot, lval(redofr_slot(lval(maxfr))))
- "prepare for full commit hijack",
save_maxfr(MaxfrSlot)
- "prepare for full commit hijack",
- assign(redofr(lval(maxfr)), lval(curfr))
+ assign(redofr_slot(lval(maxfr)), lval(curfr))
- "hijack the redofr slot",
- assign(redoip(lval(maxfr)), StackLabelConst)
+ assign(redoip_slot(lval(maxfr)), StackLabelConst)
- "hijack the redoip slot"
])
),
@@ -2005,11 +1988,11 @@
SuccessUndoCode = node([
assign(maxfr, lval(curfr))
- "restore maxfr for quarter commit hijack",
- assign(redoip(lval(maxfr)), StackLabelConst)
+ assign(redoip_slot(lval(maxfr)), StackLabelConst)
- "restore redoip for quarter commit hijack"
]),
FailureUndoCode = node([
- assign(redoip(lval(maxfr)), StackLabelConst)
+ assign(redoip_slot(lval(maxfr)), StackLabelConst)
- "restore redoip for quarter commit hijack"
])
;
@@ -2017,11 +2000,11 @@
SuccessUndoCode = node([
assign(maxfr, lval(curfr))
- "restore maxfr for half commit hijack",
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for half commit hijack"
]),
FailureUndoCode = node([
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for half commit hijack"
])
;
@@ -2029,15 +2012,15 @@
SuccessUndoCode = node([
restore_maxfr(MaxfrSlot)
- "restore maxfr for full commit hijack",
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for full commit hijack",
- assign(redofr(lval(maxfr)), lval(RedofrSlot))
+ assign(redofr_slot(lval(maxfr)), lval(RedofrSlot))
- "restore redofr for full commit hijack"
]),
FailureUndoCode = node([
- assign(redoip(lval(maxfr)), lval(RedoipSlot))
+ assign(redoip_slot(lval(maxfr)), lval(RedoipSlot))
- "restore redoip for full commit hijack",
- assign(redofr(lval(maxfr)), lval(RedofrSlot))
+ assign(redofr_slot(lval(maxfr)), lval(RedofrSlot))
- "restore redofr for full commit hijack"
])
),
@@ -2116,7 +2099,7 @@
pick_stack_resume_point(ResumePoint, _, StackLabel),
LabelConst = const(code_addr_const(StackLabel)),
Code = node([
- assign(redoip(lval(maxfr)), LabelConst)
+ assign(redoip_slot(lval(maxfr)), LabelConst)
- "hijack redoip to effect resume point"
]),
RedoipUpdate = has_been_done
@@ -2651,8 +2634,7 @@
:- pred maybe_restore_trail_info(maybe(pair(lval))::in,
code_tree::out, code_tree::out, code_info::in, code_info::out) is det.
-maybe_restore_trail_info(MaybeTrailSlots, CommitCode, RestoreCode,
- !CI) :-
+maybe_restore_trail_info(MaybeTrailSlots, CommitCode, RestoreCode, !CI) :-
(
MaybeTrailSlots = no,
CommitCode = empty,
@@ -2663,8 +2645,7 @@
reset_ticket(lval(TrailPtrSlot), commit)
- "discard trail entries and restore trail ptr",
prune_tickets_to(lval(CounterSlot))
- - ("restore ticket counter " ++
- "(but not high water mark)")
+ - ("restore ticket counter (but not high water mark)")
]),
RestoreCode = node([
reset_ticket(lval(TrailPtrSlot), undo)
@@ -2838,8 +2819,7 @@
:- pred restore_hp(lval::in, code_tree::out) is det.
-:- pred release_hp(lval::in,
- code_info::in, code_info::out) is det.
+:- pred release_hp(lval::in, code_info::in, code_info::out) is det.
:- pred restore_and_release_hp(lval::in, code_tree::out,
code_info::in, code_info::out) is det.
@@ -2858,18 +2838,15 @@
:- pred save_ticket(code_tree::out, lval::out,
code_info::in, code_info::out) is det.
-:- pred reset_ticket(lval::in, reset_trail_reason::in,
- code_tree::out) is det.
+:- pred reset_ticket(lval::in, reset_trail_reason::in, code_tree::out) is det.
-:- pred release_ticket(lval::in,
- code_info::in, code_info::out) is det.
+:- pred release_ticket(lval::in, code_info::in, code_info::out) is det.
:- pred reset_and_prune_ticket(lval::in, reset_trail_reason::in,
code_tree::out) is det.
-:- pred reset_prune_and_release_ticket(lval::in,
- reset_trail_reason::in, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred reset_prune_and_release_ticket(lval::in, reset_trail_reason::in,
+ code_tree::out, code_info::in, code_info::out) is det.
:- pred reset_and_discard_ticket(lval::in, reset_trail_reason::in,
code_tree::out) is det.
@@ -3180,8 +3157,7 @@
:- pred release_reg(lval::in, code_info::in, code_info::out) is det.
-:- pred reserve_r1(code_tree::out, code_info::in, code_info::out)
- is det.
+:- pred reserve_r1(code_tree::out, code_info::in, code_info::out) is det.
:- pred clear_r1(code_tree::out, code_info::in, code_info::out) is det.
@@ -3200,9 +3176,8 @@
%
% - The input arguments will be moved to their registers.
%
-:- pred setup_call(hlds_goal_info::in,
- assoc_list(prog_var, arg_info)::in, set(lval)::out, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred setup_call(hlds_goal_info::in, assoc_list(prog_var, arg_info)::in,
+ set(lval)::out, code_tree::out, code_info::in, code_info::out) is det.
% Move the output arguments of the current procedure to where
% they need to be at return.
@@ -3220,14 +3195,11 @@
% thus it is OK for this action to delete the last record of the state
% of a variable.
%
-:- pred clear_all_registers(bool::in,
- code_info::in, code_info::out) is det.
+:- pred clear_all_registers(bool::in, code_info::in, code_info::out) is det.
-:- pred clobber_regs(list(lval)::in,
- code_info::in, code_info::out) is det.
+:- pred clobber_regs(list(lval)::in, code_info::in, code_info::out) is det.
-:- pred save_variables(set(prog_var)::in,
- set(lval)::out, code_tree::out,
+:- pred save_variables(set(prog_var)::in, set(lval)::out, code_tree::out,
code_info::in, code_info::out) is det.
:- pred save_variables_on_stack(list(prog_var)::in, code_tree::out,
@@ -3511,8 +3483,7 @@
code_info::in, code_info::out) is det.
setup_call_args(AllArgsInfos, Direction, LiveLocs, Code, !CI) :-
- list.filter(call_arg_in_selected_dir(Direction),
- AllArgsInfos, ArgsInfos),
+ list.filter(call_arg_in_selected_dir(Direction), AllArgsInfos, ArgsInfos),
var_arg_info_to_lval(ArgsInfos, ArgsLocns),
get_module_info(!.CI, ModuleInfo),
get_var_locn_info(!.CI, VarLocnInfo0),
@@ -3522,16 +3493,14 @@
assoc_list.values(ArgsLocns, LiveLocList),
set.list_to_set(LiveLocList, LiveLocs),
assoc_list.keys(ArgsLocns, ArgVars),
- which_variables_are_forward_live(!.CI, ArgVars,
- set.init, DeadVars),
+ which_variables_are_forward_live(!.CI, ArgVars, set.init, DeadVars),
make_vars_forward_dead(DeadVars, !CI).
:- pred var_arg_info_to_lval(assoc_list(prog_var, arg_info)::in,
assoc_list(prog_var, lval)::out) is det.
var_arg_info_to_lval([], []).
-var_arg_info_to_lval([Var - ArgInfo | RestInfos],
- [Var - Lval | RestLvals]) :-
+var_arg_info_to_lval([Var - ArgInfo | RestInfos], [Var - Lval | RestLvals]) :-
ArgInfo = arg_info(Loc, _Mode),
code_util.arg_loc_to_register(Loc, Lval),
var_arg_info_to_lval(RestInfos, RestLvals).
@@ -3768,15 +3737,13 @@
% Release a stack slot acquired earlier for a temporary value.
%
-:- pred release_temp_slot(lval::in,
- code_info::in, code_info::out) is det.
+:- pred release_temp_slot(lval::in, code_info::in, code_info::out) is det.
% Return the lval of the stack slot in which the given variable
% is stored. Aborts if the variable does not have a stack slot
% an assigned to it.
%
-:- pred get_variable_slot(code_info::in, prog_var::in, lval::out)
- is det.
+:- pred get_variable_slot(code_info::in, prog_var::in, lval::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: compiler/code_model.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_model.m,v
retrieving revision 1.10
diff -u -b -r1.10 code_model.m
--- compiler/code_model.m 24 Feb 2006 07:11:08 -0000 1.10
+++ compiler/code_model.m 7 Apr 2006 03:26:11 -0000
@@ -18,7 +18,7 @@
%
%-----------------------------------------------------------------------------%
-:- module hlds__code_model.
+:- module hlds.code_model.
:- interface.
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.170
diff -u -b -r1.170 code_util.m
--- compiler/code_util.m 31 Mar 2006 03:32:10 -0000 1.170
+++ compiler/code_util.m 8 Apr 2006 14:16:59 -0000
@@ -388,15 +388,15 @@
lvals_in_lval(succip, []).
lvals_in_lval(maxfr, []).
lvals_in_lval(curfr, []).
-lvals_in_lval(succip(Rval), Lvals) :-
+lvals_in_lval(succip_slot(Rval), Lvals) :-
lvals_in_rval(Rval, Lvals).
-lvals_in_lval(redofr(Rval), Lvals) :-
+lvals_in_lval(redofr_slot(Rval), Lvals) :-
lvals_in_rval(Rval, Lvals).
-lvals_in_lval(redoip(Rval), Lvals) :-
+lvals_in_lval(redoip_slot(Rval), Lvals) :-
lvals_in_rval(Rval, Lvals).
-lvals_in_lval(succfr(Rval), Lvals) :-
+lvals_in_lval(succfr_slot(Rval), Lvals) :-
lvals_in_rval(Rval, Lvals).
-lvals_in_lval(prevfr(Rval), Lvals) :-
+lvals_in_lval(prevfr_slot(Rval), Lvals) :-
lvals_in_rval(Rval, Lvals).
lvals_in_lval(hp, []).
lvals_in_lval(sp, []).
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.73
diff -u -b -r1.73 continuation_info.m
--- compiler/continuation_info.m 29 Mar 2006 08:06:39 -0000 1.73
+++ compiler/continuation_info.m 8 Apr 2006 14:16:59 -0000
@@ -301,6 +301,8 @@
---> ticket % A ticket (trail pointer).
; ticket_counter % A copy of the ticket counter.
; trace_data
+ ; lookup_switch_cur
+ ; lookup_switch_max
; sync_term % A syncronization term used
% at the end of par_conjs.
% See par_conj_gen.m for details.
@@ -384,7 +386,8 @@
maybe_process_llds([], _, !GlobalData).
maybe_process_llds([Proc | Procs], ModuleInfo, !GlobalData) :-
- Proc = c_procedure(_, _, PredProcId, Instrs, _, _, _),
+ PredProcId = Proc ^ cproc_id,
+ Instrs = Proc ^ cproc_code,
maybe_process_proc_llds(Instrs, PredProcId, ModuleInfo, !GlobalData),
maybe_process_llds(Procs, ModuleInfo, !GlobalData).
@@ -869,11 +872,11 @@
live_value_type(lval(hp), hp).
live_value_type(lval(maxfr), maxfr).
live_value_type(lval(curfr), curfr).
-live_value_type(lval(succfr(_)), unwanted).
-live_value_type(lval(prevfr(_)), unwanted).
-live_value_type(lval(redofr(_)), unwanted).
-live_value_type(lval(redoip(_)), unwanted).
-live_value_type(lval(succip(_)), unwanted).
+live_value_type(lval(succfr_slot(_)), unwanted).
+live_value_type(lval(prevfr_slot(_)), unwanted).
+live_value_type(lval(redofr_slot(_)), unwanted).
+live_value_type(lval(redoip_slot(_)), unwanted).
+live_value_type(lval(succip_slot(_)), unwanted).
live_value_type(lval(sp), unwanted).
live_value_type(lval(lvar(_)), unwanted).
live_value_type(lval(field(_, _, _)), unwanted).
@@ -886,6 +889,8 @@
% if the GC is going to garbage-collect
% the trail.
live_value_type(ticket_counter, unwanted).
+live_value_type(lookup_switch_cur, unwanted).
+live_value_type(lookup_switch_max, unwanted).
live_value_type(sync_term, unwanted).
live_value_type(trace_data, unwanted).
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.77
diff -u -b -r1.77 dupelim.m
--- compiler/dupelim.m 10 Apr 2006 04:28:21 -0000 1.77
+++ compiler/dupelim.m 10 Apr 2006 04:31:21 -0000
@@ -466,19 +466,19 @@
Lval1 = framevar(_),
Lval = Lval1
;
- Lval1 = succip(_),
+ Lval1 = succip_slot(_),
Lval = Lval1
;
- Lval1 = redoip(_),
+ Lval1 = redoip_slot(_),
Lval = Lval1
;
- Lval1 = succfr(_),
+ Lval1 = succfr_slot(_),
Lval = Lval1
;
- Lval1 = redofr(_),
+ Lval1 = redofr_slot(_),
Lval = Lval1
;
- Lval1 = prevfr(_),
+ Lval1 = prevfr_slot(_),
Lval = Lval1
;
Lval1 = field(_, Addr, FieldNum),
@@ -815,23 +815,23 @@
Lval2 = Lval1,
Lval = Lval1
;
- Lval1 = succip(_),
+ Lval1 = succip_slot(_),
Lval2 = Lval1,
Lval = Lval1
;
- Lval1 = redoip(_),
+ Lval1 = redoip_slot(_),
Lval2 = Lval1,
Lval = Lval1
;
- Lval1 = redofr(_),
+ Lval1 = redofr_slot(_),
Lval2 = Lval1,
Lval = Lval1
;
- Lval1 = succfr(_),
+ Lval1 = succfr_slot(_),
Lval2 = Lval1,
Lval = Lval1
;
- Lval1 = prevfr(_),
+ Lval1 = prevfr_slot(_),
Lval2 = Lval1,
Lval = Lval1
;
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.69
diff -u -b -r1.69 exprn_aux.m
--- compiler/exprn_aux.m 30 Mar 2006 02:45:55 -0000 1.69
+++ compiler/exprn_aux.m 8 Apr 2006 14:16:59 -0000
@@ -282,15 +282,15 @@
vars_in_lval(sp, []).
vars_in_lval(stackvar(_SlotNum), []).
vars_in_lval(framevar(_SlotNum), []).
-vars_in_lval(succip(Rval), Vars) :-
+vars_in_lval(succip_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
-vars_in_lval(redoip(Rval), Vars) :-
+vars_in_lval(redoip_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
-vars_in_lval(redofr(Rval), Vars) :-
+vars_in_lval(redofr_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
-vars_in_lval(succfr(Rval), Vars) :-
+vars_in_lval(succfr_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
-vars_in_lval(prevfr(Rval), Vars) :-
+vars_in_lval(prevfr_slot(Rval), Vars) :-
vars_in_rval(Rval, Vars).
vars_in_lval(field(_MaybeTag, Rval0, Rval1), Vars) :-
vars_in_rval(Rval0, Vars0),
@@ -622,25 +622,25 @@
Lval0 = framevar(_SlotNum),
Lval = Lval0
;
- Lval0 = succip(Rval0),
+ Lval0 = succip_slot(Rval0),
substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N),
- Lval = succip(Rval)
+ Lval = succip_slot(Rval)
;
- Lval0 = redoip(Rval0),
+ Lval0 = redoip_slot(Rval0),
substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N),
- Lval = redoip(Rval)
+ Lval = redoip_slot(Rval)
;
- Lval0 = redofr(Rval0),
+ Lval0 = redofr_slot(Rval0),
substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N),
- Lval = redofr(Rval)
+ Lval = redofr_slot(Rval)
;
- Lval0 = succfr(Rval0),
+ Lval0 = succfr_slot(Rval0),
substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N),
- Lval = succfr(Rval)
+ Lval = succfr_slot(Rval)
;
- Lval0 = prevfr(Rval0),
+ Lval0 = prevfr_slot(Rval0),
substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval, !N),
- Lval = prevfr(Rval)
+ Lval = prevfr_slot(Rval)
;
Lval0 = field(Tag, Rval1, Rval2),
substitute_lval_in_rval_count(OldLval, NewLval, Rval1, Rval3, !N),
@@ -758,25 +758,25 @@
Lval0 = framevar(N),
Lval = framevar(N)
;
- Lval0 = succip(Rval0),
+ Lval0 = succip_slot(Rval0),
substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
- Lval = succip(Rval)
+ Lval = succip_slot(Rval)
;
- Lval0 = redoip(Rval0),
+ Lval0 = redoip_slot(Rval0),
substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
- Lval = redoip(Rval)
+ Lval = redoip_slot(Rval)
;
- Lval0 = redofr(Rval0),
+ Lval0 = redofr_slot(Rval0),
substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
- Lval = redofr(Rval)
+ Lval = redofr_slot(Rval)
;
- Lval0 = succfr(Rval0),
+ Lval0 = succfr_slot(Rval0),
substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
- Lval = succfr(Rval)
+ Lval = succfr_slot(Rval)
;
- Lval0 = prevfr(Rval0),
+ Lval0 = prevfr_slot(Rval0),
substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
- Lval = prevfr(Rval)
+ Lval = prevfr_slot(Rval)
;
Lval0 = field(Tag, Rval1, Rval2),
substitute_rval_in_rval(OldRval, NewRval, Rval1, Rval3),
@@ -937,15 +937,15 @@
lval_addrs(succip, [], []).
lval_addrs(maxfr, [], []).
lval_addrs(curfr, [], []).
-lval_addrs(prevfr(Rval), CodeAddrs, DataAddrs) :-
+lval_addrs(prevfr_slot(Rval), CodeAddrs, DataAddrs) :-
rval_addrs(Rval, CodeAddrs, DataAddrs).
-lval_addrs(succfr(Rval), CodeAddrs, DataAddrs) :-
+lval_addrs(succfr_slot(Rval), CodeAddrs, DataAddrs) :-
rval_addrs(Rval, CodeAddrs, DataAddrs).
-lval_addrs(redofr(Rval), CodeAddrs, DataAddrs) :-
+lval_addrs(redofr_slot(Rval), CodeAddrs, DataAddrs) :-
rval_addrs(Rval, CodeAddrs, DataAddrs).
-lval_addrs(redoip(Rval), CodeAddrs, DataAddrs) :-
+lval_addrs(redoip_slot(Rval), CodeAddrs, DataAddrs) :-
rval_addrs(Rval, CodeAddrs, DataAddrs).
-lval_addrs(succip(Rval), CodeAddrs, DataAddrs) :-
+lval_addrs(succip_slot(Rval), CodeAddrs, DataAddrs) :-
rval_addrs(Rval, CodeAddrs, DataAddrs).
lval_addrs(hp, [], []).
lval_addrs(sp, [], []).
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.99
diff -u -b -r1.99 frameopt.m
--- compiler/frameopt.m 29 Mar 2006 08:06:45 -0000 1.99
+++ compiler/frameopt.m 22 Apr 2006 05:13:18 -0000
@@ -104,8 +104,8 @@
%-----------------------------------------------------------------------------%
- % frameopt_main(ProcLabel, !LabelCounter, !Instrs, Globals, AnyChange,
- % NewJumps):
+ % frameopt_main_det_stack(ProcLabel, !LabelCounter, !Instrs, Globals,
+ % AnyChange):
%
% Attempt to update !Instrs using the one of the transformations
% described above for procedures that live on the det stack.
@@ -119,33 +119,36 @@
% deleted and probably some jumps that could be profitably be
% short-circuited.
%
-:- pred frameopt_main(proc_label::in, counter::in, counter::out,
+:- pred frameopt_main_det_stack(proc_label::in, counter::in, counter::out,
list(instruction)::in, list(instruction)::out, globals::in, bool::out)
is det.
- % frameopt_nondet(ProcLabel, LayoutLabels, MayAlterRtti, !LabelCounter,
- % !Instrs, AnyChange):
+ % frameopt_main_nondet_stack(ProcLabel, !LabelCounter, !Instrs, Globals,
+ % AnyChange):
%
- % Attempt to update !Instrs using the one of the transformations
- % described above for procedures that live on the nondet stack.
+ % The equivalent of frameopt_main_det_stack for procedures that live on
+ % the nondet stack, but attempting only the transformation that delays
+ % the creation of stack frames.
+ %
+:- pred frameopt_main_nondet_stack(proc_label::in, counter::in, counter::out,
+ list(instruction)::in, list(instruction)::out, globals::in, bool::out)
+ is det.
+
+ % frameopt_keep_nondet_frame(ProcLabel, LayoutLabels,
+ % !LabelCounter, !Instrs, AnyChange):
%
- % ProcLabel should be the ProcLabel of the procedure whose body
- % !.Instrs implements, and !.LabelCounter that procedure's label
- % counter. If frameopt_main allocates any labels, !:LabelCounter
- % will reflect this.
+ % The equivalent of frameopt_main_det_stack for procedures that live on
+ % the nondet stack, but attempting only the transformation that keeps
+ % existing stack frames at tail calls. This should be called before
+ % other LLDS optimizations on the procedure body.
%
% LayoutLabels should be the set of labels in the procedure with layout
% structures, while MayAlterRtti should say whether we are allowed to
% perform optimizations that may interfere with RTTI.
%
- % AnyChange says whether we performed any modifications.
- % If yes, then we also introduced some extra labels that should be
- % deleted, and we introduced some jumps that may be profitably
- % short-circuited.
- %
-:- pred frameopt_nondet(proc_label::in, set(label)::in, may_alter_rtti::in,
- counter::in, counter::out,
- list(instruction)::in, list(instruction)::out, bool::out) is det.
+:- pred frameopt_keep_nondet_frame(proc_label::in, set(label)::in,
+ counter::in, counter::out, list(instruction)::in, list(instruction)::out,
+ bool::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -174,16 +177,18 @@
%-----------------------------------------------------------------------------%
-frameopt_main(ProcLabel, !C, Instrs0, Instrs, Globals, Mod) :-
+frameopt_main_det_stack(ProcLabel, !C, Instrs0, Instrs, Globals, Mod) :-
opt_util.get_prologue(Instrs0, LabelInstr, Comments0, Instrs1),
- ( frameopt.detstack_setup(Instrs1, FrameSize, Msg, _, _, _) ->
+ ( detect_det_entry(Instrs1, _, _, EntryInfo) ->
some [!BlockMap] (
map.init(!:BlockMap),
divide_into_basic_blocks([LabelInstr | Instrs1], ProcLabel,
BasicInstrs, !C),
- build_frame_block_map(BasicInstrs, FrameSize, LabelSeq0, no, no,
- ProcLabel, !BlockMap, map.init, PredMap, !C),
- analyze_block_map(LabelSeq0, !BlockMap, KeepFrame),
+ build_frame_block_map(BasicInstrs, EntryInfo, LabelSeq0, no, no,
+ ProcLabel, !BlockMap, map.init, PredMap, !C,
+ map.init, PreExitDummyLabelMap),
+ analyze_block_map(LabelSeq0, PreExitDummyLabelMap, !BlockMap,
+ KeepFrame),
(
KeepFrame = yes(FirstLabel - SecondLabel),
CanClobberSuccip = can_clobber_succip(LabelSeq0, !.BlockMap),
@@ -191,24 +196,29 @@
CanClobberSuccip, !BlockMap),
LabelSeq = LabelSeq0,
NewComment = comment("keeping stack frame") - "",
- list.append(Comments0, [NewComment], Comments),
+ Comments = Comments0 ++ [NewComment],
flatten_block_seq(LabelSeq, !.BlockMap, BodyInstrs),
- list.append(Comments, BodyInstrs, Instrs),
+ Instrs = Comments ++ BodyInstrs,
Mod = yes
;
KeepFrame = no,
- (
- can_delay_frame(LabelSeq0, !.BlockMap),
- delay_frame_transform(LabelSeq0, LabelSeq, FrameSize, Msg,
+ ( can_delay_frame(LabelSeq0, !.BlockMap) ->
+ delay_frame_transform(LabelSeq0, LabelSeq, EntryInfo,
ProcLabel, PredMap, !C, !BlockMap, Globals,
- NewComments, CanTransform),
- CanTransform = can_transform
- ->
- Comments = Comments0 ++ NewComments,
+ TransformComments, DescComments, CanTransform),
+ (
+ CanTransform = can_transform,
+ Comments = Comments0 ++ TransformComments
+ ++ DescComments,
flatten_block_seq(LabelSeq, !.BlockMap, BodyInstrs),
- list.append(Comments, BodyInstrs, Instrs),
+ Instrs = Comments ++ BodyInstrs,
Mod = yes
;
+ CanTransform = cannot_transform,
+ maybe_add_comments(Globals, DescComments,
+ Instrs0, Instrs, Mod)
+ )
+ ;
Instrs = Instrs0,
Mod = no
)
@@ -219,37 +229,67 @@
Mod = no
).
-:- pred flatten_block_seq(list(label)::in, frame_block_map::in,
- list(instruction)::out) is det.
+frameopt_main_nondet_stack(ProcLabel, !C, Instrs0, Instrs, Globals, Mod) :-
+ opt_util.get_prologue(Instrs0, LabelInstr, Comments0, Instrs1),
+ ( detect_nondet_entry(Instrs1, _, _, EntryInfo) ->
+ some [!BlockMap] (
+ map.init(!:BlockMap),
+ divide_into_basic_blocks([LabelInstr | Instrs1], ProcLabel,
+ BasicInstrs, !C),
+ build_frame_block_map(BasicInstrs, EntryInfo, LabelSeq0, no, no,
+ ProcLabel, !BlockMap, map.init, PredMap, !C,
+ map.init, PreExitDummyLabelMap),
+ analyze_block_map(LabelSeq0, PreExitDummyLabelMap, !BlockMap,
+ _KeepFrame),
+ ( can_delay_frame(LabelSeq0, !.BlockMap) ->
+ delay_frame_transform(LabelSeq0, LabelSeq, EntryInfo,
+ ProcLabel, PredMap, !C, !BlockMap, Globals,
+ TransformComments, DescComments, CanTransform),
+ (
+ CanTransform = can_transform,
+ Comments = Comments0 ++ TransformComments ++ DescComments,
+ flatten_block_seq(LabelSeq, !.BlockMap, BodyInstrs),
+ Instrs = Comments ++ BodyInstrs,
+ Mod = yes
+ ;
+ CanTransform = cannot_transform,
+ maybe_add_comments(Globals, DescComments,
+ Instrs0, Instrs, Mod)
+ )
+ ;
+ Instrs = Instrs0,
+ Mod = no
+ )
+ )
+ ;
+ Instrs = Instrs0,
+ Mod = no
+ ).
-flatten_block_seq([], _, []).
-flatten_block_seq([Label | Labels], BlockMap, Instrs) :-
- flatten_block_seq(Labels, BlockMap, RestInstrs),
- map.lookup(BlockMap, Label, BlockInfo),
- BlockInstrs = BlockInfo ^ fb_instrs,
+:- pred maybe_add_comments(globals::in, list(instruction)::in,
+ list(instruction)::in, list(instruction)::out, bool::out) is det.
+
+maybe_add_comments(Globals, DescComments, Instrs0, Instrs, Mod) :-
+ globals.lookup_bool_option(Globals, frameopt_comments, FrameoptComments),
(
- list.split_last(BlockInstrs, MostInstrs, LastInstr),
- Labels = [NextLabel | _],
- LastInstr = goto(label(NextLabel)) - _
- ->
- % Optimize away the redundant goto, which we probably introduced.
- % The next invocation of jumpopt would also do this, but doing it here
- % is cheaper and may let us reach a fixpoint in the optimization
- % sequence earlier.
- Instrs = MostInstrs ++ RestInstrs
+ FrameoptComments = no,
+ Instrs = Instrs0,
+ Mod = no
;
- Instrs = BlockInstrs ++ RestInstrs
+ FrameoptComments = yes,
+ Instrs =
+ [comment("could not delay frame creation") - ""]
+ ++ DescComments ++ Instrs0,
+ Mod = yes
).
%-----------------------------------------------------------------------------%
-frameopt_nondet(ProcLabel, LayoutLabels, MayAlterRtti, !C, Instrs0, Instrs,
+frameopt_keep_nondet_frame(ProcLabel, LayoutLabels, !C, Instrs0, Instrs,
Mod) :-
opt_util.get_prologue(Instrs0, LabelInstr, Comments0, Instrs1),
(
- MayAlterRtti = may_alter_rtti,
- frameopt.nondetstack_setup(Instrs1, FrameInfo, Redoip,
- MkframeInstr, Remain),
+ nondetstack_setup(Instrs1, FrameInfo, Redoip, MkframeInstr, Remain),
MkframeInstr = MkframeUinstr - MkframeComment,
find_succeed_labels(Instrs1, map.init, SuccMap),
counter.allocate(KeepFrameLabelNum, !C),
@@ -260,7 +300,8 @@
list.condense([[LabelInstr], Comments0,
[mkframe(FrameInfo, no) - MkframeComment,
label(KeepFrameLabel) - "tail recursion target",
- assign(redoip(lval(curfr)), const(code_addr_const(Redoip))) - ""],
+ assign(redoip_slot(lval(curfr)),
+ const(code_addr_const(Redoip))) - ""],
Instrs2], Instrs),
Mod = yes
;
@@ -268,12 +309,10 @@
Mod = no
).
-:- pred frameopt.nondetstack_setup(list(instruction)::in,
- nondet_frame_info::out, code_addr::out,
- instruction::out, list(instruction)::out) is semidet.
+:- pred nondetstack_setup(list(instruction)::in, nondet_frame_info::out,
+ code_addr::out, instruction::out, list(instruction)::out) is semidet.
-frameopt.nondetstack_setup(Instrs0, FrameInfo, Redoip, MkframeInstr,
- Remain) :-
+nondetstack_setup(Instrs0, FrameInfo, Redoip, MkframeInstr, Remain) :-
Instrs0 = [MkframeInstr | Remain],
MkframeInstr = mkframe(FrameInfo, yes(Redoip)) - _,
FrameInfo = ordinary_frame(_, _, _).
@@ -308,7 +347,7 @@
% a runtime check.
Uinstr0 = call(label(entry(_, ProcLabel)), label(RetLabel),
_, _, _, CallModel),
- CallModel = nondet(unchecked_tail_call),
+ CallModel = call_model_nondet(unchecked_tail_call),
map.search(SuccMap, RetLabel, BetweenIncl),
BetweenIncl = [livevals(_) - _, goto(_) - _],
PrevInstr = livevals(Livevals),
@@ -332,9 +371,11 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- type frame_block_map == map(label, frame_block_info).
+:- type frame_block_map(En, Ex) == map(label, frame_block_info(En, Ex)).
-:- type frame_block_info
+:- type det_frame_block_map == frame_block_map(det_entry_info, det_exit_info).
+
+:- type frame_block_info(En, Ex)
---> frame_block_info(
fb_label :: label,
% The label of the first instr.
@@ -355,31 +396,117 @@
% The label we fall through to
% (if there is one).
- fb_type :: block_type
+ fb_type :: block_type(En, Ex)
).
-:- type block_type
- ---> setup % This is a block containing
- % only setup instructions.
+:- type block_type(EntryInfo, ExitInfo)
+ ---> entry_block(EntryInfo)
+ ; ordinary_block(block_needs_frame(needs_frame_reason), maybe_dummy)
+ ; exit_block(ExitInfo).
+
+:- type maybe_dummy
+ ---> is_not_dummy
+ ; is_post_entry_dummy
+ ; is_pre_exit_dummy.
+
+:- type block_needs_frame(T)
+ ---> block_needs_frame(T)
+ ; block_doesnt_need_frame.
- ; ordinary(block_needs_frame)
- % This block does not contain setup or
- % teardown. The arg says whether the code
- % in the block needs a stack frame.
+:- type needs_frame_reasons == set(needs_frame_reason).
- ; teardown( % This block contains stack teardown
+:- type needs_frame_reason
+ ---> code_needs_frame(label)
+ % The code of the block of this label needs a frame.
+
+ ; keep_frame
+
+ ; redoip_label
+
+ ; jump_around(label, needs_frame_reasons)
+
+ ; frontier(label, needs_frame_reasons)
+
+ ; succ_propagated(label, needs_frame_reason)
+ % The reason given by the second arg is propagated to its
+ % successors, including the block of the first argument.
+
+ ; pred_propagated(label, needs_frame_reason).
+ % The reason given by the second arg is propagated to its
+ % predecessors, including the block of the first argument.
+
+:- type det_entry_info
+ ---> det_entry(
+ string, % The msg of the incr_sp instruction.
+ int % The frame size.
+ ).
+
+:- type det_exit_info
+ ---> det_exit( % This block contains det stack teardown
% and goto code.
list(instruction),
- % The instr that restores succip (if any),
+ % The instr that restores succip (if any).
list(instruction),
- % The livevals instr before the goto (if any),
+ % The livevals instr before the goto (if any).
instruction
% The goto instr.
).
-:- type block_needs_frame
- ---> block_needs_frame
- ; block_doesnt_need_frame.
+:- type nondet_entry_info
+ ---> nondet_entry(
+ string, % The msg of the mkframe instruction.
+ int, % The frame size.
+ code_addr % The initial redoip.
+ ).
+
+:- type nondet_exit_info
+ ---> nondet_plain_exit( % This block contains nondet stack exit code
+ % that doesn't throw away the stack frame.
+ list(instruction),
+ % The livevals instr before the goto (if any).
+ instruction
+ % The goto(do_succeed) instr.
+ )
+ ; nondet_teardown_exit(
+ % This block contains nondet stack exit code
+ % that *does* throw away the stack frame.
+ instruction, % The restore of the succip.
+ instruction, % The restore of the maxfr.
+ instruction, % The restore of the curfr.
+ list(instruction),
+ % The livevals instr before the goto (if any).
+ instruction
+ % The goto(entry(_, _)) instr.
+ ).
+
+:- typeclass block_entry_exit(En, Ex) <= ((En -> Ex), (Ex -> En)) where [
+ pred detect_entry(list(instruction)::in, list(instruction)::out,
+ list(instruction)::out, En::out) is semidet,
+ pred detect_exit(list(instruction)::in, En::in, list(instruction)::out,
+ list(instruction)::out, list(instruction)::out, Ex::out) is semidet,
+ func late_setup_code(En) = list(instruction),
+ func non_teardown_exit_code(Ex) = list(instruction),
+ func describe_entry(En) = string,
+ func describe_exit(proc_label, Ex) = string
+].
+
+:- instance block_entry_exit(det_entry_info, det_exit_info) where [
+ pred(detect_entry/4) is detect_det_entry,
+ pred(detect_exit/6) is detect_det_exit,
+ func(late_setup_code/1) is det_late_setup,
+ func(non_teardown_exit_code/1) is det_non_teardown_exit_code,
+ func(describe_entry/1) is describe_det_entry,
+ func(describe_exit/2) is describe_det_exit
+].
+
+:- instance block_entry_exit(nondet_entry_info, nondet_exit_info) where [
+ pred(detect_entry/4) is detect_nondet_entry,
+ pred(detect_exit/6) is detect_nondet_exit,
+ func(late_setup_code/1) is nondet_late_setup,
+ func(non_teardown_exit_code/1) is nondet_non_teardown_exit_code,
+ func(describe_entry/1) is describe_nondet_entry,
+ func(describe_exit/2) is describe_nondet_exit
+].
%-----------------------------------------------------------------------------%
@@ -417,18 +544,44 @@
Instrs = [Instr0 | Instrs1]
).
+:- pred flatten_block_seq(list(label)::in, frame_block_map(En, Ex)::in,
+ list(instruction)::out) is det.
+
+flatten_block_seq([], _, []).
+flatten_block_seq([Label | Labels], BlockMap, Instrs) :-
+ flatten_block_seq(Labels, BlockMap, RestInstrs),
+ map.lookup(BlockMap, Label, BlockInfo),
+ BlockInstrs = BlockInfo ^ fb_instrs,
+ (
+ list.split_last(BlockInstrs, MostInstrs, LastInstr),
+ Labels = [NextLabel | _],
+ LastInstr = goto(label(NextLabel)) - _
+ ->
+ % Optimize away the redundant goto, which we probably introduced.
+ % The next invocation of jumpopt would also do this, but doing it here
+ % is cheaper and may let us reach a fixpoint in the optimization
+ % sequence earlier.
+ Instrs = MostInstrs ++ RestInstrs
+ ;
+ Instrs = BlockInstrs ++ RestInstrs
+ ).
+
%-----------------------------------------------------------------------------%
+ % This type is explained in the big comment in the body of
+ % build_frame_block_map below.
+:- type pre_exit_dummy_label_map == map(label, label).
+
% Given an instruction list in which labels mark the start of every
% basic block, divide it up into basic blocks of one of three types:
%
- % - setup blocks, blocks that contain only stack setup instructions
+ % - entry blocks, blocks that contain only stack setup instructions
% (incr_sp and assignment of succip to the bottom stack slot);
%
% - ordinary blocks that contain neither a stack setup nor a
% stack teardown;
%
- % - teardown blocks that remove an existing stack frame.
+ % - exit blocks that remove an existing stack frame.
%
% For such each block, create a frame_block_info structure that gives the
% label starting the block, the instructions in the block, and its
@@ -439,14 +592,18 @@
% and return the sequence of labels of the blocks in their original
% order.
%
-:- pred build_frame_block_map(list(instruction)::in, int::in, list(label)::out,
- maybe(label)::in, maybe(label)::in, proc_label::in,
- frame_block_map::in, frame_block_map::out,
- pred_map::in, pred_map::out, counter::in, counter::out) is det.
-
-build_frame_block_map([], _, [], _, _, _, !BlockMap, !PredMap, !C).
-build_frame_block_map([Instr0 | Instrs0], FrameSize, LabelSeq,
- MaybePrevLabel, FallInto, ProcLabel, !BlockMap, !PredMap, !C) :-
+:- pred build_frame_block_map(list(instruction)::in, En::in,
+ list(label)::out, maybe(label)::in, maybe(label)::in, proc_label::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ pred_map::in, pred_map::out, counter::in, counter::out,
+ pre_exit_dummy_label_map::in, pre_exit_dummy_label_map::out) is det
+ <= block_entry_exit(En, Ex).
+
+build_frame_block_map([], _, [], _, _, _, !BlockMap, !PredMap, !C,
+ !PreExitDummyLabelMap).
+build_frame_block_map([Instr0 | Instrs0], EntryInfo, LabelSeq,
+ MaybePrevLabel, FallInto, ProcLabel, !BlockMap, !PredMap, !C,
+ !PreExitDummyLabelMap) :-
( Instr0 = label(Label) - _ ->
(
MaybePrevLabel = yes(PrevLabel),
@@ -455,76 +612,130 @@
MaybePrevLabel = no
),
(
- frameopt.detstack_setup(Instrs0, _, _, Setup, Others, Remain)
+ detect_entry(Instrs0, EntryInstrs, Instrs1, EntryInfo)
->
- % Create a block with just the Setup instructions in it.
-
- BlockInfo = frame_block_info(Label, [Instr0 | Setup], FallInto,
- [], no, setup),
- list.append(Others, Remain, Instrs1),
+ % Create a block with just the entry instructions in it,
+ % followed by an empty block. The reason why we need the empty
+ % block is that process_frame_delay below doesn't handle any
+ % transition from entry blocks directly to exit blocks.
+ % Fixing that would be complicated; this fix is simpler.
+ %
+ % We would like to put EmptyLabel *after* FallThroughLabel
+ % to make the next invocation of labelopt eliminate EmptyLabel
+ % rather than FallThroughLabel, but doing that would require
+ % updating LabelSeq and BlockMap.
+
+ counter.allocate(EmptyN, !C),
+ EmptyLabel = internal(EmptyN, ProcLabel),
+
+ % The fb_jump_dests and fb_fall_dest fields are only dummies.
+ FallThroughToEmptyInstr = goto(label(EmptyLabel)) - "fall through",
+ BlockInfo = frame_block_info(Label,
+ [Instr0 | EntryInstrs] ++ [FallThroughToEmptyInstr],
+ FallInto, [], no, entry_block(EntryInfo)),
+
+ % Ensure that the left over, non-entry part of the original block
+ % starts with a label, and that the empty block ends with a goto
+ % that falls through to this label.
(
Instrs1 = [Instr1 | _],
- Instr1 = label(_) - _
+ Instr1 = label(NextLabelPrime) - _
->
+ NextLabel = NextLabelPrime,
Instrs2 = Instrs1
;
counter.allocate(N, !C),
- NewLabel = internal(N, ProcLabel),
- NewInstr = label(NewLabel) - "",
- Instrs2 = [NewInstr | Instrs1]
- ),
- build_frame_block_map(Instrs2, FrameSize, LabelSeq0, yes(Label),
- yes(Label), ProcLabel, !BlockMap, !PredMap, !C),
+ NextLabel = internal(N, ProcLabel),
+ NextLabelInstr = label(NextLabel) - "",
+ Instrs2 = [NextLabelInstr | Instrs1]
+ ),
+
+ EmptyLabelInstr = label(EmptyLabel) - "",
+ FallThroughFromEmptyInstr =
+ goto(label(NextLabel)) - "fall through",
+ % The fb_jump_dests and fb_fall_dest fields are only dummies.
+ EmptyBlockType = ordinary_block(block_doesnt_need_frame,
+ is_post_entry_dummy),
+ EmptyBlockInfo = frame_block_info(EmptyLabel,
+ [EmptyLabelInstr, FallThroughFromEmptyInstr],
+ yes(Label), [], no, EmptyBlockType),
+
+ build_frame_block_map(Instrs2, EntryInfo, LabelSeq0,
+ yes(EmptyLabel), yes(EmptyLabel), ProcLabel, !BlockMap,
+ !PredMap, !C, !PreExitDummyLabelMap),
svmap.det_insert(Label, BlockInfo, !BlockMap),
- LabelSeq = [Label | LabelSeq0]
+ svmap.det_insert(EmptyLabel, EmptyBlockInfo, !BlockMap),
+ LabelSeq = [Label, EmptyLabel | LabelSeq0]
;
- frameopt.detstack_teardown(Instrs0, FrameSize, Extra,
- SuccipRestore, Decrsp, Livevals, Goto, Remain)
+ detect_exit(Instrs0, EntryInfo, Extra, ExitInstrs,
+ Remain, ExitInfo)
->
- Teardown = SuccipRestore ++ Decrsp ++ Livevals ++ [Goto],
+ % We always insert an ordinary block before the exit block,
+ % because doing otherwise could lead to a violation of our
+ % invariant that exit blocks never *need* a stack frame
+ % in cases where the redoip of a nondet frame is assigned
+ % the label of the exit block. By inserting a dummy block
+ % before the exit block if necessary, we ensure that the redoip
+ % points not to the exit block but to the ordinary block
+ % preceding it.
+ %
+ % However, having other blocks jump to a pre_exit dummy block
+ % instead of the exit block loses opportunities for optimization.
+ % This is because we may (and typically will) fall into the
+ % pre_exit dummy block from an ordinary block that needs a stack
+ % frame, and this requirement is propagated to the pre_exit dummy
+ % block by propagate_frame_requirement_to_successors, which will
+ % cause propagate_frame_requirement_to_predecessors to propagate
+ % that requirement to blocks that don't actually need a stack
+ % frame. This is why in the is_pre_exit_dummy case below we record
+ % the mapping from the label of the pre_exit dummy block to the
+ % label of the exit block, so that we can alter instructions
+ % that jump to the first label to proceed to the second. Since
+ % there is no code between those two labels (except a dummy goto
+ % instruction that implements the fallthrough), this is safe.
+ % To avoid violating the invariant mentioned at the top of this
+ % comment, we don't substitute labels used as code addresses
+ % in assignments to redoip slots.
+ counter.allocate(N, !C),
+ ExitLabel = internal(N, ProcLabel),
+
+ compute_block_needs_frame(Label, Extra, NeedsFrame),
+ FallThroughInstr = goto(label(ExitLabel)) - "fall through",
+ % The fb_jump_dests and fb_fall_dest fields are only dummies.
(
Extra = [],
- MaybeExtraInfo = no,
- LabelledBlock = [Instr0 | Teardown],
- TeardownLabel = Label,
- TeardownInfo = frame_block_info(TeardownLabel, LabelledBlock,
- FallInto, [], no, teardown(SuccipRestore, Livevals, Goto)),
- NextPrevLabel = Label
+ expect(unify(NeedsFrame, block_doesnt_need_frame), this_file,
+ "build_frame_block_map: [] needs frame"),
+ svmap.det_insert(Label, ExitLabel, !PreExitDummyLabelMap),
+ ExtraBlockType = ordinary_block(NeedsFrame, is_pre_exit_dummy)
;
Extra = [_ | _],
- block_needs_frame(Extra, NeedsFrame),
- ExtraInfo = frame_block_info(Label, [Instr0 | Extra],
- FallInto, [], no, ordinary(NeedsFrame)),
- MaybeExtraInfo = yes(ExtraInfo - Label),
- counter.allocate(N, !C),
- NewLabel = internal(N, ProcLabel),
- NewInstr = label(NewLabel) - "",
- LabelledBlock = [NewInstr | Teardown],
- TeardownLabel = NewLabel,
- TeardownInfo = frame_block_info(TeardownLabel, LabelledBlock,
- yes(Label), [], no,
- teardown(SuccipRestore, Livevals, Goto)),
- svmap.det_insert(NewLabel, Label, !PredMap),
- NextPrevLabel = TeardownLabel
- ),
- build_frame_block_map(Remain, FrameSize, LabelSeq0,
- yes(NextPrevLabel), no, ProcLabel, !BlockMap, !PredMap, !C),
- (
- MaybeExtraInfo = no,
- svmap.det_insert(TeardownLabel, TeardownInfo, !BlockMap),
- LabelSeq = [TeardownLabel | LabelSeq0]
- ;
- MaybeExtraInfo = yes(ExtraInfo2 - ExtraLabel2),
- svmap.det_insert(TeardownLabel, TeardownInfo, !BlockMap),
- svmap.det_insert(ExtraLabel2, ExtraInfo2, !BlockMap),
- LabelSeq = [ExtraLabel2, TeardownLabel | LabelSeq0]
- )
+ ExtraBlockType = ordinary_block(NeedsFrame, is_not_dummy)
+ ),
+ ExtraInstrs = [Instr0 | Extra] ++ [FallThroughInstr],
+ ExtraInfo = frame_block_info(Label, ExtraInstrs, FallInto,
+ [], no, ExtraBlockType),
+
+ ExitLabelInstr = label(ExitLabel) - "",
+ LabelledBlock = [ExitLabelInstr | ExitInstrs],
+ % The fb_jump_dests and fb_fall_dest fields are only dummies.
+ ExitBlockInfo = frame_block_info(ExitLabel, LabelledBlock,
+ yes(Label), [], no, exit_block(ExitInfo)),
+ svmap.det_insert(ExitLabel, Label, !PredMap),
+
+ build_frame_block_map(Remain, EntryInfo, LabelSeq0, yes(ExitLabel),
+ no, ProcLabel, !BlockMap, !PredMap, !C, !PreExitDummyLabelMap),
+
+ svmap.det_insert(ExitLabel, ExitBlockInfo, !BlockMap),
+ svmap.det_insert(Label, ExtraInfo, !BlockMap),
+ LabelSeq = [Label, ExitLabel | LabelSeq0]
;
opt_util.skip_to_next_label(Instrs0, Block, Instrs1),
- block_needs_frame(Block, NeedsFrame),
+ compute_block_needs_frame(Label, Block, NeedsFrame),
BlockInstrs = [Instr0 | Block],
+ % The fb_jump_dests and fb_fall_dest fields are only dummies.
BlockInfo = frame_block_info(Label, BlockInstrs, FallInto,
- [], no, ordinary(NeedsFrame)),
+ [], no, ordinary_block(NeedsFrame, is_not_dummy)),
( list.last(BlockInstrs, LastBlockInstr) ->
LastBlockInstr = LastBlockUinstr - _,
opt_util.can_instr_fall_through(LastBlockUinstr,
@@ -539,8 +750,9 @@
;
NextFallInto = yes(Label)
),
- build_frame_block_map(Instrs1, FrameSize, LabelSeq0,
- yes(Label), NextFallInto, ProcLabel, !BlockMap, !PredMap, !C),
+ build_frame_block_map(Instrs1, EntryInfo, LabelSeq0, yes(Label),
+ NextFallInto, ProcLabel, !BlockMap, !PredMap, !C,
+ !PreExitDummyLabelMap),
svmap.det_insert(Label, BlockInfo, !BlockMap),
LabelSeq = [Label | LabelSeq0]
)
@@ -552,31 +764,28 @@
%-----------------------------------------------------------------------------%
% Does the given code start with a setup of a det stack frame? If yes,
- % return the size of the frame and three instruction sequences,
- % Setup, Others and Remain. Setup is the instruction sequence
+ % return the size of the frame and two instruction sequences,
+ % Setup and Others ++ Remain. Setup is the instruction sequence
% that sets up the det stack frame, Others is a sequence of
% non-interfering instructions that were interspersed with Setup
- % but can be moved after Setup, and Remain is all remaining
- % instructions.
+ % but can be moved after Setup, and Remain is all remaining instructions.
%
-:- pred frameopt.detstack_setup(list(instruction)::in, int::out, string::out,
- list(instruction)::out, list(instruction)::out, list(instruction)::out)
- is semidet.
+:- pred detect_det_entry(list(instruction)::in, list(instruction)::out,
+ list(instruction)::out, det_entry_info::out) is semidet.
-frameopt.detstack_setup(Instrs0, FrameSize, Msg, Setup, Others, Remain) :-
+detect_det_entry(Instrs0, Setup, Others ++ Remain, EntryInfo) :-
opt_util.gather_comments(Instrs0, Others0, Instrs1),
Instrs1 = [SetupInstr1 | Instrs2],
SetupInstr1 = incr_sp(FrameSize, Msg) - _,
- frameopt.detstack_setup_2(Instrs2, FrameSize, SetupInstr2,
- Others0, Others, Remain),
- Setup = [SetupInstr1, SetupInstr2].
-
-:- pred frameopt.detstack_setup_2(list(instruction)::in, int::in,
- instruction::out, list(instruction)::in, list(instruction)::out,
- list(instruction)::out) is semidet.
+ detstack_setup(Instrs2, FrameSize, SetupInstr2, Others0, Others, Remain),
+ Setup = [SetupInstr1, SetupInstr2],
+ EntryInfo = det_entry(Msg, FrameSize).
-frameopt.detstack_setup_2([Instr0 | Instrs0], FrameSize, Setup, !Others,
- Remain) :-
+:- pred detstack_setup(list(instruction)::in, int::in, instruction::out,
+ list(instruction)::in, list(instruction)::out, list(instruction)::out)
+ is semidet.
+
+detstack_setup([Instr0 | Instrs0], FrameSize, Setup, !Others, Remain) :-
( Instr0 = assign(Lval, Rval) - _ ->
(
Lval = stackvar(FrameSize),
@@ -589,20 +798,46 @@
Lval \= stackvar(FrameSize)
->
!:Others = !.Others ++ [Instr0],
- frameopt.detstack_setup_2(Instrs0, FrameSize, Setup, !Others,
- Remain)
+ detstack_setup(Instrs0, FrameSize, Setup, !Others, Remain)
;
fail
)
; Instr0 = comment(_) - _ ->
!:Others = !.Others ++ [Instr0],
- frameopt.detstack_setup_2(Instrs0, FrameSize, Setup, !Others, Remain)
+ detstack_setup(Instrs0, FrameSize, Setup, !Others, Remain)
;
fail
).
+:- pred detect_nondet_entry(list(instruction)::in, list(instruction)::out,
+ list(instruction)::out, nondet_entry_info::out) is semidet.
+
+detect_nondet_entry(Instrs0, [MkframeInstr], Remain, EntryInfo) :-
+ Instrs0 = [MkframeInstr | Remain],
+ MkframeInstr = mkframe(FrameInfo, MaybeRedoip) - _,
+ % We could allow MaybeRedoip to be `no', and search for the instruction
+ % that sets the redoip of the new frame. That is left for future work.
+ MaybeRedoip = yes(Redoip),
+ % If the initial mkframe sets the redoip to something other than do_fail,
+ % then even this entry block needs a stack frame, so frameopt cannot do
+ % anything.
+ Redoip = do_fail,
+ FrameInfo = ordinary_frame(Msg, Size, no),
+ EntryInfo = nondet_entry(Msg, Size, Redoip).
+
%-----------------------------------------------------------------------------%
+:- pred detect_det_exit(list(instruction)::in, det_entry_info::in,
+ list(instruction)::out, list(instruction)::out, list(instruction)::out,
+ det_exit_info::out) is semidet.
+
+detect_det_exit(Instrs0, EntryInfo, Extra, ExitInstrs, Remain, ExitInfo) :-
+ EntryInfo = det_entry(_Msg, FrameSize),
+ detstack_teardown(Instrs0, FrameSize, Extra, SuccipRestore, Decrsp,
+ Livevals, Goto, Remain),
+ ExitInstrs = SuccipRestore ++ Decrsp ++ Livevals ++ [Goto],
+ ExitInfo = det_exit(SuccipRestore, Livevals, Goto).
+
% Does the following block contain a teardown of a det stack frame,
% and a proceed or tailcall? If yes, we return
%
@@ -617,75 +852,76 @@
% any such instructions are returned as Extra. Remain is all the
% instructions after the teardown.
%
-:- pred frameopt.detstack_teardown(list(instruction)::in, int::in,
+:- pred detstack_teardown(list(instruction)::in, int::in,
list(instruction)::out, list(instruction)::out,
list(instruction)::out, list(instruction)::out,
instruction::out, list(instruction)::out) is semidet.
-frameopt.detstack_teardown([Instr0 | Instrs0], FrameSize,
- Extra, Succip, Decrsp, Livevals, Goto, Remain) :-
+detstack_teardown([Instr0 | Instrs0], FrameSize, Extra, SuccipRestore, Decrsp,
+ Livevals, Goto, Remain) :-
(
Instr0 = label(_) - _
->
fail
;
- frameopt.detstack_teardown_2([Instr0 | Instrs0], FrameSize,
- [], ExtraPrime, [], SuccipPrime, [], DecrspPrime,
+ detstack_teardown_2([Instr0 | Instrs0], FrameSize,
+ [], ExtraPrime, [], SuccipRestorePrime, [], DecrspPrime,
[], LivevalsPrime, GotoPrime, RemainPrime)
->
Extra = ExtraPrime,
- Succip = SuccipPrime,
+ SuccipRestore = SuccipRestorePrime,
Decrsp = DecrspPrime,
Livevals = LivevalsPrime,
Goto = GotoPrime,
Remain = RemainPrime
;
- frameopt.detstack_teardown(Instrs0, FrameSize, Extra1, Succip,
- Decrsp, Livevals, Goto, Remain),
+ detstack_teardown(Instrs0, FrameSize, Extra1, SuccipRestore, Decrsp,
+ Livevals, Goto, Remain),
Extra = [Instr0 | Extra1]
).
-:- pred frameopt.detstack_teardown_2(list(instruction)::in, int::in,
+:- pred detstack_teardown_2(list(instruction)::in, int::in,
list(instruction)::in, list(instruction)::out,
list(instruction)::in, list(instruction)::out,
list(instruction)::in, list(instruction)::out,
list(instruction)::in, list(instruction)::out,
instruction::out, list(instruction)::out) is semidet.
-frameopt.detstack_teardown_2(Instrs0, FrameSize,
- !Extra, !Succip, !Decrsp, !Livevals, Goto, Remain) :-
+detstack_teardown_2(Instrs0, FrameSize, !Extra, !SuccipRestore, !Decrsp,
+ !Livevals, Goto, Remain) :-
opt_util.skip_comments(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
Instr1 = Uinstr1 - _,
+ % XXX allow other instruction types in Extras, e.g. incr_hp
(
Uinstr1 = assign(Lval, Rval),
(
Lval = succip,
Rval = lval(stackvar(FrameSize))
->
- !.Succip = [],
+ !.SuccipRestore = [],
!.Decrsp = [],
- !:Succip = [Instr1],
- frameopt.detstack_teardown_2(Instrs2, FrameSize, !Extra, !Succip,
+ !:SuccipRestore = [Instr1],
+ detstack_teardown_2(Instrs2, FrameSize, !Extra, !SuccipRestore,
!Decrsp, !Livevals, Goto, Remain)
;
- opt_util.lval_refers_stackvars(Lval, no),
- opt_util.rval_refers_stackvars(Rval, no),
- list.append(!.Extra, [Instr1], !:Extra),
- frameopt.detstack_teardown_2(Instrs2, FrameSize, !Extra, !Succip,
+ opt_util.lval_refers_stackvars(Lval) = no,
+ opt_util.rval_refers_stackvars(Rval) = no,
+ !:Extra = !.Extra ++ [Instr1],
+ detstack_teardown_2(Instrs2, FrameSize, !Extra, !SuccipRestore,
!Decrsp, !Livevals, Goto, Remain)
)
;
Uinstr1 = decr_sp(FrameSize),
!.Decrsp = [],
!:Decrsp = [Instr1],
- frameopt.detstack_teardown_2(Instrs2, FrameSize, !Extra, !Succip,
+ detstack_teardown_2(Instrs2, FrameSize, !Extra, !SuccipRestore,
!Decrsp, !Livevals, Goto, Remain)
;
Uinstr1 = livevals(_),
!.Livevals = [],
!:Livevals = [Instr1],
- frameopt.detstack_teardown_2(Instrs2, FrameSize, !Extra, !Succip,
+ detstack_teardown_2(Instrs2, FrameSize, !Extra, !SuccipRestore,
!Decrsp, !Livevals, Goto, Remain)
;
Uinstr1 = goto(_),
@@ -694,17 +930,151 @@
Remain = Instrs2
).
+:- pred detect_nondet_exit(list(instruction)::in, nondet_entry_info::in,
+ list(instruction)::out, list(instruction)::out, list(instruction)::out,
+ nondet_exit_info::out) is semidet.
+
+detect_nondet_exit(Instrs0, _EntryInfo, Extra, ExitInstrs, Remain, ExitInfo) :-
+ nondetstack_teardown(Instrs0, Extra, SuccipRestore, Maxfr, Curfr,
+ Livevals, Goto, GotoTarget, Remain),
+ ExitInstrs = SuccipRestore ++ Maxfr ++ Curfr ++ Livevals ++ [Goto],
+ (
+ Curfr = [],
+ % MR_succeed refers to the current stack frame, so it is valid
+ % only if we haven't thrown away the stack frame yet by resetting
+ % curfr.
+ Maxfr = [],
+ SuccipRestore = [],
+ GotoTarget = do_succeed(_),
+ ExitInfo = nondet_plain_exit(Livevals, Goto)
+ ;
+ Curfr = [CurfrInstr],
+ % If we *have* thrown away the current stack frame, we can exit
+ % only via tailcall, and in that case we ought to have also reset
+ % maxfr and succip.
+ Maxfr = [MaxfrInstr],
+ SuccipRestore = [SuccipRestoreInstr],
+ ( GotoTarget = label(entry(_, _))
+ ; GotoTarget = imported(_)
+ ),
+ ExitInfo = nondet_teardown_exit(SuccipRestoreInstr,
+ MaxfrInstr, CurfrInstr, Livevals, Goto)
+ ).
+
+ % Does the following block contain a succeed from a nondet stack frame?
+ % If yes, we return
+ %
+ % - the livevals instruction (if any) as Livevals
+ % - the goto instruction as Goto
+ %
+ % These may be preceded by instructions that do not access the stack;
+ % any such instructions are returned as Extra. Remain is all the
+ % instructions after the succeed.
+ %
+:- pred nondetstack_teardown(list(instruction)::in, list(instruction)::out,
+ list(instruction)::out, list(instruction)::out,
+ list(instruction)::out, list(instruction)::out,
+ instruction::out, code_addr::out, list(instruction)::out) is semidet.
+
+nondetstack_teardown([Instr0 | Instrs0], Extra, SuccipRestore, Maxfr, Curfr,
+ Livevals, Goto, GotoTarget, Remain) :-
+ (
+ Instr0 = label(_) - _
+ ->
+ fail
+ ;
+ nondetstack_teardown_2([Instr0 | Instrs0], [], ExtraPrime,
+ [], SuccipRestorePrime, [], MaxfrPrime, [], CurfrPrime,
+ [], LivevalsPrime, GotoPrime, GotoTargetPrime, RemainPrime)
+ ->
+ Extra = ExtraPrime,
+ SuccipRestore = SuccipRestorePrime,
+ Maxfr = MaxfrPrime,
+ Curfr = CurfrPrime,
+ Livevals = LivevalsPrime,
+ Goto = GotoPrime,
+ GotoTarget = GotoTargetPrime,
+ Remain = RemainPrime
+ ;
+ nondetstack_teardown(Instrs0, Extra1, SuccipRestore, Maxfr, Curfr,
+ Livevals, Goto, GotoTarget, Remain),
+ Extra = [Instr0 | Extra1]
+ ).
+
+:- pred nondetstack_teardown_2(list(instruction)::in,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ instruction::out, code_addr::out, list(instruction)::out) is semidet.
+
+nondetstack_teardown_2(Instrs0, !Extra, !SuccipRestore, !Maxfr, !Curfr,
+ !Livevals, Goto, GotoTarget, Remain) :-
+ opt_util.skip_comments(Instrs0, Instrs1),
+ Instrs1 = [Instr1 | Instrs2],
+ Instr1 = Uinstr1 - _,
+ % XXX allow other instruction types in Extras, e.g. incr_hp
+ (
+ Uinstr1 = assign(Lval, Rval),
+ (
+ Lval = succip,
+ Rval = lval(succip_slot(lval(curfr))),
+ !.SuccipRestore = [],
+ % The restore instruction is valid only if curfr hasn't been
+ % modified yet.
+ !.Curfr = []
+ ->
+ !:SuccipRestore = [Instr1]
+ ;
+ Lval = maxfr,
+ Rval = lval(prevfr_slot(lval(curfr))),
+ !.Maxfr = [],
+ % The restore instruction is valid only if curfr hasn't been
+ % modified yet.
+ !.Curfr = []
+ ->
+ !:Maxfr = [Instr1]
+ ;
+ Lval = curfr,
+ Rval = lval(succfr_slot(lval(curfr))),
+ !.Curfr = []
+ ->
+ !:Curfr = [Instr1]
+ ;
+ opt_util.lval_refers_stackvars(Lval) = no,
+ opt_util.rval_refers_stackvars(Rval) = no
+ ->
+ !:Extra = !.Extra ++ [Instr1]
+ ;
+ fail
+ ),
+ nondetstack_teardown_2(Instrs2, !Extra, !SuccipRestore, !Maxfr, !Curfr,
+ !Livevals, Goto, GotoTarget, Remain)
+ ;
+ Uinstr1 = livevals(_),
+ !.Livevals = [],
+ !:Livevals = [Instr1],
+ nondetstack_teardown_2(Instrs2, !Extra, !SuccipRestore, !Maxfr, !Curfr,
+ !Livevals, Goto, GotoTarget, Remain)
+ ;
+ Uinstr1 = goto(GotoTarget),
+ Goto = Instr1,
+ Remain = Instrs2
+ ).
+
%-----------------------------------------------------------------------------%
% Does an ordinary block with the given content need a stack frame?
%
-:- pred block_needs_frame(list(instruction)::in, block_needs_frame::out) is det.
+:- pred compute_block_needs_frame(label::in, list(instruction)::in,
+ block_needs_frame(needs_frame_reason)::out) is det.
-block_needs_frame(Instrs, NeedsFrame) :-
- opt_util.block_refers_stackvars(Instrs, ReferStackVars),
+compute_block_needs_frame(Label, Instrs, NeedsFrame) :-
+ opt_util.block_refers_to_stack(Instrs) = ReferStackVars,
(
ReferStackVars = yes,
- NeedsFrame = block_needs_frame
+ NeedsFrame = block_needs_frame(code_needs_frame(Label))
;
ReferStackVars = no,
(
@@ -728,9 +1098,13 @@
;
NeedStack = yes
)
+ ;
+ % If we assign to the succip register, then we need the saved
+ % copy of the original return address in the stack frame.
+ Uinstr = assign(succip, _)
)
->
- NeedsFrame = block_needs_frame
+ NeedsFrame = block_needs_frame(code_needs_frame(Label))
;
NeedsFrame = block_doesnt_need_frame
)
@@ -749,28 +1123,32 @@
% the stack frame for recursive tail calls once it has been set up
% by the initial entry to the procedure, or delaying the creation of
% the stack frame as long as possible. We want to do the former
- % whenever we find at least one teardown block that branches back
+ % whenever we find at least one exit block that branches back
% to the beginning of the procedure; in such cases we return the
% the label starting the procedure and the label that should replace
% it in tailcalls that avoid the stack teardown, which is the label
% immediately after the initial stack setup block.
%
-:- pred analyze_block_map(list(label)::in,
- frame_block_map::in, frame_block_map::out, maybe(pair(label))::out) is det.
+:- pred analyze_block_map(list(label)::in, pre_exit_dummy_label_map::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ maybe(pair(label))::out) is det <= block_entry_exit(En, Ex).
-analyze_block_map(LabelSeq, !BlockMap, KeepFrameData) :-
+analyze_block_map(LabelSeq, PreExitDummyLabelMap, !BlockMap, KeepFrameData) :-
(
LabelSeq = [FirstLabel, SecondLabel | _],
map.search(!.BlockMap, FirstLabel, FirstBlockInfo),
- FirstBlockInfo = frame_block_info(FirstLabel, _, _, _, _, setup)
+ FirstBlockInfo = frame_block_info(FirstLabel, _, _, _, _, BlockType),
+ BlockType = entry_block(_)
->
- analyze_block_map_2(LabelSeq, FirstLabel, !BlockMap,
- block_doesnt_need_frame, AnyBlockNeedsFrame, no, JumpToStart),
+ ProcLabel = get_proc_label(FirstLabel),
+ analyze_block_map_2(LabelSeq, FirstLabel, ProcLabel,
+ PreExitDummyLabelMap, !BlockMap, no, AnyBlockNeedsFrame,
+ no, JumpToStart),
% We want to apply the transformation to keep the stack frame only if
% (a) some block actually needs the stack frame, and (b) there is at
% least one block that jumps back to the start of the procedure.
(
- AnyBlockNeedsFrame = block_needs_frame,
+ AnyBlockNeedsFrame = yes,
JumpToStart = yes
->
KeepFrameData = yes(FirstLabel - SecondLabel)
@@ -781,30 +1159,82 @@
unexpected(this_file, "analyze_block_map: bad data")
).
-:- pred analyze_block_map_2(list(label)::in, label::in,
- frame_block_map::in, frame_block_map::out,
- block_needs_frame::in, block_needs_frame::out, bool::in, bool::out) is det.
-
-analyze_block_map_2([], _, !BlockMap, !AnyBlockNeedsFrame, !KeepFrame).
-analyze_block_map_2([Label | Labels], FirstLabel, !BlockMap,
- !AnyBlockNeedsFrame, !JumpToStart) :-
+:- pred analyze_block_map_2(list(label)::in, label::in, proc_label::in,
+ pre_exit_dummy_label_map::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ bool::in, bool::out, bool::in, bool::out) is det
+ <= block_entry_exit(En, Ex).
+
+analyze_block_map_2([], _, _, _, !BlockMap, !AnyBlockNeedsFrame, !KeepFrame).
+analyze_block_map_2([Label | Labels], FirstLabel, ProcLabel,
+ PreExitDummyLabelMap, !BlockMap, !AnyBlockNeedsFrame, !JumpToStart) :-
+ analyze_block(Label, Labels, FirstLabel, ProcLabel, PreExitDummyLabelMap,
+ !BlockMap, !AnyBlockNeedsFrame, !JumpToStart),
+ analyze_block_map_2(Labels, FirstLabel, ProcLabel, PreExitDummyLabelMap,
+ !BlockMap, !AnyBlockNeedsFrame, !JumpToStart).
+
+:- pred analyze_block(label::in, list(label)::in, label::in, proc_label::in,
+ pre_exit_dummy_label_map::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ bool::in, bool::out, bool::in, bool::out) is det
+ <= block_entry_exit(En, Ex).
+
+analyze_block(Label, FollowingLabels, FirstLabel, ProcLabel,
+ PreExitDummyLabelMap, !BlockMap, !AnyBlockNeedsFrame, !JumpToStart) :-
map.lookup(!.BlockMap, Label, BlockInfo0),
- BlockInfo0 = frame_block_info(BlockLabel, BlockInstrs, FallInto,
+ BlockInfo0 = frame_block_info(BlockLabel, BlockInstrs0, FallInto,
_, _, Type),
- ( Type = ordinary(block_needs_frame) ->
- !:AnyBlockNeedsFrame = block_needs_frame
+ ( Type = ordinary_block(block_needs_frame(_), _) ->
+ !:AnyBlockNeedsFrame = yes
;
true
),
(
Label = BlockLabel, % sanity check
- list.last(BlockInstrs, LastInstr)
+ list.split_last_det(BlockInstrs0, AllButLastInstrs, LastInstr0)
->
- LastInstr = LastUinstr - _,
- possible_targets(LastUinstr, SideLabels, _SideCodeAddrs),
+ LastInstr0 = LastUinstr0 - Comment,
+ ( LastUinstr0 = goto(GotoTarget0) ->
+ replace_labels_code_addr(GotoTarget0, PreExitDummyLabelMap,
+ GotoTarget),
+ LastUinstr = goto(GotoTarget),
+ LastInstr = LastUinstr - Comment,
+ BlockInstrs = AllButLastInstrs ++ [LastInstr]
+ ; LastUinstr0 = if_val(Rval, GotoTarget0) ->
+ replace_labels_code_addr(GotoTarget0, PreExitDummyLabelMap,
+ GotoTarget),
+ LastUinstr = if_val(Rval, GotoTarget),
+ LastInstr = LastUinstr - Comment,
+ BlockInstrs = AllButLastInstrs ++ [LastInstr]
+ ; LastUinstr0 = computed_goto(Rval, GotoTargets0) ->
+ replace_labels_label_list(GotoTargets0, PreExitDummyLabelMap,
+ GotoTargets),
+ LastUinstr = computed_goto(Rval, GotoTargets),
+ LastInstr = LastUinstr - Comment,
+ BlockInstrs = AllButLastInstrs ++ [LastInstr]
+ ; LastUinstr0 = pragma_c(D, Comps0, MC, FNL, FL, FOL, NF0, S, MD) ->
+ (
+ NF0 = no,
+ NF = no,
+ Comps0 = Comps
+ ;
+ NF0 = yes(NFLabel0),
+ replace_labels_label(NFLabel0, PreExitDummyLabelMap, NFLabel),
+ NF = yes(NFLabel),
+ replace_labels_comps(Comps0, PreExitDummyLabelMap, Comps)
+ ),
+ LastUinstr = pragma_c(D, Comps, MC, FNL, FL, FOL, NF, S, MD),
+ LastInstr = LastUinstr - Comment,
+ BlockInstrs = AllButLastInstrs ++ [LastInstr]
+ ;
+ LastUinstr = LastUinstr0,
+ BlockInstrs = BlockInstrs0
+ ),
+ possible_targets(LastUinstr, SideLabels0, _SideCodeAddrs),
+ list.filter(local_label(ProcLabel), SideLabels0, SideLabels),
(
opt_util.can_instr_fall_through(LastUinstr, yes),
- Labels = [NextLabel | _]
+ FollowingLabels = [NextLabel | _]
->
MaybeFallThrough = yes(NextLabel)
;
@@ -824,8 +1254,13 @@
BlockInfo = frame_block_info(BlockLabel, BlockInstrs, FallInto,
SideLabels, MaybeFallThrough, Type),
svmap.det_update(Label, BlockInfo, !BlockMap),
- analyze_block_map_2(Labels, FirstLabel, !BlockMap, !AnyBlockNeedsFrame,
- !JumpToStart).
+ find_redoip_labels(BlockInstrs, ProcLabel, [], RedoipLabels),
+ list.foldl(mark_redoip_label, RedoipLabels, !BlockMap).
+
+:- pred local_label(proc_label::in, label::in) is semidet.
+
+local_label(ProcLabel, entry(_, ProcLabel)).
+local_label(ProcLabel, internal(_, ProcLabel)).
% The form of a label used in a tailcall may be different from
% the form used in the initial label. The initial label may be
@@ -839,8 +1274,9 @@
%
:- pred matching_label_ref(label::in, label::in) is semidet.
-matching_label_ref(entry(FirstLabelType, ProcLabel),
- entry(GotoLabelType, ProcLabel)) :-
+matching_label_ref(FirstLabel, GotoLabel) :-
+ FirstLabel = entry(FirstLabelType, ProcLabel),
+ GotoLabel = entry(GotoLabelType, ProcLabel),
matching_entry_type(FirstLabelType, GotoLabelType).
:- pred matching_entry_type(entry_label_type::in, entry_label_type::in)
@@ -853,10 +1289,46 @@
matching_entry_type(local, local).
matching_entry_type(c_local, c_local).
+:- pred find_redoip_labels(list(instruction)::in, proc_label::in,
+ list(label)::in, list(label)::out) is det.
+
+find_redoip_labels([], _, !RedoipLabels).
+find_redoip_labels([Instr | Instrs], ProcLabel, !RedoipLabels) :-
+ Instr = Uinstr - _,
+ (
+ Uinstr = assign(redoip_slot(_), const(code_addr_const(label(Label)))),
+ get_proc_label(Label) = ProcLabel
+ ->
+ !:RedoipLabels = [Label | !.RedoipLabels]
+ ;
+ true
+ ),
+ find_redoip_labels(Instrs, ProcLabel, !RedoipLabels).
+
+:- pred mark_redoip_label(label::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out) is det.
+
+mark_redoip_label(Label, !BlockMap) :-
+ map.lookup(!.BlockMap, Label, BlockInfo0),
+ BlockType0 = BlockInfo0 ^ fb_type,
+ (
+ BlockType0 = entry_block(_),
+ unexpected(this_file, "mark_redoip_label: entry_block")
+ ;
+ BlockType0 = ordinary_block(_, MaybeDummy),
+ Reason = redoip_label,
+ BlockType = ordinary_block(block_needs_frame(Reason), MaybeDummy),
+ BlockInfo = BlockInfo0 ^ fb_type := BlockType,
+ svmap.det_update(Label, BlockInfo, !BlockMap)
+ ;
+ BlockType0 = exit_block(_),
+ unexpected(this_file, "mark_redoip_label: exit_block")
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- func can_clobber_succip(list(label), frame_block_map) = bool.
+:- func can_clobber_succip(list(label), frame_block_map(_, _)) = bool.
can_clobber_succip([], _BlockMap) = no.
can_clobber_succip([Label | Labels], BlockMap) = CanClobberSuccip :-
@@ -888,7 +1360,7 @@
% should replace it in tailcalls that avoid the stack teardown.
%
:- pred keep_frame_transform(list(label)::in, label::in, label::in, bool::in,
- frame_block_map::in, frame_block_map::out) is det.
+ det_frame_block_map::in, det_frame_block_map::out) is det.
keep_frame_transform([], _, _, _, !BlockMap).
keep_frame_transform([Label | Labels], FirstLabel, SecondLabel,
@@ -896,7 +1368,7 @@
map.lookup(!.BlockMap, Label, BlockInfo0),
(
BlockInfo0 = frame_block_info(Label, OrigInstrs, FallInto, [_], no,
- teardown(Succip, Livevals, Goto)),
+ exit_block(det_exit(Succip, Livevals, Goto))),
Goto = goto(label(GotoLabel)) - Comment,
matching_label_ref(FirstLabel, GotoLabel)
->
@@ -911,17 +1383,19 @@
),
string.append(Comment, " (keeping frame)", NewComment),
NewGoto = goto(label(SecondLabel)) - NewComment,
- list.append(Livevals, [NewGoto], LivevalsGoto),
+ LivevalsGoto = Livevals ++ [NewGoto],
(
CanClobberSuccip = yes,
- list.append(Succip, LivevalsGoto, BackInstrs)
+ BackInstrs = Succip ++ LivevalsGoto
;
CanClobberSuccip = no,
BackInstrs = LivevalsGoto
),
Instrs = [OrigLabelInstr | BackInstrs],
- BlockInfo = frame_block_info(Label, Instrs, FallInto,
- [SecondLabel], no, ordinary(block_needs_frame)),
+ Reason = keep_frame,
+ BlockType = ordinary_block(block_needs_frame(Reason), is_not_dummy),
+ BlockInfo = frame_block_info(Label, Instrs, FallInto, [SecondLabel],
+ no, BlockType),
map.det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
;
true
@@ -929,34 +1403,19 @@
keep_frame_transform(Labels, FirstLabel, SecondLabel, CanClobberSuccip,
!BlockMap).
-% list.split_last_det
-:- pred pick_last(list(T)::in, list(T)::out, T::out) is det.
-
-pick_last([], _, _) :-
- unexpected(this_file, "empty list in pick_last").
-pick_last([First | Rest], NonLast, Last) :-
- (
- Rest = [],
- NonLast = [],
- Last = First
- ;
- Rest = [_ | _],
- pick_last(Rest, NonLast0, Last),
- NonLast = [First | NonLast0]
- ).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Check that we can use the delay_frame transformation. This requires
% that only the first block is of the setup type.
%
-:- pred can_delay_frame(list(label)::in, frame_block_map::in) is semidet.
+:- pred can_delay_frame(list(label)::in, frame_block_map(En, Ex)::in)
+ is semidet.
can_delay_frame([], _).
can_delay_frame([Label | _Labels], BlockMap) :-
map.lookup(BlockMap, Label, BlockInfo),
- BlockInfo ^ fb_type = setup.
+ BlockInfo ^ fb_type = entry_block(_).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -985,17 +1444,19 @@
% full jump optimization to duplicate code as necessary to optimize away
% the goto.
%
-:- type setup_par_map ---> setup_par_map(map(label, label)).
+:- type setup_par_map
+ ---> setup_par_map(map(label, label)).
- % map.search(TeardownParMap, L, ParallelL should be true if L starts
- % a teardown block and ParallelL starts a copy of L's block from which
+ % map.search(ExitParMap, L, ParallelL should be true if L starts
+ % an exit block and ParallelL starts a copy of L's block from which
% the instructions to tear down the stack frame have been deleted.
% If the block immediately before L does not have a stack frame,
% we put ParallelL before L. If it does, we put ParallelL after L.
% since neither L nor ParallelL can fall through, we don't need any gotos
% to jump around blocks.
%
-:- type teardown_par_map ---> teardown_par_map(map(label, label)).
+:- type exit_par_map
+ ---> exit_par_map(map(label, label)).
%-----------------------------------------------------------------------------%
@@ -1003,7 +1464,7 @@
---> can_transform
; cannot_transform.
- % XXX needs updating
+ % XXX This documentation needs updating.
% The optimization of delaying the creation of stack frames as long
% as possible is in three main phases:
@@ -1029,8 +1490,8 @@
% - The second phase gets rid of the frame setup code in the initial
% setup block, but its main task is to transform ordinary blocks that
% do not need a frame. Every block that is a successor of such a block,
- % whether via jump or fallthrough, will be an ordinary block or a
- % teardown block.
+ % whether via jump or fallthrough, will be an ordinary block or an
+ % exit block.
%
% - If the successor is an ordinary block that doesn't need a frame,
% the transfer of control remains as before.
@@ -1044,11 +1505,11 @@
% of B; the creation of SetupB's block is left to the third phase.
% The correspondence between B and SetupB is recorded in SetupParMap.
%
- % - If the successor is a teardown block B, then we modify the transfer
+ % - If the successor is an exit block B, then we modify the transfer
% of control to jump a new label ParallelB, whose block has the same
% code as B's block, except for the deletion of the instructions that
% tear down the (nonexistent along this path) stack frame. The
- % correspondence between B and ParallelB is recorded in TeardownParMap.
+ % correspondence between B and ParallelB is recorded in ExitParMap.
%
% - The third phase has the job of adding the pieces of code whose
% existence is assumed by the modified code output by the second stage.
@@ -1060,18 +1521,19 @@
% jump around SetupB's block if previously it fell through to B.)
%
% For every teardown block that can jumped to from someplace that does
- % not have a stack frame (i.e. for every B in TeardownParMap), we create
+ % not have a stack frame (i.e. for every B in ExitParMap), we create
% a new block that is a clone of B with the stack teardown deleted.
% Whether we put B or ParallelB first depends on whether the immediately
% previous block has a stack frame or not.
%
-:- pred delay_frame_transform(list(label)::in, list(label)::out, int::in,
- string::in, proc_label::in, pred_map::in, counter::in, counter::out,
- frame_block_map::in, frame_block_map::out, globals::in,
- list(instruction)::out, can_transform::out) is det.
+:- pred delay_frame_transform(list(label)::in, list(label)::out,
+ En::in, proc_label::in, pred_map::in, counter::in, counter::out,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out, globals::in,
+ list(instruction)::out, list(instruction)::out, can_transform::out) is det
+ <= block_entry_exit(En, Ex).
-delay_frame_transform(!LabelSeq, FrameSize, Msg, ProcLabel, PredMap, !C,
- !BlockMap, Globals, NewComments, CanTransform) :-
+delay_frame_transform(!LabelSeq, EntryInfo, ProcLabel, PredMap, !C,
+ !BlockMap, Globals, TransformComments, DescComments, CanTransform) :-
some [!OrdNeedsFrame, !CanTransform, !PropagationStepsLeft] (
!:OrdNeedsFrame = map.init,
!:CanTransform = can_transform,
@@ -1086,54 +1548,55 @@
propagate_frame_requirement_to_predecessors(PredQueue, !.BlockMap,
RevMap, !OrdNeedsFrame, !.PropagationStepsLeft, _, !CanTransform),
(
- !.CanTransform = cannot_transform,
+ !.CanTransform = cannot_transform
% The delay frame optimization is not applicable; our caller will
% ignore all the other output arguments.
- NewComments = []
;
!.CanTransform = can_transform,
+ process_frame_delay(!.LabelSeq, !.OrdNeedsFrame, ProcLabel, !C,
+ !BlockMap, setup_par_map(map.init), SetupParMap,
+ exit_par_map(map.init), ExitParMap),
+ create_parallels(!LabelSeq, EntryInfo, ProcLabel, !C,
+ !.OrdNeedsFrame, SetupParMap, ExitParMap, PredMap, !BlockMap)
+ ),
globals.lookup_bool_option(Globals, frameopt_comments,
FrameoptComments),
(
FrameoptComments = no,
- NewComments = []
+ TransformComments = [],
+ DescComments = []
;
FrameoptComments = yes,
- FirstComment = comment("delaying stack frame") - "",
+ TransformComments = [comment("delaying stack frame") - ""],
list.map(describe_block(!.BlockMap, !.OrdNeedsFrame,
- PredMap, ProcLabel), !.LabelSeq, BlockComments),
- NewComments = [FirstComment | BlockComments]
- ),
- process_frame_delay(!.LabelSeq, !.OrdNeedsFrame, ProcLabel, !C,
- !BlockMap, setup_par_map(map.init), SetupParMap,
- teardown_par_map(map.init), TeardownParMap),
- create_parallels(!LabelSeq, FrameSize, Msg, ProcLabel, !C,
- !.OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap,
- !BlockMap)
+ PredMap, ProcLabel), !.LabelSeq, DescComments)
),
CanTransform = !.CanTransform
).
% We want to stop the transformation if we need more than this many
- % propagation steps. For such large predicates (write_ordinary_term
- % in , any performance benefit
- % of frameopt is unlikely to be noticeable.
+ % propagation steps. For such large predicates (e.g. write_ordinary_term)
+ % any performance benefit from frameopt is unlikely to be noticeable.
%
:- func max_propagation_steps = int.
max_propagation_steps = 10000.
-:- pred key_block_needs_frame(pair(label, block_needs_frame)::in, label::out)
- is semidet.
+:- pred key_block_needs_frame(
+ pair(label, block_needs_frame(needs_frame_reasons))::in,
+ pair(needs_frame_reason, label)::out) is semidet.
-key_block_needs_frame(Label - block_needs_frame, Label).
+key_block_needs_frame(Label - block_needs_frame(Reasons),
+ frontier(Label, Reasons) - Label).
%-----------------------------------------------------------------------------%
% Maps the label of each ordinary block to a bool that says whether
% the block needs a stack frame or not.
%
-:- type ord_needs_frame == map(label, block_needs_frame).
+:- type ord_needs_frame == map(label, block_needs_frame(needs_frame_reasons)).
+
+:- type prop_queue == queue(pair(needs_frame_reason, label)).
% Initialize the data structures for the delaying operation.
% The first is a map showing the predecessors of each block,
@@ -1144,8 +1607,8 @@
% This predicate implements the first part of the first phase of
% delay_frame_transform.
%
-:- pred delay_frame_init(list(label)::in, frame_block_map::in,
- rev_map::in, rev_map::out, queue(label)::in, queue(label)::out,
+:- pred delay_frame_init(list(label)::in, frame_block_map(En, Ex)::in,
+ rev_map::in, rev_map::out, prop_queue::in, prop_queue::out,
ord_needs_frame::in, ord_needs_frame::out) is det.
delay_frame_init([], _, !RevMap, !Queue, !OrdNeedsFrame).
@@ -1154,18 +1617,21 @@
map.lookup(BlockMap, Label, BlockInfo),
BlockType = BlockInfo ^ fb_type,
(
- BlockType = setup
+ BlockType = entry_block(_)
;
- BlockType = ordinary(NeedsFrame),
- svmap.det_insert(Label, NeedsFrame, !OrdNeedsFrame),
+ BlockType = ordinary_block(NeedsFrame, _),
(
- NeedsFrame = block_doesnt_need_frame
+ NeedsFrame = block_doesnt_need_frame,
+ svmap.det_insert(Label, block_doesnt_need_frame, !OrdNeedsFrame)
;
- NeedsFrame = block_needs_frame,
- svqueue.put(Label, !Queue)
+ NeedsFrame = block_needs_frame(Reason),
+ Reasons = make_singleton_set(Reason),
+ svmap.det_insert(Label, block_needs_frame(Reasons),
+ !OrdNeedsFrame),
+ svqueue.put(Reason - Label, !Queue)
)
;
- BlockType = teardown(_, _, _)
+ BlockType = exit_block(_)
),
rev_map_side_labels(successors(BlockInfo), Label, !RevMap),
delay_frame_init(Labels, BlockMap, !RevMap, !Queue, !OrdNeedsFrame).
@@ -1186,6 +1652,21 @@
%-----------------------------------------------------------------------------%
+:- pred ord_needs_frame(label::in, needs_frame_reason::in,
+ ord_needs_frame::in, ord_needs_frame::out) is det.
+
+ord_needs_frame(Label, CurReason, !OrdNeedsFrame) :-
+ map.lookup(!.OrdNeedsFrame, Label, NeedsFrame0),
+ (
+ NeedsFrame0 = block_doesnt_need_frame,
+ Reasons = make_singleton_set(CurReason),
+ svmap.det_update(Label, block_needs_frame(Reasons), !OrdNeedsFrame)
+ ;
+ NeedsFrame0 = block_needs_frame(Reasons0),
+ set.insert(Reasons0, CurReason, Reasons),
+ svmap.det_update(Label, block_needs_frame(Reasons), !OrdNeedsFrame)
+ ).
+
% Given a queue of labels representing ordinary blocks that must have
% a stack frame, propagate the requirement for a stack frame to all
% other ordinary blocks that are their successors.
@@ -1193,8 +1674,8 @@
% This predicate implements the second part of the first phase of
% delay_frame_transform.
%
-:- pred propagate_frame_requirement_to_successors(queue(label)::in,
- frame_block_map::in, ord_needs_frame::in, ord_needs_frame::out,
+:- pred propagate_frame_requirement_to_successors(prop_queue::in,
+ frame_block_map(En, Ex)::in, ord_needs_frame::in, ord_needs_frame::out,
set(label)::in, int::in, int::out, can_transform::in, can_transform::out)
is det.
@@ -1204,31 +1685,34 @@
true
; !.PropagationStepsLeft < 0 ->
!:CanTransform = cannot_transform
- ; svqueue.get(Label, !Queue) ->
+ ; svqueue.get(Reason - Label, !Queue) ->
!:PropagationStepsLeft = !.PropagationStepsLeft - 1,
svset.insert(Label, !AlreadyProcessed),
map.lookup(BlockMap, Label, BlockInfo),
BlockType = BlockInfo ^ fb_type,
(
- BlockType = ordinary(_),
- svmap.det_update(Label, block_needs_frame, !OrdNeedsFrame),
+ BlockType = ordinary_block(_, _MaybeDummy),
+ ord_needs_frame(Label, Reason, !OrdNeedsFrame),
% Putting an already processed label into the queue could
% lead to an infinite loop. However, we cannot decide whether
- % a label has been processed by checking whether !.OrdNeedsFrame
- % maps Label to yes, since !.OrdNeedsFrame doesn't mention setup
- % frames, and we want to set !:CanTransform to no if any successor
- % is a setup frame. We cannot assume that successors not in
- % !.OrdNeedsFrame should set !:CanTransform to no either, since
- % we don't want to do that for teardown frames.
+ % a label has been processed by checking whether
+ % !.OrdNeedsFrame maps Label to yes, since !.OrdNeedsFrame
+ % doesn't mention setup frames, and we want to set
+ % !:CanTransform to no if any successor is a setup frame.
+ % We cannot assume that successors not in !.OrdNeedsFrame
+ % should set !:CanTransform to no either, since we don't want
+ % to do that for exit frames.
list.filter(set.contains(!.AlreadyProcessed),
successors(BlockInfo), _, UnprocessedSuccessors),
- svqueue.put_list(UnprocessedSuccessors, !Queue)
+ list.map(pair_with(succ_propagated(Label, Reason)),
+ UnprocessedSuccessors, PairedUnprocessedSuccessors),
+ svqueue.put_list(PairedUnprocessedSuccessors, !Queue)
;
- BlockType = setup,
+ BlockType = entry_block(_),
!:CanTransform = cannot_transform
;
- BlockType = teardown(_, _, _)
- % Teardown frames never *need* stack frames.
+ BlockType = exit_block(_)
+ % Exit blocks never *need* stack frames.
),
propagate_frame_requirement_to_successors(!.Queue, BlockMap,
!OrdNeedsFrame, !.AlreadyProcessed, !PropagationStepsLeft,
@@ -1240,8 +1724,8 @@
% This predicate implements the third part of the first phase of
% delay_frame_transform; see the documentation there.
%
-:- pred propagate_frame_requirement_to_predecessors(queue(label)::in,
- frame_block_map::in, rev_map::in,
+:- pred propagate_frame_requirement_to_predecessors(prop_queue::in,
+ frame_block_map(En, Ex)::in, rev_map::in,
ord_needs_frame::in, ord_needs_frame::out, int::in, int::out,
can_transform::in, can_transform::out) is det.
@@ -1251,7 +1735,7 @@
true
; !.PropagationStepsLeft < 0 ->
!:CanTransform = cannot_transform
- ; svqueue.get(Label, !Queue) ->
+ ; svqueue.get(Reason - Label, !Queue) ->
!:PropagationStepsLeft = !.PropagationStepsLeft - 1,
( map.search(RevMap, Label, PredecessorsPrime) ->
Predecessors = PredecessorsPrime
@@ -1261,39 +1745,43 @@
% that sets up the resumption point saves the address of Label on
% the stack, and thus is already known to need a stack frame.
Predecessors = [],
- svmap.det_update(Label, block_needs_frame, !OrdNeedsFrame)
+ ord_needs_frame(Label, Reason, !OrdNeedsFrame)
),
list.filter(all_successors_need_frame(BlockMap, !.OrdNeedsFrame),
Predecessors, NowNeedFrameLabels),
- list.foldl2(record_frame_need(BlockMap), NowNeedFrameLabels,
+ list.foldl2(record_frame_need(BlockMap, Reason), NowNeedFrameLabels,
!OrdNeedsFrame, !CanTransform),
- svqueue.put_list(NowNeedFrameLabels, !Queue),
+ % XXX map.lookup(BlockMap, Label, BlockInfo),
+ % XXX Successors = successors(BlockInfo),
+ list.map(pair_with(pred_propagated(Label, Reason)), NowNeedFrameLabels,
+ PairedNowNeedFrameLabels),
+ svqueue.put_list(PairedNowNeedFrameLabels, !Queue),
propagate_frame_requirement_to_predecessors(!.Queue, BlockMap,
RevMap, !OrdNeedsFrame, !PropagationStepsLeft, !CanTransform)
;
true
).
-:- pred record_frame_need(frame_block_map::in, label::in,
- ord_needs_frame::in, ord_needs_frame::out,
+:- pred record_frame_need(frame_block_map(En, Ex)::in, needs_frame_reason::in,
+ label::in, ord_needs_frame::in, ord_needs_frame::out,
can_transform::in, can_transform::out) is det.
-record_frame_need(BlockMap, Label, !OrdNeedsFrame, !CanTransform) :-
+record_frame_need(BlockMap, Reason, Label, !OrdNeedsFrame, !CanTransform) :-
map.lookup(BlockMap, Label, BlockInfo),
BlockType = BlockInfo ^ fb_type,
(
- BlockType = setup,
+ BlockType = entry_block(_),
!:CanTransform = cannot_transform
;
- BlockType = ordinary(_),
- svmap.det_update(Label, block_needs_frame, !OrdNeedsFrame)
+ BlockType = ordinary_block(_, _),
+ ord_needs_frame(Label, Reason, !OrdNeedsFrame)
;
- BlockType = teardown(_, _, _),
- unexpected(this_file, "record_frame_need: teardown")
+ BlockType = exit_block(_),
+ unexpected(this_file, "record_frame_need: exit_block")
).
-:- pred all_successors_need_frame(frame_block_map::in, ord_needs_frame::in,
- label::in) is semidet.
+:- pred all_successors_need_frame(frame_block_map(En, Ex)::in,
+ ord_needs_frame::in, label::in) is semidet.
all_successors_need_frame(BlockMap, OrdNeedsFrame, Label) :-
map.lookup(BlockMap, Label, BlockInfo),
@@ -1306,17 +1794,17 @@
label_needs_frame(OrdNeedsFrame, Label) :-
( map.search(OrdNeedsFrame, Label, NeedsFrame) ->
- NeedsFrame = block_needs_frame
+ NeedsFrame = block_needs_frame(_)
;
% If the map.search fails, Label is not an ordinary frame.
- % Setup blocks and teardown blocks don't need frames.
+ % Entry blocks and exit blocks don't need frames.
fail
).
% Returns the set of successors of the given block as a list
% (which may contain duplicates).
%
-:- func successors(frame_block_info) = list(label).
+:- func successors(frame_block_info(En, Ex)) = list(label).
successors(BlockInfo) = Successors :-
SideLabels = BlockInfo ^ fb_jump_dests,
@@ -1337,35 +1825,20 @@
%
:- pred process_frame_delay(list(label)::in, ord_needs_frame::in,
proc_label::in, counter::in, counter::out,
- frame_block_map::in, frame_block_map::out,
- setup_par_map::in, setup_par_map::out,
- teardown_par_map::in, teardown_par_map::out) is det.
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ setup_par_map::in, setup_par_map::out, exit_par_map::in, exit_par_map::out)
+ is det <= block_entry_exit(En, Ex).
-process_frame_delay([], _, _, !C, !BlockMap,
- !SetupParMap, !TeardownParMap).
+process_frame_delay([], _, _, !C, !BlockMap, !SetupParMap, !ExitParMap).
process_frame_delay([Label0 | Labels0], OrdNeedsFrame, ProcLabel, !C,
- !BlockMap, !SetupParMap, !TeardownParMap) :-
+ !BlockMap, !SetupParMap, !ExitParMap) :-
map.lookup(!.BlockMap, Label0, BlockInfo0),
BlockInfo0 = frame_block_info(Label0Copy, Instrs0, FallInto, SideLabels0,
MaybeFallThrough0, Type),
expect(unify(Label0, Label0Copy), this_file,
"process_frame_delay: label in frame_block_info is not copy"),
(
- Type = setup,
- (
- MaybeFallThrough0 = yes(_FallThrough)
- ;
- MaybeFallThrough0 = no,
- unexpected(this_file,
- "process_frame_delay: no fallthrough for setup block")
- ),
- (
- SideLabels0 = []
- ;
- SideLabels0 = [_ | _],
- unexpected(this_file,
- "process_frame_delay: nonempty side labels for setup block")
- ),
+ Type = entry_block(_),
(
Instrs0 = [LabelInstrPrime | _],
LabelInstrPrime = label(_) - _
@@ -1376,37 +1849,38 @@
"process_frame_delay: setup block does not begin with label")
),
BlockInfo = frame_block_info(Label0, [LabelInstr], FallInto,
- SideLabels0, MaybeFallThrough0, ordinary(block_doesnt_need_frame)),
+ SideLabels0, MaybeFallThrough0,
+ ordinary_block(block_doesnt_need_frame, is_not_dummy)),
svmap.det_update(Label0, BlockInfo, !BlockMap),
process_frame_delay(Labels0, OrdNeedsFrame,
- ProcLabel, !C, !BlockMap, !SetupParMap, !TeardownParMap)
+ ProcLabel, !C, !BlockMap, !SetupParMap, !ExitParMap)
;
- Type = ordinary(_),
+ Type = ordinary_block(_, _),
map.lookup(OrdNeedsFrame, Label0, NeedsFrame),
(
- NeedsFrame = block_needs_frame,
+ NeedsFrame = block_needs_frame(_),
% Every block reachable from this block, whether via jump or
% fallthrough, will be an ordinary block also mapped to `yes'
- % by OrdNeedsFrame, or will be a teardown block. We already have
- % a stack frame, and all our successors expect one, so we need not
- % do anything.
+ % by OrdNeedsFrame, or will be an exit block, or will be a pre-exit
+ % dummy block. We already have a stack frame, and all our
+ % successors expect one, so we need not do anything.
process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C,
- !BlockMap, !SetupParMap, !TeardownParMap)
+ !BlockMap, !SetupParMap, !ExitParMap)
;
NeedsFrame = block_doesnt_need_frame,
transform_nostack_ordinary_block(Label0, Labels0, BlockInfo0,
OrdNeedsFrame, ProcLabel, !C, !BlockMap,
- !SetupParMap, !TeardownParMap)
+ !SetupParMap, !ExitParMap)
)
;
- Type = teardown(_, _, _),
+ Type = exit_block(_),
process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C,
- !BlockMap, !SetupParMap, !TeardownParMap)
+ !BlockMap, !SetupParMap, !ExitParMap)
).
% Transform an ordinary block that doesn't have a stack frame.
% Every block that is a successor of this block, whether via jump or
- % fallthrough, will be an ordinary block or a teardown block.
+ % fallthrough, will be an ordinary block or an exit block.
%
% - If it is an ordinary block that doesn't need a frame, we need not
% do anything.
@@ -1417,31 +1891,31 @@
% to block B will be given by map.lookup(!.SetupParMap, B, S).
% Here, we just allocate the label S; the block will be created later.
%
- % - If it is teardown block B, then we need to jump to a variant of B
+ % - If it is exit block B, then we need to jump to a variant of B
% that does no teardown, since there is no stack frame to tear down.
% The label S of the variant block will be given by
- % map.lookup(!.TeardownParMap, B, S). Here, we just allocate
+ % map.lookup(!.ExitParMap, B, S). Here, we just allocate
% the label S; the block will be created later.
%
:- pred transform_nostack_ordinary_block(label::in, list(label)::in,
- frame_block_info::in, ord_needs_frame::in,
+ frame_block_info(En, Ex)::in, ord_needs_frame::in,
proc_label::in, counter::in, counter::out,
- frame_block_map::in, frame_block_map::out,
- setup_par_map::in, setup_par_map::out,
- teardown_par_map::in, teardown_par_map::out) is det.
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out,
+ setup_par_map::in, setup_par_map::out, exit_par_map::in, exit_par_map::out)
+ is det <= block_entry_exit(En, Ex).
transform_nostack_ordinary_block(Label0, Labels0, BlockInfo0, OrdNeedsFrame,
- ProcLabel, !C, !BlockMap, !SetupParMap, !TeardownParMap) :-
+ ProcLabel, !C, !BlockMap, !SetupParMap, !ExitParMap) :-
BlockInfo0 = frame_block_info(_, Instrs0, FallInto,
SideLabels0, MaybeFallThrough0, Type),
mark_parallels_for_nostack_successors(SideLabels0, SideLabels,
SideAssocLabelMap, OrdNeedsFrame, !.BlockMap, ProcLabel, !C,
- !SetupParMap, !TeardownParMap),
+ !SetupParMap, !ExitParMap),
(
MaybeFallThrough0 = yes(FallThroughLabel0),
mark_parallel_for_nostack_successor(FallThroughLabel0,
FallThroughLabel, OrdNeedsFrame, !.BlockMap, ProcLabel, !C,
- !SetupParMap, !TeardownParMap),
+ !SetupParMap, !ExitParMap),
MaybeFallThrough = yes(FallThroughLabel),
expect(no_disagreement(SideAssocLabelMap,
FallThroughLabel0, FallThroughLabel), this_file,
@@ -1461,7 +1935,7 @@
AssocLabelMap = SideAssocLabelMap,
RedirectFallThrough = []
),
- pick_last(Instrs0, PrevInstrs, LastInstr0),
+ list.split_last_det(Instrs0, PrevInstrs, LastInstr0),
map.from_assoc_list(AssocLabelMap, LabelMap),
opt_util.replace_labels_instruction(LastInstr0, LabelMap, no, LastInstr),
Instrs = PrevInstrs ++ [LastInstr | RedirectFallThrough],
@@ -1469,7 +1943,7 @@
SideLabels, MaybeFallThrough, Type),
map.set(!.BlockMap, Label0, BlockInfo, !:BlockMap),
process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C, !BlockMap,
- !SetupParMap, !TeardownParMap).
+ !SetupParMap, !ExitParMap).
:- pred no_disagreement(assoc_list(label, label)::in, label::in, label::in)
is semidet.
@@ -1488,24 +1962,24 @@
%
:- pred mark_parallels_for_nostack_successors(list(label)::in,
list(label)::out, assoc_list(label)::out, ord_needs_frame::in,
- frame_block_map::in, proc_label::in, counter::in, counter::out,
+ frame_block_map(En, Ex)::in, proc_label::in, counter::in, counter::out,
setup_par_map::in, setup_par_map::out,
- teardown_par_map::in, teardown_par_map::out) is det.
+ exit_par_map::in, exit_par_map::out) is det.
mark_parallels_for_nostack_successors([], [], [], _, _, _, !C,
- !SetupParMap, !TeardownParMap).
+ !SetupParMap, !ExitParMap).
mark_parallels_for_nostack_successors([Label0 | Labels0], [Label | Labels],
[Label0 - Label | LabelMap], OrdNeedsFrame, BlockMap, ProcLabel, !C,
- !SetupParMap, !TeardownParMap) :-
+ !SetupParMap, !ExitParMap) :-
mark_parallel_for_nostack_successor(Label0, Label,
- OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !TeardownParMap),
+ OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !ExitParMap),
mark_parallels_for_nostack_successors(Labels0, Labels, LabelMap,
- OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !TeardownParMap).
+ OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !ExitParMap).
% Label0 is a label that is a successor of a block which has no stack
% frame.
%
- % If Label0 starts a teardown block, we ensure that it has a non-teardown
+ % If Label0 starts an exit block, we ensure that it has a non-teardown
% parallel Label.
%
% If Label0 starts an ordinary block that needs a stack frame, we ensure
@@ -1513,31 +1987,31 @@
% control to Label0.
%
:- pred mark_parallel_for_nostack_successor(label::in, label::out,
- ord_needs_frame::in, frame_block_map::in, proc_label::in,
+ ord_needs_frame::in, frame_block_map(En, Ex)::in, proc_label::in,
counter::in, counter::out, setup_par_map::in, setup_par_map::out,
- teardown_par_map::in, teardown_par_map::out) is det.
+ exit_par_map::in, exit_par_map::out) is det.
mark_parallel_for_nostack_successor(Label0, Label, OrdNeedsFrame, BlockMap,
- ProcLabel, !C, !SetupParMap, !TeardownParMap) :-
+ ProcLabel, !C, !SetupParMap, !ExitParMap) :-
map.lookup(BlockMap, Label0, BlockInfo),
Type = BlockInfo ^ fb_type,
(
- Type = setup,
+ Type = entry_block(_),
unexpected(this_file, "mark_parallels_for_nostack_jump: " ++
"reached setup via jump from ordinary block")
;
- Type = ordinary(_),
+ Type = ordinary_block(_, _),
map.lookup(OrdNeedsFrame, Label0, NeedsFrame),
(
- NeedsFrame = block_needs_frame,
+ NeedsFrame = block_needs_frame(_),
ensure_setup_parallel(Label0, Label, ProcLabel, !C, !SetupParMap)
;
NeedsFrame = block_doesnt_need_frame,
Label = Label0
)
;
- Type = teardown(_, _, _),
- ensure_teardown_parallel(Label0, Label, ProcLabel, !C, !TeardownParMap)
+ Type = exit_block(_),
+ ensure_exit_parallel(Label0, Label, ProcLabel, !C, !ExitParMap)
).
%-----------------------------------------------------------------------------%
@@ -1547,27 +2021,28 @@
% - the setup code of ordinary blocks that need frames but (some of)
% whose predecessors don't have one, and
%
- % - the parallels of teardown blocks that can assume there is no frame to
+ % - the parallels of exit blocks that can assume there is no frame to
% tear down.
%
-:- pred create_parallels(list(label)::in, list(label)::out, int::in,
- string::in, proc_label::in, counter::in, counter::out, ord_needs_frame::in,
- setup_par_map::in, teardown_par_map::in, pred_map::in,
- frame_block_map::in, frame_block_map::out) is det.
-
-create_parallels([], [], _, _, _, !C, _, _, _, _, !BlockMap).
-create_parallels([Label0 | Labels0], Labels, FrameSize, Msg, ProcLabel, !C,
- OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap, !BlockMap) :-
- create_parallels(Labels0, Labels1, FrameSize, Msg, ProcLabel, !C,
- OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap, !BlockMap),
+:- pred create_parallels(list(label)::in, list(label)::out, En::in,
+ proc_label::in, counter::in, counter::out, ord_needs_frame::in,
+ setup_par_map::in, exit_par_map::in, pred_map::in,
+ frame_block_map(En, Ex)::in, frame_block_map(En, Ex)::out) is det
+ <= block_entry_exit(En, Ex).
+
+create_parallels([], [], _, _, !C, _, _, _, _, !BlockMap).
+create_parallels([Label0 | Labels0], Labels, EntryInfo, ProcLabel, !C,
+ OrdNeedsFrame, SetupParMap, ExitParMap, PredMap, !BlockMap) :-
+ create_parallels(Labels0, Labels1, EntryInfo, ProcLabel, !C,
+ OrdNeedsFrame, SetupParMap, ExitParMap, PredMap, !BlockMap),
map.lookup(!.BlockMap, Label0, BlockInfo0),
BlockInfo0 = frame_block_info(Label0Copy, _, FallInto,
SideLabels, MaybeFallThrough, Type),
expect(unify(Label0, Label0Copy), this_file,
"create_parallels: label in frame_block_info is not copy"),
- ( search_teardown_par_map(TeardownParMap, Label0, ParallelLabel) ->
+ ( search_exit_par_map(ExitParMap, Label0, ParallelLabel) ->
expect(unify(MaybeFallThrough, no), this_file,
- "create_parallels: teardown block with parallel has fall through"),
+ "create_parallels: exit block with parallel has fall through"),
(
SideLabels = [],
Comments = []
@@ -1575,13 +2050,14 @@
SideLabels = [_ | _],
% This can happen if fulljump optimization has redirected the
% return.
- Comments = [comment("teardown side labels "
+ Comments = [comment("exit side labels "
++ dump_labels(ProcLabel, SideLabels)) - ""]
),
PrevNeedsFrame = prev_block_needs_frame(OrdNeedsFrame, BlockInfo0),
- ( Type = teardown(_, Livevals, Goto) ->
+ ( Type = exit_block(ExitInfo) ->
LabelInstr = label(ParallelLabel) - "non-teardown parallel",
- ReplacementCode = [LabelInstr] ++ Comments ++ Livevals ++ [Goto],
+ ReplacementCode = [LabelInstr] ++ Comments ++
+ non_teardown_exit_code(ExitInfo),
(
PrevNeedsFrame = block_doesnt_need_frame,
Labels = [ParallelLabel, Label0 | Labels1],
@@ -1589,24 +2065,23 @@
svmap.det_update(Label0, BlockInfo, !BlockMap),
ParallelBlockFallInto = FallInto
;
- PrevNeedsFrame = block_needs_frame,
+ PrevNeedsFrame = block_needs_frame(_),
Labels = [Label0, ParallelLabel | Labels1],
ParallelBlockFallInto = no
),
ParallelBlockInfo = frame_block_info(ParallelLabel,
ReplacementCode, ParallelBlockFallInto, SideLabels,
- no, ordinary(block_doesnt_need_frame)),
+ no, ordinary_block(block_doesnt_need_frame, is_not_dummy)),
svmap.det_insert(ParallelLabel, ParallelBlockInfo, !BlockMap)
;
- unexpected(this_file,
- "block in teardown_par_map is not teardown")
+ unexpected(this_file, "block in exit_par_map is not exit")
)
; search_setup_par_map(SetupParMap, Label0, SetupLabel) ->
- expect(is_ordinary(Type), this_file,
+ expect(is_ordinary_block(Type), this_file,
"create_parallels: block in setup map is not ordinary"),
PrevNeedsFrame = prev_block_needs_frame(OrdNeedsFrame, BlockInfo0),
(
- PrevNeedsFrame = block_needs_frame,
+ PrevNeedsFrame = block_needs_frame(Reasons),
counter.allocate(N, !C),
JumpAroundLabel = internal(N, ProcLabel),
% By not including a label instruction at the start of
@@ -1618,9 +2093,11 @@
% it can't be referred to from anywhere.)
JumpAroundCode = [goto(label(Label0)) - "jump around setup"],
Labels = [JumpAroundLabel, SetupLabel, Label0 | Labels1],
+ JumpAroundReason = jump_around(Label0, Reasons),
JumpAroundBlockInfo = frame_block_info(JumpAroundLabel,
JumpAroundCode, no, [Label0], FallInto,
- ordinary(block_needs_frame)),
+ ordinary_block(block_needs_frame(JumpAroundReason),
+ is_not_dummy)),
svmap.det_insert(JumpAroundLabel, JumpAroundBlockInfo, !BlockMap),
SetupFallInto = yes(JumpAroundLabel),
BlockInfo = BlockInfo0 ^ fb_fallen_into := yes(SetupLabel),
@@ -1630,20 +2107,17 @@
Labels = [SetupLabel, Label0 | Labels1],
SetupFallInto = no
),
- SetupCode = [
- label(SetupLabel) - "late setup label",
- incr_sp(FrameSize, Msg) - "late setup",
- assign(stackvar(FrameSize), lval(succip)) - "late save"
- ],
+ SetupCode = [label(SetupLabel) - "late setup label"]
+ ++ late_setup_code(EntryInfo),
SetupBlockInfo = frame_block_info(SetupLabel, SetupCode,
- SetupFallInto, [], yes(Label0), setup),
+ SetupFallInto, [], yes(Label0), entry_block(EntryInfo)),
svmap.det_insert(SetupLabel, SetupBlockInfo, !BlockMap)
;
Labels = [Label0 | Labels1]
).
-:- func prev_block_needs_frame(ord_needs_frame, frame_block_info) =
- block_needs_frame.
+:- func prev_block_needs_frame(ord_needs_frame, frame_block_info(En, Ex)) =
+ block_needs_frame(needs_frame_reasons).
prev_block_needs_frame(OrdNeedsFrame, BlockInfo) = PrevNeedsFrame :-
MaybeFallIntoFrom = BlockInfo ^ fb_fallen_into,
@@ -1654,8 +2128,8 @@
% to this block.
PrevNeedsFrame = NeedsFrame
;
- % FallIntoFrom is a setup block; teardown blocks cannot fall
- % through. Setup blocks don't need frames.
+ % FallIntoFrom is a setup block; exit blocks cannot fall
+ % through. Entry blocks don't need frames.
PrevNeedsFrame = block_doesnt_need_frame
)
;
@@ -1665,9 +2139,33 @@
PrevNeedsFrame = block_doesnt_need_frame
).
-:- pred is_ordinary(block_type::in) is semidet.
+:- pred is_ordinary_block(block_type(En, Ex)::in) is semidet.
-is_ordinary(ordinary(_)).
+is_ordinary_block(ordinary_block(_, _)).
+
+%-----------------------------------------------------------------------------%
+
+:- func det_late_setup(det_entry_info) = list(instruction).
+
+det_late_setup(det_entry(Msg, FrameSize)) =
+ [incr_sp(FrameSize, Msg) - "late setup",
+ assign(stackvar(FrameSize), lval(succip)) - "late save"].
+
+:- func det_non_teardown_exit_code(det_exit_info) = list(instruction).
+
+det_non_teardown_exit_code(det_exit(_, Livevals, Goto)) = Livevals ++ [Goto].
+
+:- func nondet_late_setup(nondet_entry_info) = list(instruction).
+
+nondet_late_setup(nondet_entry(Msg, FrameSize, Redoip)) =
+ [mkframe(ordinary_frame(Msg, FrameSize, no), yes(Redoip)) - "late setup"].
+
+:- func nondet_non_teardown_exit_code(nondet_exit_info) = list(instruction).
+
+nondet_non_teardown_exit_code(nondet_plain_exit(Livevals, _Goto)) =
+ Livevals ++ [goto(succip) - ""].
+nondet_non_teardown_exit_code(nondet_teardown_exit(_, _, _, Livevals, Goto)) =
+ Livevals ++ [Goto].
%-----------------------------------------------------------------------------%
@@ -1690,15 +2188,13 @@
).
% Given the label of a block, allocate a label for its parallel
- % in the given teardown map if it doesn't already have one.
+ % in the given exit map if it doesn't already have one.
%
-:- pred ensure_teardown_parallel(label::in, label::out, proc_label::in,
- counter::in, counter::out, teardown_par_map::in, teardown_par_map::out)
- is det.
+:- pred ensure_exit_parallel(label::in, label::out, proc_label::in,
+ counter::in, counter::out, exit_par_map::in, exit_par_map::out) is det.
-ensure_teardown_parallel(Label, ParallelLabel, ProcLabel, !C,
- !TeardownParMap) :-
- !.TeardownParMap = teardown_par_map(ParMap0),
+ensure_exit_parallel(Label, ParallelLabel, ProcLabel, !C, !ExitParMap) :-
+ !.ExitParMap = exit_par_map(ParMap0),
( map.search(ParMap0, Label, OldParallel) ->
ParallelLabel = OldParallel
;
@@ -1706,7 +2202,7 @@
NewParallel = internal(N, ProcLabel),
ParallelLabel = NewParallel,
map.det_insert(ParMap0, Label, NewParallel, ParMap),
- !:TeardownParMap = teardown_par_map(ParMap)
+ !:ExitParMap = exit_par_map(ParMap)
).
%-----------------------------------------------------------------------------%
@@ -1715,8 +2211,9 @@
% as a comment instruction. This can make it much easier to debug
% frameopt.
%
-:- pred describe_block(frame_block_map::in, ord_needs_frame::in, pred_map::in,
- proc_label::in, label::in, instruction::out) is det.
+:- pred describe_block(frame_block_map(En, Ex)::in, ord_needs_frame::in,
+ pred_map::in, proc_label::in, label::in, instruction::out) is det
+ <= block_entry_exit(En, Ex).
describe_block(BlockMap, OrdNeedsFrame, PredMap, ProcLabel, Label, Instr) :-
map.lookup(BlockMap, Label, BlockInfo),
@@ -1756,54 +2253,140 @@
FallThroughStr = "does not fall through\n"
),
(
- Type = setup,
- expect(unify(SideLabels, []), this_file,
- "describe_block: setup, SideLabels=[_ | _]"),
- expect(is_yes(MaybeFallThrough), this_file,
- "describe_block: setup, MaybeFallThrough=no"),
- TypeStr = "setup\n",
- OrdNeedsFrameStr = ""
+ Type = entry_block(Entry),
+ TypeStr = "entry_block\n" ++ describe_entry(Entry)
+ ;
+ Type = ordinary_block(UsesFrame, MaybeDummy),
+ (
+ MaybeDummy = is_not_dummy,
+ TypeStr0 = "ordinary_block; "
+ ;
+ MaybeDummy = is_post_entry_dummy,
+ TypeStr0 = "ordinary_block (post_entry_dummy); "
;
- Type = ordinary(UsesFrame),
+ MaybeDummy = is_pre_exit_dummy,
+ TypeStr0 = "ordinary_block (pre_exit_dummy); "
+ ),
(
- UsesFrame = block_needs_frame,
- TypeStr = "ordinary; uses frame, "
+ UsesFrame = block_needs_frame(UsesReason),
+ TypeStr1 = TypeStr0 ++ "uses frame",
+ ( UsesReason = code_needs_frame(Label) ->
+ TypeStr2 = TypeStr1 ++ "\n"
+ ;
+ TypeStr2 = TypeStr1 ++ " " ++
+ describe_reason(ProcLabel, UsesReason) ++ "\n"
+ )
;
UsesFrame = block_doesnt_need_frame,
- TypeStr = "ordinary; does not use frame, "
+ TypeStr2 = TypeStr0 ++ "does not use frame\n"
),
- map.lookup(OrdNeedsFrame, Label, NeedsFrame),
+ ( map.search(OrdNeedsFrame, Label, NeedsFrame) ->
(
NeedsFrame = block_doesnt_need_frame,
expect(unify(UsesFrame, block_doesnt_need_frame), this_file,
"describe_block: "
++ "NeedsFrame=block_doesnt_need_frame, "
++ "UsesFrame=block_needs_frame"),
- OrdNeedsFrameStr = "does not need frame\n"
+ TypeStr = TypeStr2 ++ "does not need frame\n"
;
- NeedsFrame = block_needs_frame,
- OrdNeedsFrameStr = "does need frame\n"
+ NeedsFrame = block_needs_frame(NeedsReasonSet),
+ set.to_sorted_list(NeedsReasonSet, NeedsReasons),
+ ReasonsStr = describe_top_reasons(ProcLabel, NeedsReasons),
+ TypeStr = TypeStr2 ++ "does need frame\n" ++ ReasonsStr
)
;
- Type = teardown(RestoreSuccip, Livevals, Goto),
+ % We can get here if delay_frame_transform fails.
+ TypeStr = TypeStr2 ++ "(unknown whether it does need frame)\n"
+ )
+ ;
+ Type = exit_block(Exit),
expect(unify(MaybeFallThrough, no), this_file,
- "describe_block: teardown, MaybeFallThrough=yes(_)"),
- TypeStr = "teardown\n"
- ++ "restore: "
+ "describe_block: exit_block, MaybeFallThrough=yes(_)"),
+ TypeStr = "exit_block\n" ++ describe_exit(ProcLabel, Exit)
+ ),
+ Comment = Heading ++ PredStr ++ FallIntoStr ++ SideStr ++ FallThroughStr
+ ++ TypeStr ++ "CODE:\n" ++ BlockInstrsStr,
+ Instr = comment(Comment) - "".
+
+:- func describe_det_entry(det_entry_info) = string.
+
+describe_det_entry(det_entry(Msg, Size)) =
+ "msg: " ++ Msg ++ ", size: " ++ int_to_string(Size) ++ "\n".
+
+:- func describe_det_exit(proc_label, det_exit_info) = string.
+
+describe_det_exit(ProcLabel, det_exit(RestoreSuccip, Livevals, Goto)) =
+ "restore: "
++ dump_fullinstrs(ProcLabel, yes, RestoreSuccip)
++ "livevals: "
++ dump_fullinstrs(ProcLabel, yes, Livevals)
++ "goto: "
- ++ dump_fullinstr(ProcLabel, yes, Goto),
- OrdNeedsFrameStr = ""
- ),
- Comment = Heading ++ PredStr ++ FallIntoStr ++ SideStr ++ FallThroughStr
- ++ TypeStr ++ OrdNeedsFrameStr ++ "CODE:\n" ++ BlockInstrsStr,
- Instr = comment(Comment) - "".
+ ++ dump_fullinstr(ProcLabel, yes, Goto).
-:- pred is_yes(maybe(T)::in) is semidet.
+:- func describe_nondet_entry(nondet_entry_info) = string.
-is_yes(yes(_)).
+describe_nondet_entry(nondet_entry(Msg, Size, Redoip)) =
+ "msg: "
+ ++ Msg
+ ++ ", size: "
+ ++ int_to_string(Size)
+ ++ ", redoip: "
+ ++ dump_code_addr(Redoip)
+ ++ "\n".
+
+:- func describe_nondet_exit(proc_label, nondet_exit_info) = string.
+
+describe_nondet_exit(ProcLabel, nondet_plain_exit(Livevals, Goto)) =
+ "livevals: "
+ ++ dump_fullinstrs(ProcLabel, yes, Livevals)
+ ++ "goto: "
+ ++ dump_fullinstr(ProcLabel, yes, Goto).
+describe_nondet_exit(ProcLabel, nondet_teardown_exit(Succip, Maxfr, Curfr,
+ Livevals, Goto)) =
+ "succip: "
+ ++ dump_fullinstr(ProcLabel, yes, Succip)
+ ++ "maxfr: "
+ ++ dump_fullinstr(ProcLabel, yes, Maxfr)
+ ++ "curfr: "
+ ++ dump_fullinstr(ProcLabel, yes, Curfr)
+ ++ "livevals: "
+ ++ dump_fullinstrs(ProcLabel, yes, Livevals)
+ ++ "goto: "
+ ++ dump_fullinstr(ProcLabel, yes, Goto).
+
+:- func describe_top_reasons(proc_label, list(needs_frame_reason)) = string.
+
+describe_top_reasons(_ProcLabel, []) = "".
+describe_top_reasons(ProcLabel, [Reason | Reasons]) =
+ describe_reason(ProcLabel, Reason) ++ "\n" ++
+ describe_top_reasons(ProcLabel, Reasons).
+
+:- func describe_reason(proc_label, needs_frame_reason) = string.
+
+describe_reason(ProcLabel, code_needs_frame(Label)) =
+ "code " ++ dump_label(ProcLabel, Label).
+describe_reason(_ProcLabel, keep_frame) = "keep_frame".
+describe_reason(_ProcLabel, redoip_label) = "redoip_label".
+describe_reason(ProcLabel, frontier(Label, Reasons)) =
+ "frontier(" ++ dump_label(ProcLabel, Label) ++ ", {"
+ ++ describe_reasons(ProcLabel, to_sorted_list(Reasons)) ++ "})".
+describe_reason(ProcLabel, jump_around(Label, Reasons)) =
+ "jump_around(" ++ dump_label(ProcLabel, Label) ++ ", {"
+ ++ describe_reasons(ProcLabel, to_sorted_list(Reasons)) ++ "})".
+describe_reason(ProcLabel, succ_propagated(Label, Reason)) =
+ "successor(" ++ dump_label(ProcLabel, Label) ++ ", "
+ ++ describe_reason(ProcLabel, Reason) ++ ")".
+describe_reason(ProcLabel, pred_propagated(Label, Reason)) =
+ "predecessor(" ++ dump_label(ProcLabel, Label) ++ ", "
+ ++ describe_reason(ProcLabel, Reason) ++ ")".
+
+:- func describe_reasons(proc_label, list(needs_frame_reason)) = string.
+
+describe_reasons(_, []) = "".
+describe_reasons(ProcLabel, [Reason]) = describe_reason(ProcLabel, Reason).
+describe_reasons(ProcLabel, [Reason1, Reason2 | Reasons]) =
+ describe_reason(ProcLabel, Reason1) ++ ", " ++
+ describe_reasons(ProcLabel, [Reason2 | Reasons]).
%-----------------------------------------------------------------------------%
@@ -1813,11 +2396,21 @@
search_setup_par_map(setup_par_map(ParMap), Label, ParallelLabel) :-
map.search(ParMap, Label, ParallelLabel).
-:- pred search_teardown_par_map(teardown_par_map::in, label::in, label::out)
+:- pred search_exit_par_map(exit_par_map::in, label::in, label::out)
is semidet.
-search_teardown_par_map(teardown_par_map(ParMap), Label, ParallelLabel) :-
+search_exit_par_map(exit_par_map(ParMap), Label, ParallelLabel) :-
map.search(ParMap, Label, ParallelLabel).
+
+%-----------------------------------------------------------------------------%
+
+:- pred is_yes(maybe(T)::in) is semidet.
+
+is_yes(yes(_)).
+
+:- pred pair_with(T::in, U::in, pair(T, U)::out) is det.
+
+pair_with(T, U, T - U).
%-----------------------------------------------------------------------------%
Index: compiler/global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/global_data.m,v
retrieving revision 1.17
diff -u -b -r1.17 global_data.m
--- compiler/global_data.m 30 Mar 2006 02:45:56 -0000 1.17
+++ compiler/global_data.m 30 Mar 2006 04:32:46 -0000
@@ -26,7 +26,6 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module list.
-:- import_module maybe.
%-----------------------------------------------------------------------------%
@@ -81,7 +80,7 @@
list(list(rval))::in, list(llds_type)::out) is semidet.
:- pred add_vector_static_cell(list(llds_type)::in,
- list(maybe(list(rval)))::in, data_addr::out,
+ list(list(rval))::in, data_addr::out,
static_cell_info::in, static_cell_info::out) is det.
:- pred search_scalar_static_cell_offset(static_cell_info::in, data_addr::in,
@@ -461,38 +460,10 @@
init_vector_cell_group = vector_cell_group(counter.init(0), map.init).
-:- func pair_vector_element(list(llds_type), maybe(list(rval)))
- = common_cell_value.
+:- func pair_vector_element(list(llds_type), list(rval)) = common_cell_value.
-pair_vector_element(Types, MaybeArgs) = plain_value(ArgsTypes) :-
- (
- MaybeArgs = no,
- ArgsTypes = list.map(pair_with_default_value, Types)
- ;
- MaybeArgs = yes(Args),
- assoc_list.from_corresponding_lists(Args, Types, ArgsTypes)
- ).
-
-:- func pair_with_default_value(llds_type) = pair(rval, llds_type).
-
-pair_with_default_value(Type) = const(default_value_for_type(Type)) - Type.
-
-:- func default_value_for_type(llds_type) = rval_const.
-
-default_value_for_type(bool) = int_const(0).
-default_value_for_type(int_least8) = int_const(0).
-default_value_for_type(uint_least8) = int_const(0).
-default_value_for_type(int_least16) = int_const(0).
-default_value_for_type(uint_least16) = int_const(0).
-default_value_for_type(int_least32) = int_const(0).
-default_value_for_type(uint_least32) = int_const(0).
-default_value_for_type(integer) = int_const(0).
-default_value_for_type(unsigned) = int_const(0).
-default_value_for_type(float) = float_const(0.0).
-default_value_for_type(string) = string_const("").
-default_value_for_type(data_ptr) = int_const(0).
-default_value_for_type(code_ptr) = int_const(0).
-default_value_for_type(word) = int_const(0).
+pair_vector_element(Types, Args) = plain_value(ArgsTypes) :-
+ assoc_list.from_corresponding_lists(Args, Types, ArgsTypes).
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.264
diff -u -b -r1.264 handle_options.m
--- compiler/handle_options.m 29 Mar 2006 08:06:46 -0000 1.264
+++ compiler/handle_options.m 9 Apr 2006 08:40:45 -0000
@@ -875,7 +875,13 @@
globals.lookup_int_option(!.Globals, debug_opt_pred_id,
DebugOptPredId),
- ( DebugOptPredId > 0 ->
+ globals.lookup_string_option(!.Globals, debug_opt_pred_name,
+ DebugOptPredName),
+ (
+ ( DebugOptPredId > 0
+ ; DebugOptPredName \= ""
+ )
+ ->
globals.set_option(debug_opt, bool(yes), !Globals)
;
true
@@ -906,6 +912,8 @@
option_implies(simple_mode_constraints, mode_constraints, bool(yes),
!Globals),
+ option_implies(frameopt_comments, auto_comments, bool(yes), !Globals),
+
% Minimal model tabling is not compatible with high level code
% or with trailing; see the comments in runtime/mercury_grade.h.
@@ -1055,49 +1063,47 @@
TraceOptimized = yes
),
- % Disable hijacks if debugging is enabled. The
- % code we now use to restore the stacks for
- % direct retries works only if the retry does not
- % "backtrack" over a hijacked nondet stack frame
- % whose hijack has not been undone. Note that
- % code compiled without debugging may still hijack
- % nondet stack frames. Execution may reemerge from
- % the nondebugged region in one of two ways. If
- % the nondebugged code returns, then it will have
- % undone hijack, and the retry code will work. If
- % the nondebugged code calls debugged code, there
- % will be a region on the stacks containing no
- % debugging information, and the retry command will
- % refuse to perform retries that go into or beyond
- % this region. Both cases preserve correctness.
- %
- % An alternative solution would be to store everything
- % on the nondet stack that may be hijacked in ordinary
- % stack slots on entry to every procedure, but that
- % would be not only more complex than simply disabling
- % hijacks, it would be slower as well, except in
- % procedures that would have many nested hijacks,
- % and such code is extremely rare.
+ % Disable hijacks if debugging is enabled. The code we now use
+ % to restore the stacks for direct retries works only if the retry
+ % does not "backtrack" over a hijacked nondet stack frame whose
+ % hijack has not been undone. Note that code compiled without
+ % debugging may still hijack nondet stack frames. Execution may
+ % reemerge from the nondebugged region in one of two ways. If the
+ % nondebugged code returns, then it will have undone hijack,
+ % and the retry code will work. If the nondebugged code calls
+ % debugged code, there will be a region on the stacks containing
+ % no debugging information, and the retry command will refuse
+ % to perform retries that go into or beyond this region.
+ % Both cases preserve correctness.
+ %
+ % An alternative solution would be to store everything on the
+ % nondet stack that may be hijacked in ordinary stack slots
+ % on entry to every procedure, but that would be not only
+ % more complex than simply disabling hijacks, it would be slower
+ % as well, except in procedures that would have many nested
+ % hijacks, and such code is extremely rare.
globals.set_option(allow_hijacks, bool(no), !Globals),
- % The following option prevents useless variables
- % from cluttering the trace. Its explicit setting
- % removes a source of variability in the goal paths
- % reported by tracing.
+
+ % The following option prevents useless variables from cluttering
+ % the trace. Its explicit setting removes a source of variability
+ % in the goal paths reported by tracing.
globals.set_option(excess_assign, bool(yes), !Globals),
- % The explicit setting of the following option
- % removes a source of variability in the goal paths
- % reported by tracing.
+
+ % The explicit setting of the following option removes a source
+ % of variability in the goal paths reported by tracing.
globals.set_option(follow_code, bool(yes), !Globals),
- % The following option selects a special-case
- % code generator that cannot (yet) implement tracing.
+
+ % The following option selects a special-case code generator
+ % that cannot (yet) implement tracing.
globals.set_option(middle_rec, bool(no), !Globals),
- % The following options cause the info required
- % by tracing to be generated.
+
+ % The following options cause the info required by tracing
+ % to be generated.
globals.set_option(trace_stack_layout, bool(yes), !Globals),
globals.set_option(body_typeinfo_liveness, bool(yes), !Globals),
- % To support up-level printing, we need to save
- % variables across a call even if the call cannot
- % succeed.
+
+ % To support up-level printing, we need to save variables across
+ % a call even if the call cannot succeed.
globals.set_option(opt_no_return_calls, bool(no), !Globals)
;
true
@@ -1576,9 +1582,8 @@
%
% When searching for a header (.mh or .mih) file,
- % module_name_to_file_name uses the plain header
- % name, so we need to add the full path to the
- % header files in the current directory.
+ % module_name_to_file_name uses the plain header name, so we need to
+ % add the full path to the header files in the current directory.
%
globals.lookup_bool_option(!.Globals, use_subdirs, UseSubdirs),
(
@@ -2040,13 +2045,12 @@
CompData = Comp - Name
), GradeComponents).
- % grade_component_table(ComponetStr, Component,
- % Options, MaybeTargets, IncludeGradeStr).
+ % grade_component_table(ComponetStr, Component, Options, MaybeTargets,
+ % IncludeGradeStr):
%
- % `IncludeGradeStr' is `yes' if the component should
- % be included in the grade string. It is `no' for
- % those components that are just synonyms for other
- % comments, as .mm is for .mmsc.
+ % `IncludeGradeStr' is `yes' if the component should be included
+ % in the grade string. It is `no' for those components that are
+ % just synonyms for other comments, as .mm is for .mmsc.
%
% NOTE: .picreg components are handled separately.
% (see compute_grade_components/3).
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.87
diff -u -b -r1.87 jumpopt.m
--- compiler/jumpopt.m 29 Mar 2006 08:06:52 -0000 1.87
+++ compiler/jumpopt.m 12 Apr 2006 08:18:49 -0000
@@ -295,7 +295,9 @@
% Look for det style tailcalls. We look for this even if
% the call is semidet, because one of the optimizations below
% turns a pair of semidet epilogs into a det epilog.
- ( CallModel = det ; CallModel = semidet ),
+ ( CallModel = call_model_det
+ ; CallModel = call_model_semidet
+ ),
map.search(Procmap, RetLabel, Between0),
PrevInstr = livevals(Livevals),
MayAlterRtti = may_alter_rtti,
@@ -307,7 +309,7 @@
NewRemain = specified(NewInstrs, Instrs0)
;
% Look for semidet style tailcalls.
- CallModel = semidet,
+ CallModel = call_model_semidet,
map.search(Forkmap, RetLabel, Between),
PrevInstr = livevals(Livevals),
MayAlterRtti = may_alter_rtti,
@@ -319,7 +321,7 @@
;
% Look for nondet style tailcalls which do not need
% a runtime check.
- CallModel = nondet(unchecked_tail_call),
+ CallModel = call_model_nondet(unchecked_tail_call),
map.search(Succmap, RetLabel, BetweenIncl),
BetweenIncl = [livevals(_) - _, goto(_) - _],
PrevInstr = livevals(Livevals),
@@ -327,11 +329,11 @@
not set.member(RetLabel, LayoutLabels)
->
NewInstrs = [
- assign(maxfr, lval(prevfr(lval(curfr))))
+ assign(maxfr, lval(prevfr_slot(lval(curfr))))
- "discard this frame",
- assign(succip, lval(succip(lval(curfr))))
+ assign(succip, lval(succip_slot(lval(curfr))))
- "setup PC on return from tailcall",
- assign(curfr, lval(succfr(lval(curfr))))
+ assign(curfr, lval(succfr_slot(lval(curfr))))
- "setup curfr on return from tailcall",
livevals(Livevals) - "",
goto(Proc) - redirect_comment(Comment0)
@@ -340,7 +342,7 @@
;
% Look for nondet style tailcalls which do need
% a runtime check.
- CallModel = nondet(checked_tail_call),
+ CallModel = call_model_nondet(checked_tail_call),
!.CheckedNondetTailCallInfo = yes(ProcLabel - Counter0),
map.search(Succmap, RetLabel, BetweenIncl),
BetweenIncl = [livevals(_) - _, goto(_) - _],
@@ -354,11 +356,11 @@
if_val(binop(ne, lval(curfr), lval(maxfr)),
label(NewLabel))
- "branch around if cannot tail call",
- assign(maxfr, lval(prevfr(lval(curfr))))
+ assign(maxfr, lval(prevfr_slot(lval(curfr))))
- "discard this frame",
- assign(succip, lval(succip(lval(curfr))))
+ assign(succip, lval(succip_slot(lval(curfr))))
- "setup PC on return from tailcall",
- assign(curfr, lval(succfr(lval(curfr))))
+ assign(curfr, lval(succfr_slot(lval(curfr))))
- "setup curfr on return from tailcall",
livevals(Livevals) - "",
goto(Proc) - redirect_comment(Comment0),
@@ -1091,15 +1093,15 @@
jumpopt.short_labels_lval(_, temp(T, N), temp(T, N)).
jumpopt.short_labels_lval(_, stackvar(N), stackvar(N)).
jumpopt.short_labels_lval(_, framevar(N), framevar(N)).
-jumpopt.short_labels_lval(Instrmap, succip(Rval0), succip(Rval)) :-
+jumpopt.short_labels_lval(Instrmap, succip_slot(Rval0), succip_slot(Rval)) :-
jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, redoip(Rval0), redoip(Rval)) :-
+jumpopt.short_labels_lval(Instrmap, redoip_slot(Rval0), redoip_slot(Rval)) :-
jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, redofr(Rval0), redofr(Rval)) :-
+jumpopt.short_labels_lval(Instrmap, redofr_slot(Rval0), redofr_slot(Rval)) :-
jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, succfr(Rval0), succfr(Rval)) :-
+jumpopt.short_labels_lval(Instrmap, succfr_slot(Rval0), succfr_slot(Rval)) :-
jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, prevfr(Rval0), prevfr(Rval)) :-
+jumpopt.short_labels_lval(Instrmap, prevfr_slot(Rval0), prevfr_slot(Rval)) :-
jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
jumpopt.short_labels_lval(Instrmap, field(Tag, Rval0, Field0),
field(Tag, Rval, Field)) :-
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.75
diff -u -b -r1.75 livemap.m
--- compiler/livemap.m 6 Apr 2006 05:38:50 -0000 1.75
+++ compiler/livemap.m 8 Apr 2006 14:16:59 -0000
@@ -373,8 +373,8 @@
livemap.special_code_addr(label(_), no).
livemap.special_code_addr(imported(_), no).
livemap.special_code_addr(succip, yes(succip)).
-livemap.special_code_addr(do_succeed(_), yes(succip(lval(curfr)))).
-livemap.special_code_addr(do_redo, yes(redoip(lval(maxfr)))).
+livemap.special_code_addr(do_succeed(_), yes(succip_slot(lval(curfr)))).
+livemap.special_code_addr(do_redo, yes(redoip_slot(lval(maxfr)))).
livemap.special_code_addr(do_trace_redo_fail_shallow, no).
livemap.special_code_addr(do_trace_redo_fail_deep, no).
livemap.special_code_addr(do_fail, no).
Index: compiler/ll_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ll_backend.m,v
retrieving revision 1.14
diff -u -b -r1.14 ll_backend.m
--- compiler/ll_backend.m 10 Apr 2006 04:28:21 -0000 1.14
+++ compiler/ll_backend.m 12 Apr 2006 05:34:56 -0000
@@ -51,6 +51,7 @@
:- include_module trace.
:- include_module code_info.
+ :- include_module lookup_util.
:- include_module exprn_aux.
:- include_module continuation_info.
:- include_module var_locn.
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.329
diff -u -b -r1.329 llds.m
--- compiler/llds.m 30 Mar 2006 02:45:56 -0000 1.329
+++ compiler/llds.m 12 Apr 2006 08:18:08 -0000
@@ -159,16 +159,19 @@
:- type c_procedure
---> c_procedure(
cproc_name :: string,
- % predicate name
- cproc_arity :: int,
+ % Predicate name.
+ cproc_orig_arity :: int,
+ % Original arity.
cproc_id :: pred_proc_id,
- % the pred_proc_id this code
+ % The pred_proc_id of this code.
+ cproc_code_model :: code_model,
+ % The code model of the procedure.
cproc_code :: list(instruction),
- % the code for this procedure
+ % The code for this procedure.
cproc_proc_label :: proc_label,
- % proc_label of this procedure
+ % Proc_label of this procedure.
cproc_label_nums :: counter,
- % source for new label numbers
+ % Source for new label numbers.
cproc_may_alter_rtti :: may_alter_rtti
% The compiler is allowed to perform
% optimizations on this c_procedure
@@ -213,9 +216,9 @@
% call whenever its return address leads to the procedure epilogue.
:- type call_model
- ---> det
- ; semidet
- ; nondet(nondet_tail_call).
+ ---> call_model_det
+ ; call_model_semidet
+ ; call_model_nondet(nondet_tail_call).
% The type defines the various LLDS virtual machine instructions.
% Each instruction gets compiled to a simple piece of C code
@@ -774,26 +777,26 @@
% value of `curfr'. These are used in nondet code. Framevar slot
% numbers start at 1.
- ; succip(rval)
+ ; succip_slot(rval)
% The succip slot of the specified nondet stack frame; holds the
% code address to jump to on successful exit from this nondet
% procedure.
- ; redoip(rval)
+ ; redoip_slot(rval)
% The redoip slot of the specified nondet stack frame; holds the
% code address to jump to on failure.
- ; redofr(rval)
+ ; redofr_slot(rval)
% The redofr slot of the specified nondet stack frame; holds the
% address of the frame that the curfr register should be set to
% when backtracking through the redoip slot.
- ; succfr(rval)
+ ; succfr_slot(rval)
% The succfr slot of the specified nondet stack frame; holds the
% address of caller's nondet stack frame. On successful exit
% from this nondet procedure, we will set curfr to this value.
- ; prevfr(rval)
+ ; prevfr_slot(rval)
% The prevfr slot of the specified nondet stack frame; holds the
% address of the previous frame on the nondet stack.
@@ -1120,11 +1123,11 @@
register_type(RegType, Type).
lval_type(stackvar(_), word).
lval_type(framevar(_), word).
-lval_type(succip(_), code_ptr).
-lval_type(redoip(_), code_ptr).
-lval_type(redofr(_), data_ptr).
-lval_type(succfr(_), data_ptr).
-lval_type(prevfr(_), data_ptr).
+lval_type(succip_slot(_), code_ptr).
+lval_type(redoip_slot(_), code_ptr).
+lval_type(redofr_slot(_), data_ptr).
+lval_type(succfr_slot(_), data_ptr).
+lval_type(prevfr_slot(_), data_ptr).
lval_type(field(_, _, _), word).
lval_type(lvar(_), _) :-
unexpected(this_file, "lvar unexpected in llds.lval_type").
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.276
diff -u -b -r1.276 llds_out.m
--- compiler/llds_out.m 30 Mar 2006 02:45:56 -0000 1.276
+++ compiler/llds_out.m 22 Apr 2006 02:32:07 -0000
@@ -1059,9 +1059,9 @@
PrintComments = yes,
io.write_string("/* ", !IO),
prog_out.write_context(Context, !IO),
- io.write_string(" pragma foreign_decl_code( ", !IO),
+ io.write_string(" pragma foreign_decl_code(", !IO),
io.write(Lang, !IO),
- io.write_string(" */\n", !IO)
+ io.write_string(") */\n", !IO)
;
PrintComments = no
),
@@ -1381,7 +1381,7 @@
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_c_procedure_decls(StackLayoutLabels, Proc, !DeclSet, !IO) :-
- Proc = c_procedure(_Name, _Arity, _PredProcId, Instrs, _, _, _),
+ Proc = c_procedure(_Name, _Arity, _PredProcId, _Model, Instrs, _, _, _),
list.foldl2(output_instruction_decls(StackLayoutLabels), Instrs,
!DeclSet, !IO).
@@ -1389,7 +1389,7 @@
io::di, io::uo) is det.
output_c_procedure(PrintComments, EmitCLoops, Proc, !IO) :-
- Proc = c_procedure(Name, Arity, proc(_, ProcId), Instrs, _, _, _),
+ Proc = c_procedure(Name, Arity, proc(_, ProcId), _, Instrs, _, _, _),
proc_id_to_int(ProcId, ModeNum),
(
PrintComments = yes,
@@ -1461,7 +1461,7 @@
;
Instr = join_and_continue(_, ContLabel)
;
- Instr = assign(redoip(_), const(Const)),
+ Instr = assign(redoip_slot(_), const(Const)),
Const = code_addr_const(label(ContLabel))
)
->
@@ -1873,11 +1873,38 @@
output_block_end(!IO) :-
io.write_string("\t}\n", !IO).
+:- pred output_comment_chars(char::in, list(char)::in, io::di, io::uo) is det.
+
+output_comment_chars(_PrevChar, [], !IO).
+output_comment_chars(PrevChar, [Char | Chars], !IO) :-
+ (
+ PrevChar = ('/'),
+ Char = ('*')
+ ->
+ io.write_string(" *", !IO)
+ ;
+ PrevChar = ('*'),
+ Char = ('/')
+ ->
+ io.write_string(" /", !IO)
+ ;
+ io.write_char(Char, !IO)
+ ),
+ output_comment_chars(Char, Chars, !IO).
+
:- pred output_instruction(instr::in, pair(label, set_tree234(label))::in,
io::di, io::uo) is det.
output_instruction(comment(Comment), _, !IO) :-
- io.write_strings(["/*", Comment, "*/\n"], !IO).
+ % Ensure that any comments embedded inside Comment are made safe, i.e.
+ % prevent the closing of embedded comments from closing the outer comment.
+ % The fact that the code here is not very efficient doesn't matter since
+ % we write out comments only with --auto-comments, which we enable only
+ % when we want to debug the generated C code.
+ io.write_string("/*", !IO),
+ string.to_char_list(Comment, CommentChars),
+ output_comment_chars('*', CommentChars, !IO),
+ io.write_string("*/\n", !IO).
output_instruction(livevals(LiveVals), _, !IO) :-
io.write_string("/*\n* Live lvalues:\n", !IO),
@@ -3148,24 +3175,24 @@
output_lval_decls_format(succip, _, _, !N, !DeclSet, !IO).
output_lval_decls_format(maxfr, _, _, !N, !DeclSet, !IO).
output_lval_decls_format(curfr, _, _, !N, !DeclSet, !IO).
-output_lval_decls_format(succfr(Rval), FirstIndent, LaterIndent, !N, !DeclSet,
- !IO) :-
+output_lval_decls_format(succfr_slot(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
output_rval_decls_format(Rval, FirstIndent, LaterIndent, !N, !DeclSet,
!IO).
-output_lval_decls_format(prevfr(Rval), FirstIndent, LaterIndent, !N, !DeclSet,
- !IO) :-
+output_lval_decls_format(prevfr_slot(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
output_rval_decls_format(Rval, FirstIndent, LaterIndent, !N, !DeclSet,
!IO).
-output_lval_decls_format(redofr(Rval), FirstIndent, LaterIndent, !N, !DeclSet,
- !IO) :-
+output_lval_decls_format(redofr_slot(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
output_rval_decls_format(Rval, FirstIndent, LaterIndent, !N, !DeclSet,
!IO).
-output_lval_decls_format(redoip(Rval), FirstIndent, LaterIndent, !N, !DeclSet,
- !IO) :-
+output_lval_decls_format(redoip_slot(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
output_rval_decls_format(Rval, FirstIndent, LaterIndent, !N, !DeclSet,
!IO).
-output_lval_decls_format(succip(Rval), FirstIndent, LaterIndent, !N, !DeclSet,
- !IO) :-
+output_lval_decls_format(succip_slot(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
output_rval_decls_format(Rval, FirstIndent, LaterIndent, !N, !DeclSet,
!IO).
output_lval_decls_format(hp, _, _, !N, !DeclSet, !IO).
@@ -4699,23 +4726,23 @@
io.write_string("MR_maxfr", !IO).
output_lval(curfr, !IO) :-
io.write_string("MR_curfr", !IO).
-output_lval(succfr(Rval), !IO) :-
+output_lval(succfr_slot(Rval), !IO) :-
io.write_string("MR_succfr_slot(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval(prevfr(Rval), !IO) :-
+output_lval(prevfr_slot(Rval), !IO) :-
io.write_string("MR_prevfr_slot(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval(redofr(Rval), !IO) :-
+output_lval(redofr_slot(Rval), !IO) :-
io.write_string("MR_redofr_slot(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval(redoip(Rval), !IO) :-
+output_lval(redoip_slot(Rval), !IO) :-
io.write_string("MR_redoip_slot(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval(succip(Rval), !IO) :-
+output_lval(succip_slot(Rval), !IO) :-
io.write_string("MR_succip_slot(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
@@ -4789,23 +4816,23 @@
io.write_string("MR_maxfr_word", !IO).
output_lval_for_assign(curfr, word, !IO) :-
io.write_string("MR_curfr_word", !IO).
-output_lval_for_assign(succfr(Rval), word, !IO) :-
+output_lval_for_assign(succfr_slot(Rval), word, !IO) :-
io.write_string("MR_succfr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(prevfr(Rval), word, !IO) :-
+output_lval_for_assign(prevfr_slot(Rval), word, !IO) :-
io.write_string("MR_prevfr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(redofr(Rval), word, !IO) :-
+output_lval_for_assign(redofr_slot(Rval), word, !IO) :-
io.write_string("MR_redofr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(redoip(Rval), word, !IO) :-
+output_lval_for_assign(redoip_slot(Rval), word, !IO) :-
io.write_string("MR_redoip_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(succip(Rval), word, !IO) :-
+output_lval_for_assign(succip_slot(Rval), word, !IO) :-
io.write_string("MR_succip_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
@@ -4940,8 +4967,8 @@
list(label)::in, list(label)::out) is det.
gather_labels_from_c_procs([], Labels, Labels).
-gather_labels_from_c_procs([c_procedure(_, _, _, Instrs, _, _, _) | Procs],
- !Labels) :-
+gather_labels_from_c_procs([Proc | Procs], !Labels) :-
+ Instrs = Proc ^ cproc_code,
gather_labels_from_instrs(Instrs, !Labels),
gather_labels_from_c_procs(Procs, !Labels).
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.65
diff -u -b -r1.65 lookup_switch.m
--- compiler/lookup_switch.m 30 Mar 2006 02:45:57 -0000 1.65
+++ compiler/lookup_switch.m 22 Apr 2006 12:39:45 -0000
@@ -7,7 +7,7 @@
%-----------------------------------------------------------------------------%
% File: lookup_switch.m.
-% Author: conway.
+% Authors: conway, zs.
% For switches on atomic types in which the cases contain only the
% construction of constants, generate code which just assigns the values of
@@ -55,6 +55,7 @@
:- type lookup_switch_info.
% Decide whether we can generate code for this switch using a lookup table.
+ % The cases_list must be sorted on the index values.
%
:- pred is_lookup_switch(prog_var::in, cases_list::in,
hlds_goal_info::in, can_fail::in, int::in, abs_store_map::in,
@@ -75,6 +76,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
+:- import_module hlds.goal_form.
:- import_module hlds.hlds_data.
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
@@ -82,9 +84,11 @@
:- import_module libs.options.
:- import_module libs.tree.
:- import_module ll_backend.code_gen.
+:- import_module ll_backend.continuation_info.
:- import_module ll_backend.dense_switch.
:- import_module ll_backend.exprn_aux.
:- import_module ll_backend.global_data.
+:- import_module ll_backend.lookup_util.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
@@ -96,8 +100,32 @@
:- import_module pair.
:- import_module set.
:- import_module solutions.
+:- import_module string.
-:- type case_consts == assoc_list(int, list(rval)).
+:- type case_consts
+ ---> all_one_soln(
+ assoc_list(int, list(rval))
+ )
+ ; some_several_solns(
+ assoc_list(int, soln_consts),
+ set(prog_var), % The resume vars.
+ bool % The Boolean "or" of the result
+ % of invoking should_emit_trail_ops
+ % on the goal_infos of the
+ % disjunctions.
+ ).
+
+:- type soln_consts
+ ---> one_soln(list(rval))
+ ; several_solns(list(list(rval))).
+
+:- type need_range_check
+ ---> need_range_check
+ ; dont_need_range_check.
+
+:- type need_bit_vec_check
+ ---> need_bit_vec_check
+ ; dont_need_bit_vec_check.
:- type lookup_switch_info
---> lookup_switch_info(
@@ -108,25 +136,26 @@
% switch.
lsi_cases :: case_consts,
% The map from the switched-on value
- % to the the values of the variables.
+ % to the values of the variables
+ % in each solution.
lsi_variables :: list(prog_var),
% The output variables.
lsi_field_types :: list(llds_type),
% The types of the fields in the C
% structure we generate for each case.
- lsi_need_range_check :: can_fail,
- lsi_need_bit_vec_check :: can_fail,
+ lsi_need_range_check :: need_range_check,
+ lsi_need_bit_vec_check :: need_bit_vec_check,
% Do we need a range check and/or a
% bit vector check on the switched-on
% variable?
- lsi_liveness :: maybe(set(prog_var))
+ lsi_liveness :: set(prog_var)
).
%-----------------------------------------------------------------------------%
% Most of this predicate is taken from dense_switch.m.
%
-is_lookup_switch(CaseVar, TaggedCases, GoalInfo, SwitchCanFail, ReqDensity,
+is_lookup_switch(CaseVar, TaggedCases0, GoalInfo, SwitchCanFail0, ReqDensity,
StoreMap, !MaybeEnd, CodeModel, LookupSwitchInfo, !CI) :-
% We need the code_info structure to generate code for the cases to
% get the constants (if they exist). We can't throw it away at the
@@ -141,6 +170,25 @@
code_info.get_globals(!.CI, Globals),
globals.lookup_bool_option(Globals, static_ground_terms, yes),
+ goal_info_get_code_model(GoalInfo, CodeModel),
+ (
+ ( CodeModel = model_non
+ ; CodeModel = model_semi
+ ),
+ % We build up the list in reverse because that is linear and uses
+ % constant stack space, whereas building it up in the right order
+ % would either use linear stack space or require a quadratic algorithm.
+ % This doesn't matter if TaggedCases0 is short, but does matter if it
+ % contains thousands of elements.
+ filter_out_failing_cases(TaggedCases0, [], RevTaggedCases,
+ SwitchCanFail0, SwitchCanFail),
+ list.reverse(RevTaggedCases, TaggedCases)
+ ;
+ CodeModel = model_det,
+ TaggedCases = TaggedCases0,
+ SwitchCanFail = SwitchCanFail0
+ ),
+
% We want to generate a lookup switch for any switch that is dense enough
% - we don't care how many cases it has. A memory lookup tends to be
% cheaper than a branch.
@@ -157,13 +205,13 @@
% If there are going to be no gaps in the lookup table then we won't need
% a bitvector test to see if this switch has a value for this case.
( NumCases = Range ->
- NeedBitVecCheck0 = cannot_fail
+ NeedBitVecCheck0 = dont_need_bit_vec_check
;
- NeedBitVecCheck0 = can_fail
+ NeedBitVecCheck0 = need_bit_vec_check
),
(
SwitchCanFail = can_fail,
- % For semidet switches, we normally need to check that the variable
+ % For can_fail switches, we normally need to check that the variable
% is in range before we index into the jump table. However, if the
% range of the type is sufficiently small, we can make the jump table
% large enough to hold all of the values for the type, but then we
@@ -176,142 +224,143 @@
dense_switch.calc_density(NumCases, TypeRange, DetDensity),
DetDensity > ReqDensity
->
- NeedRangeCheck = cannot_fail,
- NeedBitVecCheck = can_fail,
+ NeedRangeCheck = dont_need_range_check,
+ NeedBitVecCheck = need_bit_vec_check,
FirstVal = 0,
LastVal = TypeRange - 1
;
- NeedRangeCheck = SwitchCanFail,
+ NeedRangeCheck = need_range_check,
NeedBitVecCheck = NeedBitVecCheck0,
FirstVal = FirstCaseVal,
LastVal = LastCaseVal
)
;
SwitchCanFail = cannot_fail,
- NeedRangeCheck = cannot_fail,
+ NeedRangeCheck = dont_need_range_check,
NeedBitVecCheck = NeedBitVecCheck0,
FirstVal = FirstCaseVal,
LastVal = LastCaseVal
),
figure_out_output_vars(!.CI, GoalInfo, OutVars),
- generate_constants(TaggedCases, OutVars, StoreMap, !MaybeEnd, CodeModel,
- CaseValuePairs, MaybeLiveness, !CI),
+ generate_constants(TaggedCases, OutVars, StoreMap, !MaybeEnd,
+ CaseSolns, MaybeLiveness, set.init, ResumeVars, no, GoalTrailOps, !CI),
+ (
+ MaybeLiveness = yes(Liveness)
+ ;
+ MaybeLiveness = no,
+ unexpected(this_file, "is_lookup_switch: no liveness!")
+ ),
VarTypes = get_var_types(!.CI),
list.map(map.lookup(VarTypes), OutVars, OutTypes),
- assoc_list.values(CaseValuePairs, CaseValues),
+ ( project_all_to_one_solution(CaseSolns, [], RevCaseValuePairs) ->
+ list.reverse(RevCaseValuePairs, CaseValuePairs),
+ CaseConsts = all_one_soln(CaseValuePairs),
+ assoc_list.values(CaseValuePairs, CaseValues)
+ ;
+ CaseConsts = some_several_solns(CaseSolns, ResumeVars, GoalTrailOps),
+ % This generates CaseValues in reverse order of index, but given that
+ % we only use CaseValues to find out the right LLDSTypes, this is OK.
+ project_solns_to_rval_lists(CaseSolns, [], CaseValues)
+ ),
code_info.get_globals(!.CI, Globals),
globals.lookup_bool_option(Globals, unboxed_float, UnboxFloat),
find_general_llds_types(UnboxFloat, OutTypes, CaseValues, LLDSTypes),
- LookupSwitchInfo = lookup_switch_info(FirstVal, LastVal, CaseValuePairs,
- OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, MaybeLiveness).
+ LookupSwitchInfo = lookup_switch_info(FirstVal, LastVal, CaseConsts,
+ OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, Liveness).
+
+:- pred project_all_to_one_solution(assoc_list(int, soln_consts)::in,
+ assoc_list(int, list(rval))::in, assoc_list(int, list(rval))::out)
+ is semidet.
+
+project_all_to_one_solution([], !RevCaseValuePairs).
+project_all_to_one_solution([Case - Solns | CaseSolns], !RevCaseValuePairs) :-
+ Solns = one_soln(Values),
+ !:RevCaseValuePairs = [Case - Values | !.RevCaseValuePairs],
+ project_all_to_one_solution(CaseSolns, !RevCaseValuePairs).
+
+:- pred project_solns_to_rval_lists(assoc_list(int, soln_consts)::in,
+ list(list(rval))::in, list(list(rval))::out) is det.
+
+project_solns_to_rval_lists([], !RvalsList).
+project_solns_to_rval_lists([Case | Cases], !RvalsList) :-
+ Case = _Index - Soln,
+ (
+ Soln = one_soln(Rvals),
+ !:RvalsList = [Rvals | !.RvalsList]
+ ;
+ Soln = several_solns(SolnRvalsList),
+ !:RvalsList = SolnRvalsList ++ !.RvalsList
+ ),
+ project_solns_to_rval_lists(Cases, !RvalsList).
%---------------------------------------------------------------------------%
- % Figure out which variables are bound in the switch.
- % We do this by using the current instmap and the instmap delta in the
- % goal info to work out which variables are [further] bound by the switch.
- %
-:- pred figure_out_output_vars(code_info::in, hlds_goal_info::in,
- list(prog_var)::out) is det.
+:- pred filter_out_failing_cases(cases_list::in,
+ cases_list::in, cases_list::out, can_fail::in, can_fail::out) is det.
-figure_out_output_vars(CI, GoalInfo, OutVars) :-
- goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
- ( instmap_delta_is_unreachable(InstMapDelta) ->
- OutVars = []
- ;
- code_info.get_instmap(CI, CurrentInstMap),
- code_info.get_module_info(CI, ModuleInfo),
- instmap_delta_changed_vars(InstMapDelta, ChangedVars),
- instmap.apply_instmap_delta(CurrentInstMap, InstMapDelta,
- InstMapAfter),
- Lambda = (pred(Var::out) is nondet :-
- % If a variable has a final inst, then it changed
- % instantiatedness during the switch.
- set.member(Var, ChangedVars),
- instmap.lookup_var(CurrentInstMap, Var, Initial),
- instmap.lookup_var(InstMapAfter, Var, Final),
- mode_is_output(ModuleInfo, (Initial -> Final))
+filter_out_failing_cases([], !RevTaggedCases, !SwitchCanFail).
+filter_out_failing_cases([Case | Cases], !RevTaggedCases, !SwitchCanFail) :-
+ Case = case(_, _, _, Goal),
+ Goal = GoalExpr - _,
+ ( GoalExpr = disj([]) ->
+ !:SwitchCanFail = can_fail
+ ;
+ !:RevTaggedCases = [Case | !.RevTaggedCases]
),
- solutions.solutions(Lambda, OutVars)
- ).
+ filter_out_failing_cases(Cases, !RevTaggedCases, !SwitchCanFail).
%---------------------------------------------------------------------------%
- % To figure out if the outputs are constants, we generate code for
- % the cases, and check to see if each of the output vars is a constant,
- % and that no actual code was generated for the goal.
- %
:- pred generate_constants(cases_list::in, list(prog_var)::in,
- abs_store_map::in, branch_end::in, branch_end::out, code_model::in,
- case_consts::out, maybe(set(prog_var))::out,
+ abs_store_map::in, branch_end::in, branch_end::out,
+ assoc_list(int, soln_consts)::out, maybe(set(prog_var))::out,
+ set(prog_var)::in, set(prog_var)::out, bool::in, bool::out,
code_info::in, code_info::out) is semidet.
-generate_constants([], _Vars, _StoreMap, !MaybeEnd, _CodeModel, [], no, !CI).
-generate_constants([Case | Cases], Vars, StoreMap, !MaybeEnd, CodeModel,
- [CaseVal | Rest], yes(Liveness), !CI) :-
+generate_constants([], _Vars, _StoreMap, !MaybeEnd, [], no, !ResumeVars,
+ !GoalTrailOps, !CI).
+generate_constants([Case | Cases], Vars, StoreMap, !MaybeEnd, [CaseVal | Rest],
+ MaybeLiveness, !ResumeVars, !GoalTrailOps, !CI) :-
Case = case(_, int_constant(CaseTag), _, Goal),
- code_info.remember_position(!.CI, BranchStart),
- code_gen.generate_goal(CodeModel, Goal, Code, !CI),
- tree.tree_of_lists_is_empty(Code),
- code_info.get_forward_live_vars(!.CI, Liveness),
- get_case_rvals(Vars, CaseRvals, !CI),
- CaseVal = CaseTag - CaseRvals,
- % EndCode code may contain instructions that place Vars in the locations
- % dictated by StoreMap, and thus does not have to be empty. (The array
- % lookup code will put those variables in those locations directly.)
- code_info.generate_branch_end(StoreMap, !MaybeEnd, _EndCode, !CI),
- code_info.reset_to_position(BranchStart, !CI),
- generate_constants(Cases, Vars, StoreMap, !MaybeEnd,
- CodeModel, Rest, _, !CI).
-
-%---------------------------------------------------------------------------%
-
-:- pred get_case_rvals(list(prog_var)::in, list(rval)::out,
- code_info::in, code_info::out) is semidet.
-
-get_case_rvals([], [], !CI).
-get_case_rvals([Var | Vars], [Rval | Rvals], !CI) :-
- code_info.produce_variable(Var, Code, Rval, !CI),
- tree.tree_of_lists_is_empty(Code),
- code_info.get_globals(!.CI, Globals),
- globals.get_options(Globals, Options),
- exprn_aux.init_exprn_opts(Options, ExprnOpts),
- rval_is_constant(Rval, ExprnOpts),
- get_case_rvals(Vars, Rvals, !CI).
-
-%---------------------------------------------------------------------------%
-
- % rval_is_constant(Rval, ExprnOpts) is true iff Rval is a constant.
- % This depends on the options governing nonlocal gotos, asm labels enabled
- % and static ground terms, etc.
- %
-:- pred rval_is_constant(rval::in, exprn_opts::in) is semidet.
-
-rval_is_constant(const(Const), ExprnOpts) :-
- exprn_aux.const_is_constant(Const, ExprnOpts, yes).
-rval_is_constant(unop(_, Exprn), ExprnOpts) :-
- rval_is_constant(Exprn, ExprnOpts).
-rval_is_constant(binop(_, Exprn0, Exprn1), ExprnOpts) :-
- rval_is_constant(Exprn0, ExprnOpts),
- rval_is_constant(Exprn1, ExprnOpts).
-rval_is_constant(mkword(_, Exprn0), ExprnOpts) :-
- rval_is_constant(Exprn0, ExprnOpts).
-
-:- pred rvals_are_constant(list(maybe(rval))::in,
- exprn_opts::in) is semidet.
-
-rvals_are_constant([], _).
-rvals_are_constant([MRval | MRvals], ExprnOpts) :-
- MRval = yes(Rval),
- rval_is_constant(Rval, ExprnOpts),
- rvals_are_constant(MRvals, ExprnOpts).
+ Goal = GoalExpr - GoalInfo,
+ ( GoalExpr = disj(Disjuncts) ->
+ bool.or(goal_may_modify_trail(GoalInfo), !GoalTrailOps),
+ (
+ Disjuncts = [],
+ % Cases like this should have been filtered out by
+ % filter_out_failing_cases above.
+ unexpected(this_file, "generate_constants: disj([])")
+ ;
+ Disjuncts = [FirstDisjunct | _],
+ FirstDisjunct = _ - FirstDisjunctGoalInfo,
+ goal_info_get_resume_point(FirstDisjunctGoalInfo, ThisResumePoint),
+ (
+ ThisResumePoint = resume_point(ThisResumeVars, _),
+ set.union(ThisResumeVars, !ResumeVars)
+ ;
+ ThisResumePoint = no_resume_point
+ )
+ ),
+ all_disjuncts_are_conj_of_unify(Disjuncts, StdDisjuncts),
+ generate_constants_for_disjuncts(StdDisjuncts, Vars, StoreMap,
+ !MaybeEnd, Solns, MaybeLiveness, !CI),
+ CaseVal = CaseTag - several_solns(Solns)
+ ;
+ goal_is_conj_of_unify(Goal, StdGoal),
+ generate_constants_for_arm(StdGoal, Vars, StoreMap, !MaybeEnd, Soln,
+ Liveness, !CI),
+ MaybeLiveness = yes(Liveness),
+ CaseVal = CaseTag - one_soln(Soln)
+ ),
+ generate_constants(Cases, Vars, StoreMap, !MaybeEnd, Rest, _, !ResumeVars,
+ !GoalTrailOps, !CI).
%---------------------------------------------------------------------------%
generate_lookup_switch(Var, StoreMap, MaybeEnd0, LookupSwitchInfo, Code,
!CI) :-
- LookupSwitchInfo = lookup_switch_info(StartVal, EndVal, CaseValues,
- OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, MaybeLiveness),
+ LookupSwitchInfo = lookup_switch_info(StartVal, EndVal, CaseConsts,
+ OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, Liveness),
% Evaluate the variable which we are going to be switching on.
code_info.produce_variable(Var, VarCode, Rval, !CI),
@@ -324,34 +373,60 @@
IndexRval = binop(int_sub, Rval, const(int_const(StartVal)))
),
- % If the switch is not locally deterministic, we need to check that
+ % If the switch is not locally deterministic, we may need to check that
% the value of the variable lies within the appropriate range.
(
- NeedRangeCheck = can_fail,
+ NeedRangeCheck = need_range_check,
Difference = EndVal - StartVal,
CmpRval = binop(unsigned_le, IndexRval, const(int_const(Difference))),
code_info.fail_if_rval_is_false(CmpRval, RangeCheckCode, !CI)
;
- NeedRangeCheck = cannot_fail,
+ NeedRangeCheck = dont_need_range_check,
RangeCheckCode = empty
),
+
+ (
+ CaseConsts = all_one_soln(CaseValues),
+ Comment = node([comment("simple lookup switch") - ""]),
+ generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
+ StartVal, EndVal, CaseValues, OutVars, LLDSTypes,
+ NeedBitVecCheck, Liveness, RestCode, !CI)
+ ;
+ CaseConsts = some_several_solns(CaseSolns, ResumeVars, GoalTrailOps),
+ get_emit_trail_ops(!.CI, EmitTrailOps),
+ bool.and(EmitTrailOps, GoalTrailOps, AddTrailOps),
+ Comment = node([comment("several soln lookup switch") - ""]),
+ generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
+ StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
+ LLDSTypes, NeedBitVecCheck, Liveness, RestCode, !CI)
+ ),
+ Code = tree_list([Comment, VarCode, RangeCheckCode, RestCode]).
+
+:- pred generate_simple_lookup_switch(rval::in, abs_store_map::in,
+ branch_end::in, int::in, int::in, assoc_list(int, list(rval))::in,
+ list(prog_var)::in, list(llds_type)::in, need_bit_vec_check::in,
+ set(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+
+generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0, StartVal, EndVal,
+ CaseValues, OutVars, LLDSTypes, NeedBitVecCheck, Liveness, Code,
+ !CI) :-
(
- NeedBitVecCheck = can_fail,
+ NeedBitVecCheck = need_bit_vec_check,
generate_bitvec_test(IndexRval, CaseValues, StartVal, EndVal,
CheckBitVecCode, !CI)
;
- NeedBitVecCheck = cannot_fail,
+ NeedBitVecCheck = dont_need_bit_vec_check,
CheckBitVecCode = empty
),
- % Now generate the terms into which we do the lookups of the values of
- % the output variables, if there are any.
+ % Now generate the static cells into which we do the lookups of the values
+ % of the output variables, if there are any.
%
- % Note that invoking generate_terms when OutVars = [] would lead to
+ % Note that invoking generate_simple_terms when OutVars = [] would lead to
% a compiler abort, since we cannot create C structures with zero fields.
(
OutVars = [],
- BaseRegCode = empty,
+ BaseRegInitCode = empty,
MaybeBaseReg = no
;
OutVars = [_ | _],
@@ -360,20 +435,14 @@
% BaseReg.
code_info.acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
MaybeBaseReg = yes(BaseReg),
- generate_terms(IndexRval, OutVars, LLDSTypes, CaseValues, StartVal,
- BaseRegCode, BaseReg, !CI)
+ generate_simple_terms(IndexRval, OutVars, LLDSTypes, CaseValues,
+ StartVal, BaseReg, BaseRegInitCode, !CI)
),
% We keep track of what variables are supposed to be live at the end
% of cases. We have to do this explicitly because generating a `fail' slot
% last would yield the wrong liveness.
- (
- MaybeLiveness = yes(Liveness),
- code_info.set_forward_live_vars(Liveness, !CI)
- ;
- MaybeLiveness = no,
- unexpected(this_file, "generate_lookup_switch: no liveness!")
- ),
+ code_info.set_forward_live_vars(Liveness, !CI),
code_info.generate_branch_end(StoreMap, MaybeEnd0, _MaybeEnd,
BranchEndCode, !CI),
(
@@ -382,9 +451,407 @@
MaybeBaseReg = yes(FinalBaseReg),
code_info.release_reg(FinalBaseReg, !CI)
),
- Comment = node([comment("lookup switch") - ""]),
- Code = tree_list([Comment, VarCode, RangeCheckCode, CheckBitVecCode,
- BaseRegCode, BranchEndCode]).
+ Code = tree_list([CheckBitVecCode, BaseRegInitCode, BranchEndCode]).
+
+ % Add an expression to the expression cache in the code_info structure
+ % for each of the output variables of the lookup switch. This is done by
+ % creating a `create' term for the array, and caching an expression
+ % for the variable to get the IndexRval'th field of that term.
+ %
+:- pred generate_simple_terms(rval::in, list(prog_var)::in,
+ list(llds_type)::in, assoc_list(int, list(rval))::in, int::in,
+ lval::in, code_tree::out, code_info::in, code_info::out) is det.
+
+generate_simple_terms(IndexRval, OutVars, OutTypes, CaseVals, Start, BaseReg,
+ Code, !CI) :-
+ list.length(OutVars, NumOutVars),
+ construct_simple_vector(Start, OutTypes, CaseVals, VectorRvals),
+ code_info.add_vector_static_cell(OutTypes, VectorRvals, VectorAddr, !CI),
+
+ VectorAddrRval = const(data_addr_const(VectorAddr, no)),
+ % IndexRval has already had Start subtracted from it.
+ ( NumOutVars = 1 ->
+ BaseRval = IndexRval
+ ;
+ BaseRval = binop(int_mul, IndexRval, const(int_const(NumOutVars)))
+ ),
+ Code = node([
+ assign(BaseReg, mem_addr(heap_ref(VectorAddrRval, 0, BaseRval)))
+ - "Compute base address for this case"
+ ]),
+ generate_offset_assigns(OutVars, 0, BaseReg, !CI).
+
+:- pred construct_simple_vector(int::in, list(llds_type)::in,
+ assoc_list(int, list(rval))::in, list(list(rval))::out) is det.
+
+construct_simple_vector(_, _, [], []).
+construct_simple_vector(CurIndex, LLDSTypes, [Index - Rvals | Rest],
+ [Row | Rows]) :-
+ ( CurIndex < Index ->
+ % If this argument (array element) is a place-holder and
+ % will never be referenced, just fill it in with a dummy entry.
+ Row = list.map(default_value_for_type, LLDSTypes),
+ Remainder = [Index - Rvals | Rest]
+ ;
+ Row = Rvals,
+ Remainder = Rest
+ ),
+ construct_simple_vector(CurIndex + 1, LLDSTypes, Remainder, Rows).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_several_soln_lookup_switch(rval::in, abs_store_map::in,
+ branch_end::in, int::in, int::in, assoc_list(int, soln_consts)::in,
+ set(prog_var)::in, bool::in, list(prog_var)::in, list(llds_type)::in,
+ need_bit_vec_check::in, set(prog_var)::in, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
+ StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
+ LLDSTypes, NeedBitVecCheck, Liveness, Code, !CI) :-
+ (
+ OutVars = [],
+ % If there are no output variables, then how can the individual
+ % solutions differ from each other?
+ unexpected(this_file,
+ "generate_several_soln_lookup_switch: no OutVars")
+ ;
+ OutVars = [_ | _]
+ ),
+
+ % Now generate the static cells into which we do the lookups of the values
+ % of the output variables, if there are any.
+ %
+ % We put a dummy row at the start
+ list.length(LLDSTypes, NumLLDSTypes),
+ InitRowNumber = 1,
+ DummyLaterSolnRow = list.map(default_value_for_type, LLDSTypes),
+ construct_several_soln_vector(StartVal, EndVal, InitRowNumber,
+ LLDSTypes, NumLLDSTypes, CaseSolns, MainRows,
+ [DummyLaterSolnRow], RevLaterSolnArray,
+ 0, FailCaseCount, 0, OneSolnCaseCount, 0, SeveralSolnCaseCount),
+ (
+ (
+ NeedBitVecCheck = need_bit_vec_check
+ <=>
+ FailCaseCount > 0
+ )
+ ->
+ true
+ ;
+ unexpected(this_file,
+ "generate_several_soln_lookup_switch: bad FailCaseCount")
+ ),
+
+ list.reverse(RevLaterSolnArray, LaterSolnArray),
+ MainRowTypes = [integer, integer | LLDSTypes],
+ list.length(MainRowTypes, MainRowWidth),
+ code_info.add_vector_static_cell(MainRowTypes, MainRows,
+ MainVectorAddr, !CI),
+ MainVectorAddrRval = const(data_addr_const(MainVectorAddr, no)),
+ code_info.add_vector_static_cell(LLDSTypes, LaterSolnArray,
+ LaterVectorAddr, !CI),
+ LaterVectorAddrRval = const(data_addr_const(LaterVectorAddr, no)),
+
+ % Since we release BaseReg only after the calls to generate_branch_end,
+ % we must make sure that generate_branch_end won't want to overwrite
+ % BaseReg.
+ code_info.acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ code_info.acquire_temp_slot(lookup_switch_cur, CurSlot, !CI),
+ code_info.acquire_temp_slot(lookup_switch_max, MaxSlot, !CI),
+ % IndexRval has already had Start subtracted from it.
+ BaseRval = binop(int_mul, IndexRval, const(int_const(MainRowWidth))),
+ BaseRegInitCode = node([
+ assign(BaseReg, mem_addr(heap_ref(MainVectorAddrRval, 0, BaseRval)))
+ - "Compute base address for this case"
+ ]),
+
+ list.sort([FailCaseCount - kind_zero_solns,
+ OneSolnCaseCount - kind_one_soln,
+ SeveralSolnCaseCount - kind_several_solns], AscendingSortedKinds),
+ list.reverse(AscendingSortedKinds, DescendingSortedKinds),
+
+ code_info.get_next_label(EndLabel, !CI),
+ code_info.remember_position(!.CI, BranchStart),
+ generate_code_for_each_kind(DescendingSortedKinds, BaseReg,
+ CurSlot, MaxSlot, LaterVectorAddrRval, EndLabel, BranchStart,
+ ResumeVars, AddTrailOps, OutVars, StoreMap, MaybeEnd0, Liveness,
+ KindsCode, !CI),
+
+ code_info.release_reg(BaseReg, !CI),
+ % We cannot release the stack slots, since they will be needed after
+ % backtracking.
+ code_info.set_resume_point_to_unknown(!CI),
+ EndLabelCode = node([
+ label(EndLabel) - "end of several_soln lookup switch"
+ ]),
+ Code = tree_list([BaseRegInitCode, KindsCode, EndLabelCode]).
+
+:- type case_kind
+ ---> kind_zero_solns
+ ; kind_one_soln
+ ; kind_several_solns.
+
+:- func case_kind_to_string(case_kind) = string.
+
+case_kind_to_string(kind_zero_solns) = "kind_zero_solns".
+case_kind_to_string(kind_one_soln) = "kind_one_soln".
+case_kind_to_string(kind_several_solns) = "kind_several_solns".
+
+:- pred generate_code_for_each_kind(assoc_list(int, case_kind)::in,
+ lval::in, lval::in, lval::in, rval::in, label::in, position_info::in,
+ set(prog_var)::in, bool::in, list(prog_var)::in, abs_store_map::in,
+ branch_end::in, set(prog_var)::in, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+generate_code_for_each_kind([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+ unexpected(this_file, "generate_code_for_each_kind: no kinds").
+generate_code_for_each_kind([_ - Kind | Kinds], BaseReg, CurSlot, MaxSlot,
+ LaterVectorAddrRval, EndLabel, BranchStart, ResumeVars, AddTrailOps,
+ OutVars, StoreMap, MaybeEnd0, Liveness, Code, !CI) :-
+ (
+ Kind = kind_zero_solns,
+ TestOp = int_ge,
+ code_info.reset_to_position(BranchStart, !CI),
+ code_info.generate_failure(KindCode, !CI)
+ ;
+ Kind = kind_one_soln,
+ TestOp = ne,
+ code_info.reset_to_position(BranchStart, !CI),
+ generate_offset_assigns(OutVars, 2, BaseReg, !CI),
+ set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ BranchEndCode, !CI),
+ GotoEndCode = node([
+ goto(label(EndLabel)) - "goto end of switch from one_soln"
+ ]),
+ KindCode = tree_list([BranchEndCode, GotoEndCode])
+ ;
+ Kind = kind_several_solns,
+ TestOp = int_le,
+ code_info.get_globals(!.CI, Globals),
+ code_info.reset_to_position(BranchStart, !CI),
+
+ % The code below is modelled on the code in disj_gen, but is
+ % specialized for the situation here.
+
+ code_info.produce_vars(ResumeVars, ResumeMap, FlushCode, !CI),
+ SaveSlotsCode = node([
+ assign(CurSlot,
+ lval(field(yes(0), lval(BaseReg), const(int_const(0)))))
+ - "Setup current slot in the later solution array",
+ assign(MaxSlot,
+ lval(field(yes(0), lval(BaseReg), const(int_const(1)))))
+ - "Setup maximum slot in the later solution array"
+ ]),
+ code_info.maybe_save_ticket(AddTrailOps, SaveTicketCode,
+ MaybeTicketSlot, !CI),
+ globals.lookup_bool_option(Globals, reclaim_heap_on_nondet_failure,
+ ReclaimHeap),
+ code_info.maybe_save_hp(ReclaimHeap, SaveHpCode, MaybeHpSlot, !CI),
+ code_info.prepare_for_disj_hijack(model_non, HijackInfo,
+ PrepareHijackCode, !CI),
+
+ code_info.remember_position(!.CI, DisjEntry),
+
+ % Generate code for the non-last disjunct.
+
+ code_info.make_resume_point(ResumeVars, stack_only, ResumeMap,
+ ResumePoint, !CI),
+ code_info.effect_resume_point(ResumePoint, model_non, UpdateRedoipCode,
+ !CI),
+ generate_offset_assigns(OutVars, 2, BaseReg, !CI),
+ code_info.flush_resume_vars_to_stack(FirstFlushResumeVarsCode, !CI),
+
+ % Forget the variables that are needed only at the resumption point at
+ % the start of the next disjunct, so that we don't generate exceptions
+ % when their storage is clobbered by the movement of the live
+ % variables to the places indicated in the store map.
+ code_info.pop_resume_point(!CI),
+ code_info.pickup_zombies(FirstZombies, !CI),
+ code_info.make_vars_forward_dead(FirstZombies, !CI),
+
+ set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ FirstBranchEndCode, !CI),
+
+ GotoEndCode = node([
+ goto(label(EndLabel)) - "goto end of switch from several_soln"
+ ]),
+
+ code_info.reset_to_position(DisjEntry, !CI),
+ code_info.generate_resume_point(ResumePoint, ResumePointCode, !CI),
+
+ code_info.maybe_reset_ticket(MaybeTicketSlot, undo, RestoreTicketCode),
+ code_info.maybe_restore_hp(MaybeHpSlot, RestoreHpCode),
+
+ code_info.acquire_reg_not_in_storemap(StoreMap, LaterBaseReg, !CI),
+ code_info.get_next_label(UndoLabel, !CI),
+ code_info.get_next_label(AfterUndoLabel, !CI),
+ list.length(OutVars, NumOutVars),
+ TestMoreSolnsCode = node([
+ assign(LaterBaseReg, lval(CurSlot))
+ - "Init later base register",
+ if_val(binop(int_ge, lval(LaterBaseReg), lval(MaxSlot)),
+ label(UndoLabel))
+ - "Jump to undo hijack code if there are no more solutions",
+ assign(CurSlot,
+ binop(int_add, lval(CurSlot), const(int_const(NumOutVars))))
+ - "Update current slot in the later solution array",
+ goto(label(AfterUndoLabel))
+ - "Jump around undo hijack code",
+ label(UndoLabel)
+ - "Undo hijack code"
+ ]),
+ code_info.undo_disj_hijack(HijackInfo, UndoHijackCode, !CI),
+ AfterUndoLabelCode = node([
+ label(AfterUndoLabel)
+ - "Return later answer code",
+ assign(LaterBaseReg,
+ mem_addr(heap_ref(LaterVectorAddrRval, 0, lval(LaterBaseReg))))
+ - "Compute base address in later array for this solution"
+ ]),
+
+ % We need to call effect_resume_point in order to push ResumePoint
+ % onto the failure continuation stack, so pop_resume_point can pop
+ % it off. However, since the redoip already points there, we don't need
+ % to execute _LaterUpdateRedoipCode.
+ code_info.effect_resume_point(ResumePoint, model_non,
+ _LaterUpdateRedoipCode, !CI),
+
+ generate_offset_assigns(OutVars, 0, LaterBaseReg, !CI),
+ code_info.flush_resume_vars_to_stack(LaterFlushResumeVarsCode, !CI),
+
+ % Forget the variables that are needed only at the resumption point at
+ % the start of the next disjunct, so that we don't generate exceptions
+ % when their storage is clobbered by the movement of the live
+ % variables to the places indicated in the store map.
+ code_info.pop_resume_point(!CI),
+ code_info.pickup_zombies(LaterZombies, !CI),
+ code_info.make_vars_forward_dead(LaterZombies, !CI),
+
+ set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ LaterBranchEndCode, !CI),
+
+ KindCode = tree_list([FlushCode, SaveSlotsCode,
+ SaveTicketCode, SaveHpCode, PrepareHijackCode,
+ UpdateRedoipCode, FirstFlushResumeVarsCode, FirstBranchEndCode,
+ GotoEndCode, ResumePointCode, RestoreTicketCode, RestoreHpCode,
+ TestMoreSolnsCode, UndoHijackCode, AfterUndoLabelCode,
+ LaterFlushResumeVarsCode, LaterBranchEndCode, GotoEndCode])
+ ),
+ (
+ Kinds = [],
+ Code = KindCode
+ ;
+ Kinds = [_ - NextKind | _],
+ code_info.get_next_label(NextKindLabel, !CI),
+ TestRval = binop(TestOp,
+ lval(field(yes(0), lval(BaseReg), const(int_const(0)))),
+ const(int_const(0))),
+ TestCode = node([
+ if_val(TestRval, label(NextKindLabel))
+ - "skip to next kind in several_soln lookup switch",
+ comment("This kind is " ++ case_kind_to_string(Kind))
+ - ""
+ ]),
+ generate_code_for_each_kind(Kinds, BaseReg, CurSlot, MaxSlot,
+ LaterVectorAddrRval, EndLabel, BranchStart, ResumeVars,
+ AddTrailOps, OutVars, StoreMap, MaybeEnd0, Liveness,
+ LaterKindsCode, !CI),
+ NextKindLabelCode = node([
+ label(NextKindLabel)
+ - "next kind in several_soln lookup switch",
+ comment("Next kind is " ++ case_kind_to_string(NextKind))
+ - ""
+ ]),
+ Code = tree_list([TestCode, KindCode, NextKindLabelCode,
+ LaterKindsCode])
+ ).
+
+:- pred set_liveness_and_end_branch(abs_store_map::in, branch_end::in,
+ set(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+
+set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness, BranchEndCode,
+ !CI) :-
+ % We keep track of what variables are supposed to be live at the end
+ % of cases. We have to do this explicitly because generating a `fail' slot
+ % last would yield the wrong liveness.
+ code_info.set_forward_live_vars(Liveness, !CI),
+ code_info.generate_branch_end(StoreMap, MaybeEnd0, _MaybeEnd,
+ BranchEndCode, !CI).
+
+ % Note that we specify --optimise-constructor-last-call for this module
+ % in order to make this predicate tail recursive.
+ %
+:- pred construct_several_soln_vector(int::in, int::in, int::in,
+ list(llds_type)::in, int::in, assoc_list(int, soln_consts)::in,
+ list(list(rval))::out,
+ list(list(rval))::in, list(list(rval))::out,
+ int::in, int::out, int::in, int::out, int::in, int::out) is det.
+
+construct_several_soln_vector(CurIndex, EndVal, !.LaterNextRow, LLDSTypes,
+ NumLLDSTypes, [], MainRows, !RevLaterSolnArray,
+ !FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount) :-
+ ( CurIndex > EndVal ->
+ MainRows = []
+ ;
+ construct_fail_row(LLDSTypes, MainRow, !FailCaseCount),
+ construct_several_soln_vector(CurIndex + 1, EndVal, !.LaterNextRow,
+ LLDSTypes, NumLLDSTypes, [], MoreMainRows, !RevLaterSolnArray,
+ !FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount),
+ MainRows = [MainRow | MoreMainRows]
+ ).
+construct_several_soln_vector(CurIndex, EndVal, !.LaterNextRow, LLDSTypes,
+ NumLLDSTypes, [Index - Soln | Rest], [MainRow | MainRows],
+ !RevLaterSolnArray,
+ !FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount) :-
+ ( CurIndex < Index ->
+ construct_fail_row(LLDSTypes, MainRow, !FailCaseCount),
+ Remainder = [Index - Soln | Rest]
+ ;
+ (
+ Soln = one_soln(Rvals),
+ !:OneSolnCaseCount = !.OneSolnCaseCount + 1,
+ % The first 0 means there is exactly one solution for this case;
+ % the second 0 is a dummy that won't be referenced.
+ ControlRvals = [const(int_const(0)), const(int_const(0))],
+ MainRow = ControlRvals ++ Rvals
+ ;
+ Soln = several_solns([]),
+ unexpected(this_file, "construct_several_soln_vector: several = 0")
+ ;
+ Soln = several_solns([FirstSoln | LaterSolns]),
+ !:SeveralSolnCaseCount = !.SeveralSolnCaseCount + 1,
+ list.length(LaterSolns, NumLaterSolns),
+ FirstRowOffset = !.LaterNextRow * NumLLDSTypes,
+ LastRowOffset = (!.LaterNextRow + NumLaterSolns - 1)
+ * NumLLDSTypes,
+ ControlRvals = [const(int_const(FirstRowOffset)),
+ const(int_const(LastRowOffset))],
+ MainRow = ControlRvals ++ FirstSoln,
+ list.reverse(LaterSolns, RevLaterSolns),
+ !:RevLaterSolnArray = RevLaterSolns ++ !.RevLaterSolnArray,
+ !:LaterNextRow = !.LaterNextRow + NumLaterSolns
+ ),
+ Remainder = Rest
+ ),
+ construct_several_soln_vector(CurIndex + 1, EndVal, !.LaterNextRow,
+ LLDSTypes, NumLLDSTypes, Remainder, MainRows, !RevLaterSolnArray,
+ !FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount).
+
+:- pred construct_fail_row(list(llds_type)::in, list(rval)::out,
+ int::in, int::out) is det.
+
+construct_fail_row(LLDSTypes, MainRow, !FailCaseCount) :-
+ % The -1 means no solutions for this case; the 0 is a dummy that
+ % won't be referenced.
+ ControlRvals = [const(int_const(-1)), const(int_const(0))],
+
+ % Since this argument (array element) is a place-holder and will never be
+ % referenced, just fill it in with a dummy entry.
+ VarRvals = list.map(default_value_for_type, LLDSTypes),
+
+ MainRow = ControlRvals ++ VarRvals,
+ !:FailCaseCount = !.FailCaseCount + 1.
%-----------------------------------------------------------------------------%
@@ -393,8 +860,8 @@
% input to the lookup switch. The bit is `1' iff we have a case for that
% tag value.
%
-:- pred generate_bitvec_test(rval::in, case_consts::in, int::in, int::in,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_bitvec_test(rval::in, assoc_list(int, T)::in,
+ int::in, int::in, code_tree::out, code_info::in, code_info::out) is det.
generate_bitvec_test(IndexRval, CaseVals, Start, _End, CheckCode, !CI) :-
get_word_bits(!.CI, WordBits, Log2WordBits),
@@ -452,7 +919,7 @@
% for each case. (We represent the bitvector here as a map from the word
% number in the vector to the bits for that word.
%
-:- pred generate_bit_vec(case_consts::in, int::in, int::in,
+:- pred generate_bit_vec(assoc_list(int, T)::in, int::in, int::in,
list(rval)::out, rval::out, code_info::in, code_info::out) is det.
generate_bit_vec(CaseVals, Start, WordBits, Args, BitVec, !CI) :-
@@ -463,7 +930,7 @@
add_scalar_static_cell_natural_types(Args, DataAddr, !CI),
BitVec = const(data_addr_const(DataAddr, no)).
-:- pred generate_bit_vec_2(case_consts::in, int::in, int::in,
+:- pred generate_bit_vec_2(assoc_list(int, T)::in, int::in, int::in,
map(int, int)::in, map(int, int)::out) is det.
generate_bit_vec_2([], _, _, Bits, Bits).
@@ -497,50 +964,6 @@
%-----------------------------------------------------------------------------%
- % Add an expression to the expression cache in the code_info structure
- % for each of the output variables of the lookup switch. This is done by
- % creating a `create' term for the array, and caching an expression
- % for the variable to get the IndexRval'th field of that term.
- %
-:- pred generate_terms(rval::in, list(prog_var)::in, list(llds_type)::in,
- case_consts::in, int::in, code_tree::out, lval::in,
- code_info::in, code_info::out) is det.
-
-generate_terms(IndexRval, OutVars, OutTypes, CaseVals, Start, Code, BaseReg,
- !CI) :-
- list.length(OutVars, NumOutVars),
- construct_vector(Start, CaseVals, VectorRvals),
- code_info.add_vector_static_cell(OutTypes, VectorRvals, VectorAddr, !CI),
-
- VectorAddrRval = const(data_addr_const(VectorAddr, no)),
- % IndexRval has already had Start subtracted from it.
- ( NumOutVars = 1 ->
- BaseRval = IndexRval
- ;
- BaseRval = binop(int_mul, IndexRval, const(int_const(NumOutVars)))
- ),
- Code = node([
- assign(BaseReg, mem_addr(heap_ref(VectorAddrRval, 0, BaseRval)))
- - "Compute base address for this case"
- ]),
- generate_offset_assigns(OutVars, 0, BaseReg, !CI).
-
-:- pred construct_vector(int::in, case_consts::in,
- list(maybe(list(rval)))::out) is det.
-
-construct_vector(_, [], []).
-construct_vector(CurIndex, [Index - Rvals | Rest], [MaybeRow | MaybeRows]) :-
- ( CurIndex < Index ->
- % If this argument (array element) is a place-holder and
- % will never be referenced, just fill it in with a dummy entry.
- MaybeRow = no,
- Remainder = [Index - Rvals | Rest]
- ;
- MaybeRow = yes(Rvals),
- Remainder = Rest
- ),
- construct_vector(CurIndex + 1, Remainder, MaybeRows).
-
:- pred generate_offset_assigns(list(prog_var)::in, int::in, lval::in,
code_info::in, code_info::out) is det.
@@ -551,6 +974,25 @@
expect(tree.is_empty(Code), this_file,
"generate_offset_assigns: nonempty code"),
generate_offset_assigns(Vars, Offset + 1, BaseReg, !CI).
+
+%-----------------------------------------------------------------------------%
+
+:- func default_value_for_type(llds_type) = rval.
+
+default_value_for_type(bool) = const(int_const(0)).
+default_value_for_type(int_least8) = const(int_const(0)).
+default_value_for_type(uint_least8) = const(int_const(0)).
+default_value_for_type(int_least16) = const(int_const(0)).
+default_value_for_type(uint_least16) = const(int_const(0)).
+default_value_for_type(int_least32) = const(int_const(0)).
+default_value_for_type(uint_least32) = const(int_const(0)).
+default_value_for_type(integer) = const(int_const(0)).
+default_value_for_type(unsigned) = const(int_const(0)).
+default_value_for_type(float) = const(float_const(0.0)).
+default_value_for_type(string) = const(string_const("")).
+default_value_for_type(data_ptr) = const(int_const(0)).
+default_value_for_type(code_ptr) = const(int_const(0)).
+default_value_for_type(word) = const(int_const(0)).
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.384
diff -u -b -r1.384 mercury_compile.m
--- compiler/mercury_compile.m 31 Mar 2006 03:32:11 -0000 1.384
+++ compiler/mercury_compile.m 7 Apr 2006 03:35:51 -0000
@@ -2693,7 +2693,8 @@
Optimize = no,
ProcCode = ProcCode0
),
- ProcCode = c_procedure(_, _, PredProcId, Instructions, _, _, _),
+ PredProcId = ProcCode ^ cproc_id,
+ Instructions = ProcCode ^ cproc_code,
write_proc_progress_message(
"% Generating call continuation information for ",
PredId, ProcId, !.HLDS, !IO),
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.116
diff -u -b -r1.116 middle_rec.m
--- compiler/middle_rec.m 6 Apr 2006 05:38:50 -0000 1.116
+++ compiler/middle_rec.m 22 Apr 2006 07:08:35 -0000
@@ -272,9 +272,9 @@
% In the code we generate, the base instruction sequence is executed
% in situations where this procedure has no stack frame. If this
- % sequence refers to stackvars, it will be to some other procedure's
+ % sequence refers to the stack frame, it will be to some other procedure's
% variables, which is obviously incorrect.
- opt_util.block_refers_stackvars(BaseList, no),
+ opt_util.block_refers_to_stack(BaseList) = no,
list.append(BaseList, RecList, AvoidList),
find_unused_register(AvoidList, AuxReg),
@@ -530,8 +530,8 @@
find_used_registers_instr(incr_sp(_, _), !Used).
find_used_registers_instr(decr_sp(_), !Used).
find_used_registers_instr(decr_sp_and_return(_), !Used).
-find_used_registers_instr(pragma_c(_, Components,
- _, _, _, _, _, _, _), !Used) :-
+find_used_registers_instr(pragma_c(_, Components, _, _, _, _, _, _, _),
+ !Used) :-
find_used_registers_components(Components, !Used).
find_used_registers_instr(init_sync_term(Lval, _), !Used) :-
find_used_registers_lval(Lval, !Used).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.176
diff -u -b -r1.176 ml_code_gen.m
--- compiler/ml_code_gen.m 29 Mar 2006 08:07:02 -0000 1.176
+++ compiler/ml_code_gen.m 22 Apr 2006 08:28:55 -0000
@@ -2792,6 +2792,8 @@
pragma_foreign_proc_extra_attributes) = target_code_attributes.
get_target_code_attributes(_, []) = [].
+get_target_code_attributes(Lang, [refers_to_llds_stack | Attrs]) =
+ get_target_code_attributes(Lang, Attrs).
get_target_code_attributes(Lang, [backend(_Backend) | Attrs]) =
get_target_code_attributes(Lang, Attrs).
get_target_code_attributes(Lang, [max_stack_size(N) | Attrs]) =
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.167
diff -u -b -r1.167 opt_debug.m
--- compiler/opt_debug.m 20 Apr 2006 05:36:58 -0000 1.167
+++ compiler/opt_debug.m 22 Apr 2006 08:28:55 -0000
@@ -246,16 +246,16 @@
dump_lval(succip) = "succip".
dump_lval(maxfr) = "maxfr".
dump_lval(curfr) = "curfr".
-dump_lval(succfr(R)) =
- "succfr(" ++ dump_rval(R) ++ ")".
-dump_lval(prevfr(R)) =
- "prevfr(" ++ dump_rval(R) ++ ")".
-dump_lval(redofr(R)) =
- "redofr(" ++ dump_rval(R) ++ ")".
-dump_lval(redoip(R)) =
- "redoip(" ++ dump_rval(R) ++ ")".
-dump_lval(succip(R)) =
- "succip(" ++ dump_rval(R) ++ ")".
+dump_lval(succfr_slot(R)) =
+ "succfr_slot(" ++ dump_rval(R) ++ ")".
+dump_lval(prevfr_slot(R)) =
+ "prevfr_slot(" ++ dump_rval(R) ++ ")".
+dump_lval(redofr_slot(R)) =
+ "redofr_slot(" ++ dump_rval(R) ++ ")".
+dump_lval(redoip_slot(R)) =
+ "redoip_slot(" ++ dump_rval(R) ++ ")".
+dump_lval(succip_slot(R)) =
+ "succip_slot(" ++ dump_rval(R) ++ ")".
dump_lval(hp) = "hp".
dump_lval(sp) = "sp".
dump_lval(field(MT, N, F)) = Str :-
@@ -641,9 +641,27 @@
Instr = assign(Lval, Rval),
Str = dump_lval(Lval) ++ " := " ++ dump_rval(Rval)
;
- Instr = call(Callee, ReturnLabel, _, _, _, _),
+ Instr = call(Callee, ReturnLabel, _LiveInfo, _Context, _GoalPath,
+ CallModel),
+ (
+ CallModel = call_model_det,
+ CallModelStr = "det"
+ ;
+ CallModel = call_model_semidet,
+ CallModelStr = "semidet"
+ ;
+ CallModel = call_model_nondet(no_tail_call),
+ CallModelStr = "nondet no_tail_call"
+ ;
+ CallModel = call_model_nondet(checked_tail_call),
+ CallModelStr = "nondet checked_tail_call"
+ ;
+ CallModel = call_model_nondet(unchecked_tail_call),
+ CallModelStr = "nondet unchecked_tail_call"
+ ),
Str = "call(" ++ dump_code_addr(ProcLabel, Callee) ++ ", "
- ++ dump_code_addr(ProcLabel, ReturnLabel) ++ ", ...)"
+ ++ dump_code_addr(ProcLabel, ReturnLabel) ++ ", ..., "
+ ++ CallModelStr ++ ")"
;
Instr = mkframe(FrameInfo, MaybeRedoip),
(
@@ -768,11 +786,49 @@
Str = "join(" ++ dump_lval(Lval) ++ ", "
++ dump_label(ProcLabel, Label) ++ ")"
;
- Instr = pragma_c(_, Comps, _, _, _, _, _, _, _),
- % XXX should probably give more info than this
- Str = "pragma_c(" ++ dump_components(ProcLabel, Comps) ++ ")"
+ Instr = pragma_c(Decls, Comps, MCM, MFNL, MFL, MFOL, MNF, SSR, MD),
+ Str = "pragma_c(\n"
+ ++ "declarations:\n" ++ dump_decls(Decls)
+ ++ "components:\n" ++ dump_components(ProcLabel, Comps)
+ ++ dump_may_call_mercury(MCM) ++ "\n"
+ ++ dump_maybe_label("fix nolayout:", ProcLabel, MFNL)
+ ++ dump_maybe_label("fix layout:", ProcLabel, MFL)
+ ++ dump_maybe_label("fix onlylayout:", ProcLabel, MFOL)
+ ++ dump_maybe_label("nofix:", ProcLabel, MNF)
+ ++ dump_bool("stack slot ref:", SSR)
+ ++ dump_bool("may duplicate:", MD)
+ ++ ")"
).
+:- func dump_may_call_mercury(may_call_mercury) = string.
+
+dump_may_call_mercury(may_call_mercury) = "may_call_mercury".
+dump_may_call_mercury(will_not_call_mercury) = "will_not_call_mercury".
+
+:- func dump_maybe_label(string, proc_label, maybe(label)) = string.
+
+dump_maybe_label(_Msg, _ProcLabel, no) = "".
+dump_maybe_label(Msg, ProcLabel, yes(Label)) =
+ Msg ++ " " ++ dump_label(ProcLabel, Label) ++ "\n".
+
+:- func dump_bool(string, bool) = string.
+
+dump_bool(Msg, no) = Msg ++ " no\n".
+dump_bool(Msg, yes) = Msg ++ " yes\n".
+
+:- func dump_decls(list(pragma_c_decl)) = string.
+
+dump_decls([]) = "".
+dump_decls([Decl | Decls]) =
+ dump_decl(Decl) ++ dump_decls(Decls).
+
+:- func dump_decl(pragma_c_decl) = string.
+
+dump_decl(pragma_c_arg_decl(_MerType, TypeStr, VarName)) =
+ "decl " ++ TypeStr ++ " " ++ VarName ++ "\n".
+dump_decl(pragma_c_struct_ptr_decl(StructTag, VarName)) =
+ "decl struct" ++ StructTag ++ " " ++ VarName ++ "\n".
+
:- func dump_components(proc_label, list(pragma_c_component)) = string.
dump_components(_, []) = "".
@@ -781,13 +837,42 @@
:- func dump_component(proc_label, pragma_c_component) = string.
-dump_component(_, pragma_c_inputs(_)) = "".
-dump_component(_, pragma_c_outputs(_)) = "".
-dump_component(_, pragma_c_user_code(_, Code)) = Code.
-dump_component(_, pragma_c_raw_code(Code, _, _)) = Code.
+dump_component(_, pragma_c_inputs(Inputs)) = dump_input_components(Inputs).
+dump_component(_, pragma_c_outputs(Outputs)) = dump_output_components(Outputs).
+dump_component(_, pragma_c_user_code(_, Code)) = Code ++ "\n".
+dump_component(_, pragma_c_raw_code(Code, _, _)) = Code ++ "\n".
dump_component(ProcLabel, pragma_c_fail_to(Label)) =
- "fail to " ++ dump_label(ProcLabel, Label).
+ "fail to " ++ dump_label(ProcLabel, Label) ++ "\n".
dump_component(_, pragma_c_noop) = "".
+
+:- func dump_input_components(list(pragma_c_input)) = string.
+
+dump_input_components([]) = "".
+dump_input_components([Input | Inputs]) =
+ dump_input_component(Input) ++ "\n" ++
+ dump_input_components(Inputs).
+
+:- func dump_output_components(list(pragma_c_output)) = string.
+
+dump_output_components([]) = "".
+dump_output_components([Input | Inputs]) =
+ dump_output_component(Input) ++ "\n" ++
+ dump_output_components(Inputs).
+
+:- func dump_input_component(pragma_c_input) = string.
+
+dump_input_component(pragma_c_input(Var, _, Dummy, _, Rval, _, _)) =
+ Var ++ dump_maybe_dummy(Dummy) ++ " := " ++ dump_rval(Rval).
+
+:- func dump_output_component(pragma_c_output) = string.
+
+dump_output_component(pragma_c_output(Lval, _, Dummy, _, Var, _, _)) =
+ dump_lval(Lval) ++ " := " ++ Var ++ dump_maybe_dummy(Dummy).
+
+:- func dump_maybe_dummy(bool) = string.
+
+dump_maybe_dummy(no) = "".
+dump_maybe_dummy(yes) = " (dummy)".
dump_fullinstr(ProcLabel, PrintComments, Uinstr - Comment) = Str :-
(
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.147
diff -u -b -r1.147 opt_util.m
--- compiler/opt_util.m 20 Apr 2006 05:36:59 -0000 1.147
+++ compiler/opt_util.m 22 Apr 2006 05:14:46 -0000
@@ -218,17 +218,14 @@
:- pred count_temps_instr(instr::in, int::in, int::out,
int::in, int::out) is det.
- % See whether an lval references any stackvars.
+ % See whether a (list of) instructions or instruction components
+ % references the current stack frame (on either stack).
%
-:- pred lval_refers_stackvars(lval::in, bool::out) is det.
-
- % See whether an rval references any stackvars.
- %
-:- pred rval_refers_stackvars(rval::in, bool::out) is det.
-
- % See whether a list of maybe rvals references any stackvars.
- %
-:- pred rvals_refer_stackvars(list(maybe(rval))::in, bool::out) is det.
+:- func lval_refers_stackvars(lval) = bool.
+:- func rval_refers_stackvars(rval) = bool.
+:- func rvals_refer_stackvars(list(maybe(rval))) = bool.
+:- func instr_refers_to_stack(instruction) = bool.
+:- func block_refers_to_stack(list(instruction)) = bool.
% See whether instructions until the next decr_sp (if any) refer to
% any stackvars or branch away. If not, return the instructions up to
@@ -240,10 +237,6 @@
:- pred no_stackvars_til_decr_sp(list(instruction)::in, int::in,
list(instruction)::out, list(instruction)::out) is semidet.
- % See whether a list of instructions references any stackvars.
- %
-:- pred block_refers_stackvars(list(instruction)::in, bool::out) is det.
-
% Format a label or proc_label for verbose messages during compilation.
%
:- func format_label(label) = string.
@@ -297,6 +290,18 @@
:- pred replace_labels_instruction_list(list(instruction)::in,
map(label, label)::in, bool::in, bool::in, list(instruction)::out) is det.
+:- pred replace_labels_comps(list(pragma_c_component)::in,
+ map(label, label)::in, list(pragma_c_component)::out) is det.
+
+:- pred replace_labels_code_addr(code_addr::in, map(label, label)::in,
+ code_addr::out) is det.
+
+:- pred replace_labels_label_list(list(label)::in,
+ map(label, label)::in, list(label)::out) is det.
+
+:- pred replace_labels_label(label::in, map(label, label)::in,
+ label::out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -395,7 +400,8 @@
Redoip, Skip, Rest) :-
Instr = Uinstr - _Comment,
(
- Uinstr = assign(redoip(lval(Fr)), const(code_addr_const(Redoip0))),
+ Uinstr = assign(redoip_slot(lval(Fr)),
+ const(code_addr_const(Redoip0))),
list.member(Fr, AllowedBases)
->
Redoip = Redoip0,
@@ -619,8 +625,8 @@
Uinstr = livevals(_)
;
Uinstr = assign(Lval, Rval),
- lval_refers_stackvars(Lval, no),
- rval_refers_stackvars(Rval, no)
+ lval_refers_stackvars(Lval) = no,
+ rval_refers_stackvars(Rval) = no
)
->
!:RevStraightLine = [Instr0 | !.RevStraightLine],
@@ -629,73 +635,80 @@
Instrs = [Instr0 | Instrs0]
).
-lval_refers_stackvars(reg(_, _), no).
-lval_refers_stackvars(stackvar(_), yes).
-lval_refers_stackvars(framevar(_), yes).
-lval_refers_stackvars(succip, no).
-lval_refers_stackvars(maxfr, no).
-lval_refers_stackvars(curfr, no).
-lval_refers_stackvars(succfr(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-lval_refers_stackvars(prevfr(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-lval_refers_stackvars(redofr(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-lval_refers_stackvars(redoip(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-lval_refers_stackvars(succip(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-lval_refers_stackvars(hp, no).
-lval_refers_stackvars(sp, no).
-lval_refers_stackvars(field(_, Rval, FieldNum), Refers) :-
- rval_refers_stackvars(Rval, Refers1),
- rval_refers_stackvars(FieldNum, Refers2),
- bool.or(Refers1, Refers2, Refers).
-lval_refers_stackvars(lvar(_), _) :-
+lval_refers_stackvars(reg(_, _)) = no.
+lval_refers_stackvars(stackvar(_)) = yes.
+lval_refers_stackvars(framevar(_)) = yes.
+lval_refers_stackvars(succip) = no.
+lval_refers_stackvars(maxfr) = no.
+lval_refers_stackvars(curfr) = no.
+lval_refers_stackvars(succfr_slot(_)) = yes.
+lval_refers_stackvars(prevfr_slot(_)) = yes.
+lval_refers_stackvars(redofr_slot(_)) = yes.
+lval_refers_stackvars(redoip_slot(_)) = yes.
+lval_refers_stackvars(succip_slot(_)) = yes.
+lval_refers_stackvars(hp) = no.
+lval_refers_stackvars(sp) = no.
+lval_refers_stackvars(field(_, Rval, FieldNum)) =
+ bool.or(
+ rval_refers_stackvars(Rval),
+ rval_refers_stackvars(FieldNum)).
+lval_refers_stackvars(lvar(_)) = _ :-
unexpected(this_file, "found lvar in lval_refers_stackvars").
-lval_refers_stackvars(temp(_, _), no).
-lval_refers_stackvars(mem_ref(Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-
-:- pred mem_ref_refers_stackvars(mem_ref::in, bool::out) is det.
-
-mem_ref_refers_stackvars(stackvar_ref(_), yes).
-mem_ref_refers_stackvars(framevar_ref(_), yes).
-mem_ref_refers_stackvars(heap_ref(Rval, _, _), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-
-rval_refers_stackvars(lval(Lval), Refers) :-
- lval_refers_stackvars(Lval, Refers).
-rval_refers_stackvars(var(_), _) :-
+lval_refers_stackvars(temp(_, _)) = no.
+lval_refers_stackvars(mem_ref(Rval)) =
+ rval_refers_stackvars(Rval).
+
+:- func mem_ref_refers_stackvars(mem_ref) = bool.
+
+mem_ref_refers_stackvars(stackvar_ref(_)) = yes.
+mem_ref_refers_stackvars(framevar_ref(_)) = yes.
+mem_ref_refers_stackvars(heap_ref(Rval1, _, Rval2)) =
+ bool.or(rval_refers_stackvars(Rval1), rval_refers_stackvars(Rval2)).
+
+rval_refers_stackvars(lval(Lval)) =
+ lval_refers_stackvars(Lval).
+rval_refers_stackvars(var(_)) = _ :-
unexpected(this_file, "found var in rval_refers_stackvars").
-rval_refers_stackvars(mkword(_, Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-rval_refers_stackvars(const(_), no).
-rval_refers_stackvars(unop(_, Rval), Refers) :-
- rval_refers_stackvars(Rval, Refers).
-rval_refers_stackvars(binop(_, Rval1, Rval2), Refers) :-
- rval_refers_stackvars(Rval1, Refers1),
- rval_refers_stackvars(Rval2, Refers2),
- bool.or(Refers1, Refers2, Refers).
-rval_refers_stackvars(mem_addr(MemRef), Refers) :-
- mem_ref_refers_stackvars(MemRef, Refers).
+rval_refers_stackvars(mkword(_, Rval)) =
+ rval_refers_stackvars(Rval).
+rval_refers_stackvars(const(_)) = no.
+rval_refers_stackvars(unop(_, Rval)) =
+ rval_refers_stackvars(Rval).
+rval_refers_stackvars(binop(_, Rval1, Rval2)) =
+ bool.or(rval_refers_stackvars(Rval1), rval_refers_stackvars(Rval2)).
+rval_refers_stackvars(mem_addr(MemRef)) =
+ mem_ref_refers_stackvars(MemRef).
% XXX probably unused
-rvals_refer_stackvars([], no).
-rvals_refer_stackvars([MaybeRval | Tail], Refers) :-
+rvals_refer_stackvars([]) = no.
+rvals_refer_stackvars([MaybeRval | Tail]) =
(
(
MaybeRval = no
;
MaybeRval = yes(Rval),
- rval_refers_stackvars(Rval, no)
+ rval_refers_stackvars(Rval) = no
)
->
- rvals_refer_stackvars(Tail, Refers)
+ rvals_refer_stackvars(Tail)
;
- Refers = yes
+ yes
).
+:- func code_addr_refers_to_stack(code_addr) = bool.
+
+code_addr_refers_to_stack(label(_)) = no.
+code_addr_refers_to_stack(imported(_)) = no.
+code_addr_refers_to_stack(succip) = no.
+code_addr_refers_to_stack(do_succeed(_)) = yes.
+code_addr_refers_to_stack(do_redo) = yes.
+code_addr_refers_to_stack(do_fail) = yes.
+code_addr_refers_to_stack(do_trace_redo_fail_shallow) = yes.
+code_addr_refers_to_stack(do_trace_redo_fail_deep) = yes.
+code_addr_refers_to_stack(do_call_closure(_)) = no.
+code_addr_refers_to_stack(do_call_class_method(_)) = no.
+code_addr_refers_to_stack(do_not_reached) = no.
+
no_stackvars_til_decr_sp([Instr0 | Instrs0], FrameSize, Between, Remain) :-
Instr0 = Uinstr0 - _,
(
@@ -710,7 +723,7 @@
Uinstr0 = assign(Lval, Rval),
(
Lval = stackvar(_),
- rval_refers_stackvars(Rval, no)
+ rval_refers_stackvars(Rval) = no
->
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between, Remain)
;
@@ -722,17 +735,16 @@
Between = [],
Remain = Instrs2
;
- lval_refers_stackvars(Lval, no),
- rval_refers_stackvars(Rval, no),
+ lval_refers_stackvars(Lval) = no,
+ rval_refers_stackvars(Rval) = no,
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
)
;
Uinstr0 = incr_hp(Lval, _, _, Rval, _),
- lval_refers_stackvars(Lval, no),
- rval_refers_stackvars(Rval, no),
- no_stackvars_til_decr_sp(Instrs0, FrameSize,
- Between0, Remain),
+ lval_refers_stackvars(Lval) = no,
+ rval_refers_stackvars(Rval) = no,
+ no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
;
Uinstr0 = decr_sp(FrameSize),
@@ -740,121 +752,126 @@
Remain = Instrs0
).
-block_refers_stackvars([], no).
-block_refers_stackvars([Instr | Instrs], Refers) :-
- instr_refers_stackvars(Instr, InstrRefers),
+block_refers_to_stack([]) = no.
+block_refers_to_stack([Instr | Instrs]) = Refers :-
+ instr_refers_to_stack(Instr) = InstrRefers,
(
InstrRefers = yes,
Refers = yes
;
InstrRefers = no,
- block_refers_stackvars(Instrs, Refers)
+ Instr = Uinstr - _,
+ can_instr_fall_through(Uinstr, CanFallThrough),
+ (
+ CanFallThrough = yes,
+ Refers = block_refers_to_stack(Instrs)
+ ;
+ CanFallThrough = no,
+ Refers = no
+ )
).
-:- pred instr_refers_stackvars(instruction::in, bool::out) is det.
-
-instr_refers_stackvars(Uinstr0 - _, Refers) :-
+instr_refers_to_stack(Uinstr - _) = Refers :-
(
- Uinstr0 = comment(_),
+ Uinstr = comment(_),
Refers = no
;
- Uinstr0 = livevals(_),
+ Uinstr = livevals(_),
Refers = no
;
- Uinstr0 = block(_, _, BlockInstrs),
- block_refers_stackvars(BlockInstrs, Refers)
+ Uinstr = block(_, _, BlockInstrs),
+ Refers = block_refers_to_stack(BlockInstrs)
;
- Uinstr0 = assign(Lval, Rval),
- lval_refers_stackvars(Lval, Refers1),
- rval_refers_stackvars(Rval, Refers2),
- bool.or(Refers1, Refers2, Refers)
+ Uinstr = assign(Lval, Rval),
+ Refers = bool.or(
+ lval_refers_stackvars(Lval),
+ rval_refers_stackvars(Rval))
;
- Uinstr0 = call(_, _, _, _, _, _),
- Refers = no
+ Uinstr = call(_, _, _, _, _, _),
+ Refers = yes
;
- Uinstr0 = mkframe(_, _),
- Refers = no
+ Uinstr = mkframe(_, _),
+ Refers = yes
;
- Uinstr0 = label(_),
+ Uinstr = label(_),
Refers = no
;
- Uinstr0 = goto(_),
- Refers = no
+ Uinstr = goto(CodeAddr),
+ Refers = code_addr_refers_to_stack(CodeAddr)
;
- Uinstr0 = computed_goto(Rval, _),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = computed_goto(Rval, _Labels),
+ Refers = rval_refers_stackvars(Rval)
;
- Uinstr0 = c_code(_, _),
+ Uinstr = c_code(_, _),
Refers = no
;
- Uinstr0 = if_val(Rval, _),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = if_val(Rval, CodeAddr),
+ Refers = bool.or(
+ rval_refers_stackvars(Rval),
+ code_addr_refers_to_stack(CodeAddr))
;
- Uinstr0 = save_maxfr(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = save_maxfr(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = restore_maxfr(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = restore_maxfr(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = incr_hp(Lval, _, _, Rval, _),
- lval_refers_stackvars(Lval, Refers1),
- rval_refers_stackvars(Rval, Refers2),
- bool.or(Refers1, Refers2, Refers)
+ Uinstr = incr_hp(Lval, _, _, Rval, _),
+ Refers = bool.or(
+ lval_refers_stackvars(Lval),
+ rval_refers_stackvars(Rval))
;
- Uinstr0 = mark_hp(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = mark_hp(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = restore_hp(Rval),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = restore_hp(Rval),
+ Refers = rval_refers_stackvars(Rval)
;
- Uinstr0 = free_heap(Rval),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = free_heap(Rval),
+ Refers = rval_refers_stackvars(Rval)
;
- Uinstr0 = store_ticket(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = store_ticket(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = reset_ticket(Rval, _Reason),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = reset_ticket(Rval, _Reason),
+ Refers = rval_refers_stackvars(Rval)
;
- Uinstr0 = discard_ticket,
+ Uinstr = discard_ticket,
Refers = no
;
- Uinstr0 = prune_ticket,
+ Uinstr = prune_ticket,
Refers = no
;
- Uinstr0 = mark_ticket_stack(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = mark_ticket_stack(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = prune_tickets_to(Rval),
- rval_refers_stackvars(Rval, Refers)
+ Uinstr = prune_tickets_to(Rval),
+ Refers = rval_refers_stackvars(Rval)
;
- % handled specially
- Uinstr0 = incr_sp(_, _),
- Refers = no
+ Uinstr = incr_sp(_, _),
+ Refers = yes
;
- % handled specially
- Uinstr0 = decr_sp(_),
- Refers = no
+ Uinstr = decr_sp(_),
+ Refers = yes
;
- % handled specially
- Uinstr0 = decr_sp_and_return(_),
- Refers = no
+ Uinstr = decr_sp_and_return(_),
+ Refers = yes
;
- Uinstr0 = pragma_c(_, Components, _, _, _, _, _, _, _),
- bool.or_list(list.map(pragma_c_component_refers_stackvars, Components),
- Refers)
+ Uinstr = pragma_c(_, Components, _, _, _, _, _, _, _),
+ Refers = bool.or_list(list.map(pragma_c_component_refers_stackvars,
+ Components))
;
- Uinstr0 = init_sync_term(Lval, _),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = init_sync_term(Lval, _),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = fork(_, _, _),
- Refers = no
+ Uinstr = fork(_, _, _),
+ Refers = yes
;
- Uinstr0 = join_and_terminate(Lval),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = join_and_terminate(Lval),
+ Refers = lval_refers_stackvars(Lval)
;
- Uinstr0 = join_and_continue(Lval, _),
- lval_refers_stackvars(Lval, Refers)
+ Uinstr = join_and_continue(Lval, _),
+ Refers = lval_refers_stackvars(Lval)
).
:- func pragma_c_component_refers_stackvars(pragma_c_component) = bool.
@@ -887,7 +904,7 @@
Refers = no
;
IsDummy = no,
- rval_refers_stackvars(Rval, Refers)
+ Refers = rval_refers_stackvars(Rval)
).
:- func pragma_c_output_refers_stackvars(pragma_c_output) = bool.
@@ -900,7 +917,7 @@
Refers = no
;
IsDummy = no,
- lval_refers_stackvars(Lval, Refers)
+ Refers = lval_refers_stackvars(Lval)
).
filter_out_labels([], []).
@@ -1603,11 +1620,11 @@
touches_nondet_ctrl_lval(succip, no).
touches_nondet_ctrl_lval(maxfr, yes).
touches_nondet_ctrl_lval(curfr, yes).
-touches_nondet_ctrl_lval(succfr(_), yes).
-touches_nondet_ctrl_lval(prevfr(_), yes).
-touches_nondet_ctrl_lval(redofr(_), yes).
-touches_nondet_ctrl_lval(redoip(_), yes).
-touches_nondet_ctrl_lval(succip(_), yes).
+touches_nondet_ctrl_lval(succfr_slot(_), yes).
+touches_nondet_ctrl_lval(prevfr_slot(_), yes).
+touches_nondet_ctrl_lval(redofr_slot(_), yes).
+touches_nondet_ctrl_lval(redoip_slot(_), yes).
+touches_nondet_ctrl_lval(succip_slot(_), yes).
touches_nondet_ctrl_lval(hp, no).
touches_nondet_ctrl_lval(sp, no).
touches_nondet_ctrl_lval(field(_, Rval1, Rval2), Touch) :-
@@ -1676,11 +1693,11 @@
lval_access_rvals(succip, []).
lval_access_rvals(maxfr, []).
lval_access_rvals(curfr, []).
-lval_access_rvals(redoip(Rval), [Rval]).
-lval_access_rvals(succip(Rval), [Rval]).
-lval_access_rvals(redofr(Rval), [Rval]).
-lval_access_rvals(prevfr(Rval), [Rval]).
-lval_access_rvals(succfr(Rval), [Rval]).
+lval_access_rvals(redoip_slot(Rval), [Rval]).
+lval_access_rvals(succip_slot(Rval), [Rval]).
+lval_access_rvals(redofr_slot(Rval), [Rval]).
+lval_access_rvals(prevfr_slot(Rval), [Rval]).
+lval_access_rvals(succfr_slot(Rval), [Rval]).
lval_access_rvals(hp, []).
lval_access_rvals(sp, []).
lval_access_rvals(field(_, Rval1, Rval2), [Rval1, Rval2]).
@@ -2000,9 +2017,6 @@
replace_labels_comps(Comps0, ReplMap, Comps)
).
-:- pred replace_labels_comps(list(pragma_c_component)::in,
- map(label, label)::in, list(pragma_c_component)::out) is det.
-
replace_labels_comps([], _, []).
replace_labels_comps([Comp0 | Comps0], ReplMap, [Comp | Comps]) :-
replace_labels_comp(Comp0, ReplMap, Comp),
@@ -2030,15 +2044,15 @@
replace_labels_lval(succip, _, succip).
replace_labels_lval(maxfr, _, maxfr).
replace_labels_lval(curfr, _, curfr).
-replace_labels_lval(succip(Rval0), ReplMap, succip(Rval)) :-
+replace_labels_lval(succip_slot(Rval0), ReplMap, succip_slot(Rval)) :-
replace_labels_rval(Rval0, ReplMap, Rval).
-replace_labels_lval(redoip(Rval0), ReplMap, redoip(Rval)) :-
+replace_labels_lval(redoip_slot(Rval0), ReplMap, redoip_slot(Rval)) :-
replace_labels_rval(Rval0, ReplMap, Rval).
-replace_labels_lval(redofr(Rval0), ReplMap, redofr(Rval)) :-
+replace_labels_lval(redofr_slot(Rval0), ReplMap, redofr_slot(Rval)) :-
replace_labels_rval(Rval0, ReplMap, Rval).
-replace_labels_lval(succfr(Rval0), ReplMap, succfr(Rval)) :-
+replace_labels_lval(succfr_slot(Rval0), ReplMap, succfr_slot(Rval)) :-
replace_labels_rval(Rval0, ReplMap, Rval).
-replace_labels_lval(prevfr(Rval0), ReplMap, prevfr(Rval)) :-
+replace_labels_lval(prevfr_slot(Rval0), ReplMap, prevfr_slot(Rval)) :-
replace_labels_rval(Rval0, ReplMap, Rval).
replace_labels_lval(hp, _, hp).
replace_labels_lval(sp, _, sp).
@@ -2096,9 +2110,6 @@
replace_labels_rval_const(data_addr_const(DataAddr, MaybeOffset), _,
data_addr_const(DataAddr, MaybeOffset)).
-:- pred replace_labels_code_addr(code_addr::in, map(label, label)::in,
- code_addr::out) is det.
-
replace_labels_code_addr(label(Label0), ReplMap, label(Label)) :-
replace_labels_label(Label0, ReplMap, Label).
replace_labels_code_addr(imported(Proc), _, imported(Proc)).
@@ -2116,16 +2127,10 @@
do_call_class_method(MaybeSpec)).
replace_labels_code_addr(do_not_reached, _, do_not_reached).
-:- pred replace_labels_label_list(list(label)::in,
- map(label, label)::in, list(label)::out) is det.
-
replace_labels_label_list([], _ReplMap, []).
replace_labels_label_list([Label0 | Labels0], ReplMap, [Label | Labels]) :-
replace_labels_label(Label0, ReplMap, Label),
replace_labels_label_list(Labels0, ReplMap, Labels).
-
-:- pred replace_labels_label(label::in, map(label, label)::in,
- label::out) is det.
replace_labels_label(Label0, ReplMap, Label) :-
( map.search(ReplMap, Label0, NewLabel) ->
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.55
diff -u -b -r1.55 optimize.m
--- compiler/optimize.m 10 Apr 2006 04:28:21 -0000 1.55
+++ compiler/optimize.m 22 Apr 2006 02:48:27 -0000
@@ -37,6 +37,7 @@
:- import_module backend_libs.name_mangle.
:- import_module backend_libs.proc_label.
+:- import_module hlds.code_model.
:- import_module hlds.hlds_pred.
:- import_module hlds.passes_aux.
:- import_module libs.compiler_util.
@@ -76,7 +77,7 @@
optimize_proc(GlobalData, CProc0, CProc, !IO) :-
some [!OptDebugInfo, !C, !Instrs] (
- CProc0 = c_procedure(Name, Arity, PredProcId, !:Instrs,
+ CProc0 = c_procedure(Name, Arity, PredProcId, CodeModel, !:Instrs,
ProcLabel, !:C, MayAlterRtti),
init_opt_debug_info(Name, Arity, PredProcId, ProcLabel,
!.Instrs, !.C, !:OptDebugInfo, !IO),
@@ -93,16 +94,16 @@
;
set.init(LayoutLabelSet)
),
- optimize_initial(LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
- !OptDebugInfo, !Instrs, !IO),
+ optimize_initial(LayoutLabelSet, ProcLabel, CodeModel, MayAlterRtti,
+ !C, !OptDebugInfo, !Instrs, !IO),
optimize_repeat(Repeat, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
!OptDebugInfo, !Instrs, !IO),
- optimize_middle(yes, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
- !OptDebugInfo, !Instrs, !IO),
+ optimize_middle(yes, LayoutLabelSet, ProcLabel, CodeModel,
+ MayAlterRtti, !C, !OptDebugInfo, !Instrs, !IO),
optimize_last(LayoutLabelSet, ProcLabel, !C, !.OptDebugInfo, !Instrs,
!IO),
- CProc = c_procedure(Name, Arity, PredProcId, !.Instrs, ProcLabel,
- !.C, MayAlterRtti)
+ CProc = c_procedure(Name, Arity, PredProcId, CodeModel, !.Instrs,
+ ProcLabel, !.C, MayAlterRtti)
).
:- func make_internal_label(proc_label, int) = label.
@@ -115,8 +116,10 @@
---> opt_debug_info(
string, % Base file name for the dump files.
int, % The number of the last dump file written.
+ string, % The name of this file.
int, % The number of the last dump file written
% that has the instruction sequence in it.
+ string, % The name of this file.
list(instruction)
% The instruction sequence at the time the
% last dump file was written.
@@ -131,18 +134,25 @@
OptDebugInfo, !IO) :-
globals.io_lookup_bool_option(debug_opt, DebugOpt, !IO),
globals.io_lookup_int_option(debug_opt_pred_id, DebugOptPredId, !IO),
+ globals.io_lookup_string_option(debug_opt_pred_name, DebugOptPredName,
+ !IO),
PredProcId = proc(PredId, ProcId),
pred_id_to_int(PredId, PredIdInt),
proc_id_to_int(ProcId, ProcIdInt),
(
DebugOpt = yes,
- ( DebugOptPredId >= 0 => DebugOptPredId = PredIdInt )
+ ( DebugOptPredId >= 0 ->
+ DebugOptPredId = PredIdInt
+ ; DebugOptPredName \= "" ->
+ DebugOptPredName = Name
+ ;
+ true
+ )
->
BaseName = opt_subdir_name ++ "/"
++ mangle_name_as_filename(Name) ++ "_" ++ int_to_string(Arity)
++ ".pred" ++ int_to_string(PredIdInt)
++ ".proc" ++ int_to_string(ProcIdInt),
- OptDebugInfo = opt_debug_info(BaseName, 0, 0, Instrs0),
io.call_system("mkdir -p " ++ opt_subdir_name, MkdirRes, !IO),
( MkdirRes = ok(0) ->
@@ -150,7 +160,7 @@
;
unexpected(this_file, "cannot make " ++ opt_subdir_name)
),
- FileName = BaseName ++ ".opt0",
+ FileName = BaseName ++ ".opt" ++ num_to_str(0),
io.open_output(FileName, Res, !IO),
( Res = ok(FileStream) ->
io.set_output_stream(FileStream, OutputStream, !IO),
@@ -161,7 +171,9 @@
io.close_output(FileStream, !IO)
;
unexpected(this_file, "cannot open " ++ FileName)
- )
+ ),
+ OptDebugInfo = opt_debug_info(BaseName, 0, FileName, 0, FileName,
+ Instrs0)
;
OptDebugInfo = no_opt_debug_info
).
@@ -170,25 +182,33 @@
opt_subdir_name = "OptSubdir".
-:- pred maybe_opt_debug(list(instruction)::in, counter::in, string::in,
- proc_label::in, opt_debug_info::in, opt_debug_info::out, io::di, io::uo)
- is det.
+:- func num_to_str(int) = string.
-maybe_opt_debug(Instrs, Counter, Msg, ProcLabel, !OptDebugInfo, !IO) :-
+num_to_str(N) =
+ ( N < 10 ->
+ "0" ++ string.int_to_string(N)
+ ;
+ string.int_to_string(N)
+ ).
+
+:- pred maybe_opt_debug(list(instruction)::in, counter::in,
+ string::in, string::in, proc_label::in,
+ opt_debug_info::in, opt_debug_info::out, io::di, io::uo) is det.
+
+maybe_opt_debug(Instrs, Counter, Suffix, Msg, ProcLabel, !OptDebugInfo, !IO) :-
(
- !.OptDebugInfo = opt_debug_info(BaseName, OptNum0, PrevNum,
- PrevInstrs),
+ !.OptDebugInfo = opt_debug_info(BaseName, OptNum0, _OptFileName0,
+ PrevNum, PrevFileName, PrevInstrs),
( Instrs = PrevInstrs ->
Same = yes
;
Same = no
),
OptNum = OptNum0 + 1,
- string.int_to_string(PrevNum, PrevNumStr),
- string.int_to_string(OptNum, OptNumStr),
- PrevFileName = BaseName ++ ".opt" ++ PrevNumStr,
- OptFileName = BaseName ++ ".opt" ++ OptNumStr,
- DiffFileName = BaseName ++ ".diff" ++ OptNumStr,
+ OptFileName = BaseName ++ ".opt" ++ num_to_str(OptNum)
+ ++ "." ++ Suffix,
+ DiffFileName = BaseName ++ ".diff" ++ num_to_str(OptNum)
+ ++ "." ++ Suffix,
io.open_output(OptFileName, Res, !IO),
( Res = ok(FileStream) ->
io.set_output_stream(FileStream, OutputStream, !IO),
@@ -209,7 +229,8 @@
),
(
Same = yes,
- !:OptDebugInfo = opt_debug_info(BaseName, OptNum, PrevNum, Instrs)
+ !:OptDebugInfo = opt_debug_info(BaseName, OptNum, OptFileName,
+ PrevNum, PrevFileName, Instrs)
;
Same = no,
% Although the -u is not fully portable, it is available
@@ -218,7 +239,8 @@
DiffCommand = "diff -u '" ++ PrevFileName ++ "' '" ++ OptFileName
++ "' > '" ++ DiffFileName ++ "'",
io.call_system(DiffCommand, _, !IO),
- !:OptDebugInfo = opt_debug_info(BaseName, OptNum, OptNum, Instrs)
+ !:OptDebugInfo = opt_debug_info(BaseName, OptNum, OptFileName,
+ OptNum, OptFileName, Instrs)
)
;
!.OptDebugInfo = no_opt_debug_info
@@ -226,18 +248,22 @@
%-----------------------------------------------------------------------------%
-:- pred optimize_initial(set(label)::in, proc_label::in, may_alter_rtti::in,
- counter::in, counter::out, opt_debug_info::in, opt_debug_info::out,
+:- pred optimize_initial(set(label)::in, proc_label::in, code_model::in,
+ may_alter_rtti::in, counter::in, counter::out,
+ opt_debug_info::in, opt_debug_info::out,
list(instruction)::in, list(instruction)::out, io::di, io::uo) is det.
-optimize_initial(LayoutLabelSet, ProcLabel, MayAlterRtti, !C, !OptDebugInfo,
- !Instrs, !IO) :-
+optimize_initial(LayoutLabelSet, ProcLabel, CodeModel, MayAlterRtti,
+ !C, !OptDebugInfo, !Instrs, !IO) :-
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
LabelStr = opt_util.format_proc_label(ProcLabel),
globals.io_lookup_bool_option(optimize_frames, FrameOpt, !IO),
(
FrameOpt = yes,
+ MayAlterRtti = may_alter_rtti,
+ CodeModel = model_non
+ ->
(
VeryVerbose = yes,
io.write_string("% Optimizing nondet frames for ", !IO),
@@ -246,12 +272,12 @@
;
VeryVerbose = no
),
- frameopt_nondet(ProcLabel, LayoutLabelSet, MayAlterRtti, !C, !Instrs,
- _Mod),
- maybe_opt_debug(!.Instrs, !.C, "after nondet frame opt",
+ frameopt_keep_nondet_frame(ProcLabel, LayoutLabelSet,
+ !C, !Instrs, _Mod),
+ maybe_opt_debug(!.Instrs, !.C, "ndframeopt", "after nondet frame opt",
ProcLabel, !OptDebugInfo, !IO)
;
- FrameOpt = no
+ true
).
%-----------------------------------------------------------------------------%
@@ -316,7 +342,7 @@
jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel, FullJumpopt,
Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
Mod1),
- maybe_opt_debug(!.Instrs, !.C, "after jump opt",
+ maybe_opt_debug(!.Instrs, !.C, "jump", "after jump opt",
ProcLabel, !OptDebugInfo, !IO)
;
Jumpopt = no,
@@ -335,7 +361,7 @@
),
globals.io_get_gc_method(GC_Method, !IO),
peephole.optimize(GC_Method, !Instrs, Mod2),
- maybe_opt_debug(!.Instrs, !.C, "after peephole",
+ maybe_opt_debug(!.Instrs, !.C, "peep", "after peephole",
ProcLabel, !OptDebugInfo, !IO)
;
Peephole = no,
@@ -353,7 +379,7 @@
VeryVerbose = no
),
labelopt_main(Final, LayoutLabelSet, !Instrs, Mod3),
- maybe_opt_debug(!.Instrs, !.C, "after label opt",
+ maybe_opt_debug(!.Instrs, !.C, "label", "after label opt",
ProcLabel, !OptDebugInfo, !IO)
;
LabelElim = no,
@@ -371,7 +397,7 @@
VeryVerbose = no
),
dupelim_main(ProcLabel, !C, !Instrs),
- maybe_opt_debug(!.Instrs, !.C, "after duplicates",
+ maybe_opt_debug(!.Instrs, !.C, "dup", "after duplicates",
ProcLabel, !OptDebugInfo, !IO)
;
DupElim = no
@@ -385,11 +411,11 @@
maybe_report_stats(Statistics, !IO).
:- pred optimize_middle(bool::in, set(label)::in, proc_label::in,
- may_alter_rtti::in, counter::in, counter::out,
+ code_model::in, may_alter_rtti::in, counter::in, counter::out,
opt_debug_info::in, opt_debug_info::out,
list(instruction)::in, list(instruction)::out, io::di, io::uo) is det.
-optimize_middle(Final, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
+optimize_middle(Final, LayoutLabelSet, ProcLabel, CodeModel, MayAlterRtti, !C,
!OptDebugInfo, !Instrs, !IO) :-
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
LabelStr = opt_util.format_proc_label(ProcLabel),
@@ -406,8 +432,16 @@
VeryVerbose = no
),
globals.io_get_globals(Globals, !IO),
- frameopt_main(ProcLabel, !C, !Instrs, Globals, Mod1),
- maybe_opt_debug(!.Instrs, !.C, "after frame opt",
+ (
+ ( CodeModel = model_det
+ ; CodeModel = model_semi
+ ),
+ frameopt_main_det_stack(ProcLabel, !C, !Instrs, Globals, Mod1)
+ ;
+ CodeModel = model_non,
+ frameopt_main_nondet_stack(ProcLabel, !C, !Instrs, Globals, Mod1)
+ ),
+ maybe_opt_debug(!.Instrs, !.C, "frame", "after frame opt",
ProcLabel, !OptDebugInfo, !IO),
globals.io_lookup_bool_option(optimize_fulljumps, FullJumpopt, !IO),
globals.io_lookup_bool_option(pessimize_tailcalls,
@@ -430,7 +464,7 @@
jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel, FullJumpopt,
Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
_Mod2),
- maybe_opt_debug(!.Instrs, !.C, "after jumps",
+ maybe_opt_debug(!.Instrs, !.C, "jump", "after jumps",
ProcLabel, !OptDebugInfo, !IO)
;
true
@@ -446,7 +480,24 @@
VeryVerbose = no
),
labelopt_main(Final, LayoutLabelSet, !Instrs, _Mod3),
- maybe_opt_debug(!.Instrs, !.C, "after labels",
+ maybe_opt_debug(!.Instrs, !.C, "label", "after labels",
+ ProcLabel, !OptDebugInfo, !IO)
+ ;
+ Mod1 = no
+ ),
+ (
+ Mod1 = yes,
+ (
+ VeryVerbose = yes,
+ io.write_string("% Optimizing locally for ", !IO),
+ io.write_string(LabelStr, !IO),
+ io.write_string("\n", !IO)
+ ;
+ VeryVerbose = no
+ ),
+ globals.io_get_gc_method(GC_Method, !IO),
+ peephole.optimize(GC_Method, !Instrs, _Mod),
+ maybe_opt_debug(!.Instrs, !.C, "peep", "after peephole",
ProcLabel, !OptDebugInfo, !IO)
;
Mod1 = no
@@ -471,7 +522,7 @@
globals.io_lookup_bool_option(auto_comments, AutoComments, !IO),
use_local_vars_proc(!Instrs, NumRealRRegs, AccessThreshold,
AutoComments, ProcLabel, !C),
- maybe_opt_debug(!.Instrs, !.C, "after use_local_vars",
+ maybe_opt_debug(!.Instrs, !.C, "use_local", "after use_local_vars",
ProcLabel, !OptDebugInfo, !IO)
;
UseLocalVars = no
@@ -507,7 +558,7 @@
VeryVerbose = no
),
labelopt_main(no, LayoutLabelSet, !Instrs, _Mod1),
- maybe_opt_debug(!.Instrs, !.C, "after label opt",
+ maybe_opt_debug(!.Instrs, !.C, "label", "after label opt",
ProcLabel, !OptDebugInfo, !IO)
;
true
@@ -523,7 +574,7 @@
VeryVerbose = no
),
remove_reassign(!Instrs),
- maybe_opt_debug(!.Instrs, !.C, "after reassign",
+ maybe_opt_debug(!.Instrs, !.C, "reassign", "after reassign",
ProcLabel, !OptDebugInfo, !IO)
;
Reassign = no
@@ -539,7 +590,7 @@
VeryVerbose = no
),
fill_branch_delay_slot(!Instrs),
- maybe_opt_debug(!.Instrs, !.C, "after delay slots",
+ maybe_opt_debug(!.Instrs, !.C, "delay_slot", "after delay slots",
ProcLabel, !OptDebugInfo, !IO)
;
DelaySlot = no
@@ -553,7 +604,7 @@
VeryVerbose = no
),
combine_decr_sp(!Instrs),
- maybe_opt_debug(!.Instrs, !.C, "after combine decr_sp",
+ maybe_opt_debug(!.Instrs, !.C, "decr_sp", "after combine decr_sp",
ProcLabel, !OptDebugInfo, !IO),
(
StdLabels = yes,
@@ -566,7 +617,7 @@
VeryVerbose = no
),
standardize_labels(!Instrs, !C),
- maybe_opt_debug(!.Instrs, !.C, "after standard labels",
+ maybe_opt_debug(!.Instrs, !.C, "stdlabel", "after standard labels",
ProcLabel, !OptDebugInfo, !IO)
;
StdLabels = no
@@ -582,7 +633,7 @@
VeryVerbose = no
),
wrap_blocks(!Instrs),
- maybe_opt_debug(!.Instrs, !.C, "after wrap blocks",
+ maybe_opt_debug(!.Instrs, !.C, "wrapblocks", "after wrap blocks",
ProcLabel, !.OptDebugInfo, _OptDebugInfo, !IO)
;
UseLocalVars = no
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.510
diff -u -b -r1.510 options.m
--- compiler/options.m 10 Apr 2006 04:28:21 -0000 1.510
+++ compiler/options.m 10 Apr 2006 04:31:21 -0000
@@ -134,6 +134,7 @@
; debug_opt
; debug_term % term = constraint termination analysis
; debug_opt_pred_id
+ ; debug_opt_pred_name
; debug_pd % pd = partial deduction/deforestation
; debug_il_asm % il_asm = IL generation via asm
; debug_liveness
@@ -878,6 +879,7 @@
debug_term - bool(no),
debug_opt - bool(no),
debug_opt_pred_id - int(-1),
+ debug_opt_pred_name - string(""),
debug_pd - bool(no),
debug_il_asm - bool(no),
debug_liveness - int(-1),
@@ -1574,6 +1576,7 @@
long_option("debug-term", debug_term).
long_option("debug-opt", debug_opt).
long_option("debug-opt-pred-id", debug_opt_pred_id).
+long_option("debug-opt-pred-name", debug_opt_pred_name).
long_option("debug-pd", debug_pd).
% debug-il-asm does very low-level printf style debugging of
% IL assembler. Each instruction is written on stdout before it
@@ -2883,6 +2886,9 @@
"--debug-opt-pred-id <n>",
"\tOutput detailed debugging traces of the optimization process",
"\tonly for the predicate/function with the specified pred id.",
+ "--debug-opt-pred-name <name>",
+ "\tOutput detailed debugging traces of the optimization process",
+ "\tonly for the predicate/function with the specified name.",
"--debug-pd",
"\tOutput detailed debugging traces of the partial",
"\tdeduction and deforestation process.",
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.90
diff -u -b -r1.90 peephole.m
--- compiler/peephole.m 29 Mar 2006 08:07:14 -0000 1.90
+++ compiler/peephole.m 9 Apr 2006 09:17:35 -0000
@@ -232,8 +232,16 @@
% mkframe(NFI, label) => mkframe(NFI, label)
% if_val(test, redo) if_val(test, label)
%
- % These two classes of patterns are mutually exclusive because if_val
- % is not straight-line code.
+ % If a `mkframe' is followed directly by a `fail', we optimize away
+ % the creation of the stack frame:
+ %
+ % mkframe(NFI, <any>) => goto redo
+ % goto fail
+ %
+ % This last pattern can be created by frameopt.m.
+ %
+ % These three classes of patterns are mutually exclusive because if_val
+ % and goto are not straight-line code.
%
% We also look for the following pattern, which can happen when predicates
% that are actually semidet are declared to be nondet:
@@ -299,6 +307,12 @@
->
Instrs = InstrsPrime
;
+ opt_util.skip_comments_livevals(Instrs0, Instrs1),
+ Instrs1 = [Instr1 | Instrs2],
+ Instr1 = goto(do_fail) - Comment2
+ ->
+ Instrs = [goto(do_redo) - Comment2 | Instrs2]
+ ;
Redoip1 = do_fail,
no_stack_straight_line(Instrs0, Straight, Instrs1),
Instrs1 = [Instr1 | Instrs2],
@@ -336,7 +350,7 @@
% straight-line instructions, then we can discard the nondet stack
% frame early.
%
-peephole.match(assign(redoip(lval(Base)), Redoip), Comment, _,
+peephole.match(assign(redoip_slot(lval(Base)), Redoip), Comment, _,
Instrs0, Instrs) :-
(
opt_util.next_assign_to_redoip(Instrs0, [Base], [], Redoip2,
@@ -344,7 +358,7 @@
opt_util.touches_nondet_ctrl(Skipped, no)
->
Instrs1 = Skipped ++ Rest,
- Instrs = [assign(redoip(lval(Base)),
+ Instrs = [assign(redoip_slot(lval(Base)),
const(code_addr_const(Redoip2))) - Comment | Instrs1]
;
Base = curfr,
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.91
diff -u -b -r1.91 pragma_c_gen.m
--- compiler/pragma_c_gen.m 29 Mar 2006 08:07:15 -0000 1.91
+++ compiler/pragma_c_gen.m 22 Apr 2006 08:28:55 -0000
@@ -572,9 +572,15 @@
ExtraArgs = [_ | _],
MaybeDupl = no
),
+ ExtraAttributes = extra_attributes(Attributes),
+ ( list.member(refers_to_llds_stack, ExtraAttributes) ->
+ RefersToLLDSSTack = yes
+ ;
+ RefersToLLDSSTack = no
+ ),
PragmaCCode = node([
pragma_c(Decls, Components, MayCallMercury, no, no, no,
- MaybeFailLabel, no, MaybeDupl)
+ MaybeFailLabel, RefersToLLDSSTack, MaybeDupl)
- "Pragma C inclusion"
]),
%
@@ -692,7 +698,8 @@
code_info.get_next_label(RetryLabel, !CI),
ModFrameCode = node([
- assign(redoip(lval(curfr)), const(code_addr_const(label(RetryLabel))))
+ assign(redoip_slot(lval(curfr)),
+ const(code_addr_const(label(RetryLabel))))
- "Set up backtracking to retry label"
]),
RetryLabelCode = node([
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.159
diff -u -b -r1.159 prog_data.m
--- compiler/prog_data.m 20 Apr 2006 05:37:00 -0000 1.159
+++ compiler/prog_data.m 22 Apr 2006 08:28:55 -0000
@@ -719,6 +719,7 @@
:- type pragma_foreign_proc_extra_attribute
---> max_stack_size(int)
+ ; refers_to_llds_stack
; backend(backend).
:- type pragma_foreign_proc_extra_attributes ==
@@ -1376,10 +1377,10 @@
tabled_for_io :: tabled_for_io,
purity :: purity,
terminates :: terminates,
- % there is some special case behaviour for
- % pragma c_code and pragma import purity
- % if legacy_purity_behaviour is `yes'
may_throw_exception :: may_throw_exception,
+
+ % There is some special case behaviour for pragma c_code
+ % and pragma import purity if legacy_purity_behaviour is `yes'.
legacy_purity_behaviour :: bool,
ordinary_despite_detism :: bool,
may_modify_trail :: may_modify_trail,
@@ -1514,6 +1515,7 @@
:- func extra_attribute_to_string(pragma_foreign_proc_extra_attribute)
= string.
+extra_attribute_to_string(refers_to_llds_stack) = "refers_to_llds_stack".
extra_attribute_to_string(backend(low_level_backend)) = "low_level_backend".
extra_attribute_to_string(backend(high_level_backend)) = "high_level_backend".
extra_attribute_to_string(max_stack_size(Size)) =
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.115
diff -u -b -r1.115 stack_layout.m
--- compiler/stack_layout.m 30 Mar 2006 02:45:59 -0000 1.115
+++ compiler/stack_layout.m 8 Apr 2006 14:16:59 -0000
@@ -1446,15 +1446,15 @@
represent_lval(temp(_, _), _) :-
unexpected(this_file, "continuation live value stored in temp register").
-represent_lval(succip(_), _) :-
+represent_lval(succip_slot(_), _) :-
unexpected(this_file, "continuation live value stored in fixed slot").
-represent_lval(redoip(_), _) :-
+represent_lval(redoip_slot(_), _) :-
unexpected(this_file, "continuation live value stored in fixed slot").
-represent_lval(redofr(_), _) :-
+represent_lval(redofr_slot(_), _) :-
unexpected(this_file, "continuation live value stored in fixed slot").
-represent_lval(succfr(_), _) :-
+represent_lval(succfr_slot(_), _) :-
unexpected(this_file, "continuation live value stored in fixed slot").
-represent_lval(prevfr(_), _) :-
+represent_lval(prevfr_slot(_), _) :-
unexpected(this_file, "continuation live value stored in fixed slot").
represent_lval(field(_, _, _), _) :-
Index: compiler/transform_llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform_llds.m,v
retrieving revision 1.22
diff -u -b -r1.22 transform_llds.m
--- compiler/transform_llds.m 29 Mar 2006 08:07:27 -0000 1.22
+++ compiler/transform_llds.m 8 Apr 2006 03:08:25 -0000
@@ -38,6 +38,7 @@
:- import_module hlds.hlds_pred.
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.proc_label.
+:- import_module hlds.code_model.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
@@ -119,7 +120,7 @@
Arity, proc_id_to_int(ProcId)),
Instrs = [label(entry(local, ProcLabel)) -
"label to indicate end of previous procedure"],
- DummyProc = c_procedure(PredName, Arity, proc(PredId, ProcId),
+ DummyProc = c_procedure(PredName, Arity, proc(PredId, ProcId), model_det,
Instrs, ProcLabel, counter.init(0), must_not_alter_rtti),
EndLabelModule = comp_gen_c_module(LastModule ++ "_END", [DummyProc]).
@@ -159,7 +160,9 @@
is det.
transform_c_procedure(!Proc, MaxSize) :-
- !.Proc = c_procedure(_, _, _, Instrs0, ProcLabel, C0, _),
+ ProcLabel = !.Proc ^ cproc_proc_label,
+ Instrs0 = !.Proc ^ cproc_code,
+ C0 = !.Proc ^ cproc_label_nums,
transform_instructions(Instrs0, Instrs, C0, C, ProcLabel, MaxSize),
!:Proc = !.Proc ^ cproc_code := Instrs,
!:Proc = !.Proc ^ cproc_label_nums := C.
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.37
diff -u -b -r1.37 var_locn.m
--- compiler/var_locn.m 6 Apr 2006 05:38:51 -0000 1.37
+++ compiler/var_locn.m 8 Apr 2006 14:16:59 -0000
@@ -1948,30 +1948,30 @@
Lval = Lval0,
Code = empty
;
- Lval0 = succip(Rval0),
+ Lval0 = succip_slot(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
!VLI),
- Lval = succip(Rval)
+ Lval = succip_slot(Rval)
;
- Lval0 = redoip(Rval0),
+ Lval0 = redoip_slot(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
!VLI),
- Lval = redoip(Rval)
+ Lval = redoip_slot(Rval)
;
- Lval0 = succfr(Rval0),
+ Lval0 = succfr_slot(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
!VLI),
- Lval = succfr(Rval)
+ Lval = succfr_slot(Rval)
;
- Lval0 = redofr(Rval0),
+ Lval0 = redofr_slot(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
!VLI),
- Lval = redofr(Rval)
+ Lval = redofr_slot(Rval)
;
- Lval0 = prevfr(Rval0),
+ Lval0 = prevfr_slot(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
!VLI),
- Lval = prevfr(Rval)
+ Lval = prevfr_slot(Rval)
;
Lval0 = mem_ref(Rval0),
materialize_vars_in_rval(ModuleInfo, Rval0, no, Avoid, Rval, Code,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.473
diff -u -b -r1.473 user_guide.texi
--- doc/user_guide.texi 4 Apr 2006 07:37:12 -0000 1.473
+++ doc/user_guide.texi 22 Apr 2006 11:48:54 -0000
@@ -5470,8 +5470,14 @@
@sp 1
@item --debug-opt-pred-id @var{predid}
@findex --debug-opt-pred-id
-With @samp{--debug-opt}, restrict the debugging traces
-to the optimization of the predicate or function with the specified pred id.
+Output detailed debugging traces of the optimization process
+only for the predicate/function with the specified pred id.
+
+ at sp 1
+ at item --debug-opt-pred-name @var{name}
+ at findex --debug-opt-pred-name
+Output detailed debugging traces of the optimization process
+only for the predicate/function with the specified name.
@sp 1
@item --debug-pd
cvs diff: Diffing extras
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/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
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/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
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 slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
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/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.285
diff -u -b -r1.285 Mmakefile
--- tests/hard_coded/Mmakefile 20 Apr 2006 04:05:26 -0000 1.285
+++ tests/hard_coded/Mmakefile 20 Apr 2006 05:43:43 -0000
@@ -45,6 +45,7 @@
dense_lookup_switch \
dense_lookup_switch2 \
dense_lookup_switch3 \
+ dense_lookup_switch_non \
det_in_semidet_cntxt \
disjs_in_switch \
division_test \
Index: tests/hard_coded/cycles.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/cycles.m,v
retrieving revision 1.4
diff -u -b -r1.4 cycles.m
--- tests/hard_coded/cycles.m 4 Apr 2006 02:39:20 -0000 1.4
+++ tests/hard_coded/cycles.m 12 Apr 2006 05:28:50 -0000
@@ -2,31 +2,52 @@
% example. (The generated code went into an infinite loop resulting
% in a nondet stack overflow.)
-% cycles.m
-%===========================================================================
:- module cycles.
%---------------------------------------------------------------------------
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
%---------------------------------------------------------------------------
+
:- implementation.
-:- import_module list, bool, solutions, char.
+
+:- import_module list.
+:- import_module bool.
+:- import_module solutions.
+:- import_module char.
%--------------------------------------------------
-:- type node ---> a ; b ; c ; d ; e ; f ; g ; h ; i ; j ; k ; l.
-:- type status ---> traverse ; cycle ; no_cycle.
+:- type node
+ ---> a
+ ; b
+ ; c
+ ; d
+ ; e
+ ; f
+ ; g
+ ; h
+ ; i
+ ; j
+ ; k
+ ; l.
+
+:- type status
+ ---> traverse
+ ; cycle
+ ; no_cycle.
%--------------------------------------------------
-main -->
- { cycles(a, Cycles) },
- write_cycles(Cycles).
+
+main(!IO) :-
+ cycles(a, Cycles),
+ write_cycles(Cycles, !IO).
%--------------------------------------------------
+
:- pred arrow(node, node).
:- mode arrow(in, in) is semidet.
:- mode arrow(in, out) is nondet.
@@ -39,24 +60,25 @@
arrow(d, a).
%--------------------------------------------------
+
:- pred cycles(node::in, list(list(node))::out) is det.
cycles(N, Nodes) :-
solutions((pred(C::out) is nondet :- cycle(N, C)), Nodes).
%--------------------------------------------------
+
:- pred cycle(node::in, list(node)::out) is nondet.
cycle(StartNode, NodeLs) :-
cycle1(StartNode, StartNode, [StartNode], NodeLs, traverse).
-
-:- pred cycle1(node, node, list(node), list(node), status).
-:- mode cycle1(in, in, in, out, in) is nondet.
+:- pred cycle1(node::in, node::in, list(node)::in, list(node)::out, status::in)
+ is nondet.
cycle1(StartNode, CurrNode, NodeLs0, NodeLs, traverse) :-
- (arrow(CurrNode, AdjNode) ->
- ((\+ list__member(AdjNode, NodeLs0)) ->
+ ( arrow(CurrNode, AdjNode) ->
+ ( (\+ list__member(AdjNode, NodeLs0)) ->
Status1 = traverse
;
Status1 = cycle
@@ -69,6 +91,7 @@
cycle1(StartNode, StartNode, NodeLs, NodeLs, cycle).
%--------------------------------------------------
+
:- pred node_to_char(node::in, char::out) is det.
node_to_char(a, 'a').
@@ -85,50 +108,68 @@
node_to_char(l, 'l').
%--------------------------------------------------
-:- pred write_node(node::in, io__state::di, io__state::uo) is det.
-
-write_node(N) --> { node_to_char(N, C) }, io__write_char(C).
-
-%--------------------------------------------------
-:- pred write_nodes(list(node)::in, io__state::di, io__state::uo) is det.
-
-write_nodes(Nodes) --> write_nodes1(Nodes, yes).
+:- pred write_node(node::in, io::di, io::uo) is det.
-:- pred write_nodes1(list(node), bool, io__state, io__state).
-:- mode write_nodes1(in, in, di, uo) is det.
-
-write_nodes1([], yes) --> io__write_string("[]").
-write_nodes1([], no) --> io__write_string("]").
-write_nodes1([N|Ns], Start) -->
- ( { Start = yes } -> io__write_string("[") ; { true }),
- write_node(N),
- ( { Ns \= [] } -> io__write_string(", ") ; { true }),
- write_nodes1(Ns, no).
+write_node(N, !IO) :-
+ node_to_char(N, C),
+ io.write_char(C, !IO).
%--------------------------------------------------
-:- pred write_cycles(list(list(node)), io__state, io__state).
-:- mode write_cycles(in, di, uo) is det.
-
-write_cycles(Nodes) --> write_cycles1(Nodes, yes), io__write_string("\n").
-
-:- pred write_cycles1(list(list(node)), bool, io__state, io__state).
-:- mode write_cycles1(in, in, di, uo) is det.
+:- pred write_nodes(list(node)::in, io::di, io::uo) is det.
-write_cycles1([], yes) --> io__write_string("[]").
-write_cycles1([], no) --> io__write_string("]").
-write_cycles1([N|Ns], Start) -->
- ( { Start = yes } -> io__write_string("[") ; { true }),
- write_nodes(N),
- ( { Ns \= [] } -> io__write_string(", ") ; { true }),
- write_cycles1(Ns, no).
+write_nodes(Nodes, !IO) :-
+ write_nodes1(Nodes, yes, !IO).
-%===========================================================================
-:- end_module cycles.
+:- pred write_nodes1(list(node)::in, bool::in, io::di, io::uo) is det.
+write_nodes1([], yes, !IO) :-
+ io.write_string("[]", !IO).
+write_nodes1([], no, !IO) :-
+ io.write_string("]", !IO).
+write_nodes1([N | Ns], Start, !IO) :-
+ (
+ Start = yes,
+ io.write_string("[", !IO)
+ ;
+ Start = no
+ ),
+ write_node(N, !IO),
+ (
+ Ns = [_ | _],
+ io.write_string(", ", !IO)
+ ;
+ Ns = []
+ ),
+ write_nodes1(Ns, no, !IO).
+%--------------------------------------------------
+:- pred write_cycles(list(list(node))::in, io::di, io::uo) is det.
+write_cycles(Nodes, !IO) :-
+ write_cycles1(Nodes, yes, !IO),
+ io.write_string("\n", !IO).
+:- pred write_cycles1(list(list(node))::in, bool::in, io::di, io::uo) is det.
+write_cycles1([], yes, !IO) :-
+ io.write_string("[]", !IO).
+write_cycles1([], no, !IO) :-
+ io.write_string("]", !IO).
+write_cycles1([N | Ns], Start, !IO) :-
+ (
+ Start = yes,
+ io.write_string("[", !IO)
+ ;
+ Start = no
+ ),
+ write_nodes(N, !IO),
+ (
+ Ns = [_ | _],
+ io.write_string(", ", !IO)
+ ;
+ Ns = []
+ ),
+ write_cycles1(Ns, no, !IO).
Index: tests/hard_coded/dense_lookup_switch_non.exp
===================================================================
RCS file: tests/hard_coded/dense_lookup_switch_non.exp
diff -N tests/hard_coded/dense_lookup_switch_non.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dense_lookup_switch_non.exp 22 Apr 2006 07:11:55 -0000
@@ -0,0 +1,31 @@
+a ->
+end
+
+b ->
+end
+
+c ->
+end
+
+d ->
+four f1 4.40000000000000
+end
+
+e ->
+five f2 5.50000000000000
+five2 f3(5) 55.5000000000000
+end
+
+f ->
+six f4("hex") 6.60000000000000
+end
+
+g ->
+seven f5(77.7000000000000) 7.70000000000000
+seven2 f1 777.700000000000
+seven3 f2 7777.70000000000
+end
+
+h ->
+end
+
Index: tests/hard_coded/dense_lookup_switch_non.m
===================================================================
RCS file: tests/hard_coded/dense_lookup_switch_non.m
diff -N tests/hard_coded/dense_lookup_switch_non.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dense_lookup_switch_non.m 6 Apr 2006 03:48:52 -0000
@@ -0,0 +1,77 @@
+:- module dense_lookup_switch_non.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module solutions.
+
+:- type foo
+ ---> a
+ ; b
+ ; c
+ ; d
+ ; e
+ ; f
+ ; g
+ ; h.
+
+:- type bar
+ ---> f1
+ ; f2
+ ; f3(int)
+ ; f4(string)
+ ; f5(float).
+
+main(!IO) :-
+ test(a, !IO),
+ test(b, !IO),
+ test(c, !IO),
+ test(d, !IO),
+ test(e, !IO),
+ test(f, !IO),
+ test(g, !IO),
+ test(h, !IO).
+
+:- pred test(foo::in, io::di, io::uo) is det.
+
+test(Foo, !IO) :-
+ solutions(p_tuple(Foo), Solns),
+ io.write(Foo, !IO),
+ io.write_string(" ->\n", !IO),
+ io.write_list(Solns, "", write_tp, !IO),
+ io.write_string("end\n\n", !IO).
+
+:- type tp
+ ---> tp(string, bar, float).
+
+:- pred write_tp(tp::in, io::di, io::uo) is det.
+
+write_tp(tp(Str, Bar, Float), !IO) :-
+ io.write_string(Str, !IO),
+ io.write_string(" ", !IO),
+ io.write(Bar, !IO),
+ io.write_string(" ", !IO),
+ io.write_float(Float, !IO),
+ io.nl(!IO).
+
+:- pred p_tuple(foo::in, tp::out) is nondet.
+
+p_tuple(Foo, Tuple) :-
+ p(Foo, Str, Bar, Float),
+ Tuple = tp(Str, Bar, Float).
+
+:- pred p(foo::in, string::out, bar::out, float::out) is nondet.
+:- pragma no_inline(p/4).
+
+p(d, "four", f1, 4.4).
+p(e, "five", f2, 5.5).
+p(e, "five2", f3(5), 55.5).
+p(f, "six", f4("hex"), 6.6).
+p(g, "seven", f5(77.7), 7.7).
+p(g, "seven2", f1, 777.7).
+p(g, "seven3", f2, 7777.7).
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/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list