Files
mercury/compiler/opt_util.m
Julien Fischer f519e26173 Add builtin 64-bit integer types -- Part 1.
Add the new builtin types: int64 and uint64.

Support for these new types will need to be bootstrapped over several changes.
This is the first such change and does the following:

- Extends the compiler to recognise 'int64' and 'uint64' as builtin types.
- Extends the set of builtin arithmetic, bitwise and relational operators
  to cover the new types.
- Adds the new internal option '--unboxed-int64s' to the compiler; this will be
  used to control whether 64-bit integer types are boxed or not.
- Extends all of the code generators to handle the new types.
- Extends the runtimes to support the new types.
- Adds new modules to the standard library intend to contain basic operations
  on the new types.  (These are currently empty and not documented.)

There are bunch of limitations marks with "XXX INT64"; these will be lifted in
part 2 of this change.  Also, 64-bit integer types are currently always boxed,
again this limitation will be lifted in later changes.

compiler/options.m:
    Add the new option --unboxed-int64s.

compiler/prog_type.m:
compiler/prog_data.m:
compiler/builtin_lib_types.m:
     Recognise int64 and uint64 as builtin types.

compiler/builtin_ops.m:
     Add builtin operations for the new types.

compiler/hlds_data.m:
     Add new tag types for the new types.

compiler/ctgc.selector.m:
compiler/dead_proc_elim.m:
compiler/export.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_dependency_graph.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/mercury_to_mercury.m:
compiler/mode_util.m:
compiler/module_qual.qualify_items.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/parse_tree_to_term.m:
compiler/parse_type_name.m:
compiler/polymorphism.m:
compiler/prog_out.m:
compiler/prog_util.m:
compiler/rbmm.execution_path.m:
compiler/rtti.m:
compiler/table_gen.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/unify_gen.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
    Conform to the above changes to the parse tree and HLDS.

compiler/c_util.m:
    Support writing out constants of the new types.

compiler/llds.m:
    Add a representation for constants of the new types to the LLDS.

compiler/stack_layout.m:
    Add a new field to the stack layout params that records whether
    64-bit integers are boxed or not.

compiler/call_gen.:m
compiler/code_info.m:
compiler/disj_gen.m:
compiler/dupproc.m:
compiler/exprn_aux.m:
compiler/global_data.m:
compiler/jumpopt.m:
compiler/llds_out_data.m:
compiler/llds_out_instr.m:
compiler/lookup_switch.m:
compiler/mercury_compile_llds_back_end.m:
compiler/prog_rep.m:
compiler/prog_rep_tables.m:
compiler/var_locn.m b/compiler/var_locn.m:
    Support the new types in the LLDS code generator.

compiler/mlds.m:
    Support constants of the new types in the MLDS.

compiler/ml_call_gen.m:
compiler/ml_code_util.m:
compiler/ml_global_data.m:
compiler/ml_rename_classes.m:
compiler/ml_top_gen.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_target_util.m:
compiler/rtti_to_mlds.m:
     Conform to the above changes to the MLDS.

compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/mlds_to_java.m:
    Generate the appropriate target code for constants of the new types
    and operations involving them.

compiler/bytecode.m:
compiler/bytecode_gen.m:
    Handle the new types in the bytecode generator; we just abort if we
    encounter them for now.

compiler/elds.m:
compiler/elds_to_erlang.m:
compiler/erl_call_gen.m:
compiler/erl_code_util.m:
compiler/erl_unify_gen.m:
    Handle the new types in the Erlang code generator.

library/private_builtin.m:
    Add placeholders for the builtin unify and compare operations for
    the new types.  Since the bootstrapping compiler will not recognise
    the new types we give them polymorphic arguments.  These can be
    replaced after this change has bootstrapped.

    Update the Java list of TypeCtorRep constants here.

library/int64.m:
library/uint64.m:
    New modules that will eventually contain builtin operations on the new
    types.

library/library.m:
library/MODULES_UNDOC:
    Do not include the above modules in the library documentation for now.

library/construct.m:
library/erlang_rtti_implementation.m:
library/rtti_implementation.m:
library/table_statistics.m:
deep_profiler/program_representation_utils.m:
mdbcomp/program_representation.m:
    Handle the new types.

configure.ac:
runtime/mercury_conf.h.in:
    Define the macro MR_BOXED_INT64S.  For now it is always defined, support for
    unboxed 64-bit integers will be enabled in a later change.

runtime/mercury_dotnet.cs.in:
java/runtime/TypeCtorRep.java:
runtime/mercury_type_info.h:
    Update the list of type_ctor reps.

runtime/mercury.h:
runtime/mercury_int.[ch]:
    Add macros for int64 / uint64 -> MR_Word conversion, boxing and
    unboxing.

    Add functions for hashing 64-bit integer types suitable for use
    with the tabling mechanism.

runtime/mercury_tabling.[ch]:
    Add additional HashTableSlot structs for 64-bit integer types.

    Omit the '%' character from the conversion specifiers we pass via
    the 'key_format' argument to the macros that generate the table lookup
    function.  This is so we can use the C99 exact size integer conversion
    specifiers (e.g. PRIu64 etc.) directly here.

runtime/mercury_hash_lookup_or_add_body.h:
    Add the '%' character that was omitted above to the call to debug_key_msg.

runtime/mercury_memory.h:
     Add new builtin allocation sites for boxed 64-bit integer types.

runtime/mercury_builtin_types.[ch]:
runtime/mercury_builitn_types_proc_layouts.h:
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling_macros.h:
runtime/mercury_tabling_preds.h:
runtime/mercury_term_size.c:
runtime/mercury_unify_compare_body.h:
    Add the new builtin types and handle them throughout the runtime.

runtime/Mmakefile:
    Add mercury_int.c to the list of .c files.

doc/reference_manual.texi:
     Add the new types to the list of reserved type names.

     Add the mapping from the new types to their target language types.
     These are commented out for now.
2018-01-12 09:29:24 -05:00

2684 lines
91 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: opt_util.m.
% Main author: zs.
%
% Utilities for LLDS to LLDS optimization.
%
%-----------------------------------------------------------------------------%
:- module ll_backend.opt_util.
:- interface.
:- import_module ll_backend.llds.
:- import_module mdbcomp.prim_data.
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module maybe.
%-----------------------------------------------------------------------------%
:- type instrmap == map(label, instruction).
:- type lvalmap == map(label, maybe(instruction)).
:- type tailmap == map(label, list(instruction)).
:- type succmap == map(label, bool).
:- pred get_prologue(list(instruction)::in, instruction::out,
list(instruction)::out, list(instruction)::out) is det.
:- pred gather_comments(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
:- pred gather_comments_livevals(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
% Given a list of instructions, skip past any comment instructions
% at the start and return the remaining instructions. We do this because
% comment instructions get in the way of peephole optimization.
%
:- pred skip_comments(list(instruction)::in, list(instruction)::out) is det.
:- pred skip_comments_livevals(list(instruction)::in,
list(instruction)::out) is det.
:- pred skip_comments_labels(list(instruction)::in,
list(instruction)::out) is det.
:- pred skip_comments_livevals_labels(list(instruction)::in,
list(instruction)::out) is det.
% Find the next assignment to the redoip of the frame whose address
% is given by the base addresses in the second argument, provided
% it is guaranteed to be reached from here, and guaranteed not to be
% reached from anywhere else by a jump.
%
:- pred next_assign_to_redoip(list(instruction)::in, list(lval)::in,
list(instruction)::in, code_addr::out, list(instruction)::out,
list(instruction)::out) is semidet.
% See if these instructions touch nondet stack controls, i.e.
% the virtual machine registers that point to the nondet stack
% (curfr and maxfr) and the fixed slots in nondet stack frames.
%
:- func touches_nondet_ctrl(list(instruction)) = bool.
% Find the instructions up to and including the next one that
% cannot fall through.
%
:- pred find_no_fallthrough(list(instruction)::in,
list(instruction)::out) is det.
% Find the first label in the instruction stream.
%
:- pred find_first_label(list(instruction)::in, label::out) is det.
% Skip to the next label, returning the code before the label,
% and the label together with the code after the label.
%
:- pred skip_to_next_label(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
% Check whether the named label follows without any intervening code.
% If yes, return the instructions after the label.
%
:- pred is_this_label_next(label::in, list(instruction)::in,
list(instruction)::out) is semidet.
% Is a proceed instruction (i.e. a goto(succip) instruction)
% next in the instruction list, possibly preceded by a restoration
% of succip and a det stack frame removal? If yes, return the
% instructions up to the proceed.
%
:- pred is_proceed_next(list(instruction)::in,
list(instruction)::out) is semidet.
% Is a proceed instruction (i.e. a goto(succip) instruction)
% next in the instruction list, possibly preceded by an assignment
% to r1, a restoration of succip and a det stack frame removal?
% If yes, return the instructions up to the proceed.
%
:- pred is_sdproceed_next(list(instruction)::in,
list(instruction)::out) is semidet.
% Same as the previous predicate, but also return whether it is
% a success or a fail.
%
:- pred is_sdproceed_next_sf(list(instruction)::in,
list(instruction)::out, bool::out) is semidet.
% Is a succeed instruction (i.e. a goto(do_succeed(_)) instruction)
% next in the instruction list? If yes, return the instructions
% up to and including the succeed.
%
:- pred is_succeed_next(list(instruction)::in,
list(instruction)::out) is semidet.
% Is the following code a test of r1, followed in both continuations
% by a semidet proceed? Is the code in both continuations the same,
% modulo livevals annotations and the value assigned to r1? Is MR_TRUE
% assigned to r1 in the success continuation and MR_FALSE in the failure
% continuation? If the answer is yes to all these questions, return
% the code shared by the two continuations.
%
:- pred is_forkproceed_next(list(instruction)::in, tailmap::in,
list(instruction)::out) is semidet.
% Remove the assignment to r1 from the list returned by is_sdproceed_next.
%
:- pred filter_out_r1(list(instruction)::in, maybe(rval_const)::out,
list(instruction)::out) is det.
% Does the following code consist of straighline instructions that do not
% modify nondet frame linkages, plus possibly if_val(..., dofail), and then
% a succeed? If yes, then return all the instructions up to the succeed,
% and all the following instructions.
%
:- pred straight_alternative(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is semidet.
% Find and return the initial sequence of instructions that do not
% refer to stackvars and do not branch.
%
:- pred no_stack_straight_line(list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
% Check whether the given instruction sequence consist of an initial
% sequence of instructions that do not refer to stackvars and do not
% contain any entry points or unconditional branches away, until a
% goto(do_succeed(yes)) instruction. If yes, return that initial sequence,
% the comment on the goto(do_succeed(yes)) instruction, and the
% instructions after it.
%
:- pred may_replace_succeed_with_succeed_discard(list(instruction)::in,
list(instruction)::out, string::out, list(instruction)::out) is semidet.
% Remove the labels from a block of code for jumpopt.
%
:- pred filter_out_labels(list(instruction)::in, list(instruction)::out)
is det.
% Remove any livevals instructions that do not precede an instruction
% that needs one.
%
:- pred filter_out_bad_livevals(list(instruction)::in, list(instruction)::out)
is det.
% Remove the livevals instruction from the list returned by
% is_proceed_next.
%
:- pred filter_out_livevals(list(instruction)::in, list(instruction)::out)
is det.
% Get just the livevals instructions from a list of instructions.
%
:- pred filter_in_livevals(list(instruction)::in,
list(instruction)::out) is det.
% See if the condition of an if-then-else is constant, and if yes,
% whether the branch will be taken or not.
%
:- pred is_const_condition(rval::in, bool::out) is semidet.
% Check whether an instruction can possibly branch away.
%
:- func can_instr_branch_away(instr) = bool.
% Check whether an instruction can possibly fall through
% to the next instruction without using its label.
%
:- func can_instr_fall_through(instr) = bool.
% Check whether a code_addr, when the target of a goto, represents either
% a call or a proceed/succeed; if so, it is the end of an extended basic
% block and needs a livevals in front of it.
%
:- func livevals_addr(code_addr) = bool.
% Determine all the labels and code addresses which are referenced
% by an instruction. The code addresses that are labels are returned
% in both output arguments.
%
:- pred instr_labels(instr::in, list(label)::out, list(code_addr)::out) is det.
:- pred instr_labels_only(instr::in, list(label)::out) is det.
% Given an instruction, find the set of labels and other code addresses
% to which it can cause control to transfer. In the case of calls, this
% includes transfer via return from the called procedure.
%
:- pred possible_targets(instr::in, list(label)::out, list(code_addr)::out)
is det.
% Find the maximum temp variable number used.
%
:- pred count_temps_instr_list(list(instruction)::in, int::in, int::out,
int::in, int::out) is det.
:- pred count_temps_instr(instr::in, int::in, int::out,
int::in, int::out) is det.
% See whether a (list of) instructions or instruction components
% references the current stack frame (on either stack).
%
:- 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
% the decr_sp. A restoration of succip from the bottom stack slot
% is allowed; this instruction is not returned in the output.
% The same thing applies to assignments to detstackvars; these are
% not useful if we throw away the stack frame.
%
:- pred no_stackvars_til_decr_sp(list(instruction)::in, int::in,
list(instruction)::out, list(instruction)::out) is semidet.
% Format a label or proc_label for verbose messages during compilation.
%
:- func format_label(label) = string.
:- func format_proc_label(proc_label) = string.
% Find out if an instruction sequence has both incr_sp and decr_sp.
%
:- pred has_both_incr_decr_sp(list(instruction)::in) is semidet.
% Find out what rvals, if any, are needed to access an lval.
%
:- pred lval_access_rvals(lval::in, list(rval)::out) is det.
% Count the number of hp increments in a block of code.
%
:- pred count_incr_hp(list(instruction)::in, int::out) is det.
% Whenever the input list of instructions contains two livevals pseudo-ops
% without an intervening no-fall-through instruction, ensure that the
% first of these registers as live every lval that is live in the second,
% except those that are assigned to by intervening instructions. This makes
% the shadowing of the second livevals by the first benign.
%
:- pred propagate_livevals(list(instruction)::in, list(instruction)::out)
is det.
% Replace references to one set of local labels with references to another
% set, in one instruction or a list of instructions. Control references
% (those that can cause a transfer of control from the instruction they
% occur in to the replaced label, either directly or via return from a
% called procedure) are always replaced; references that treat the label
% as data are replaced iff the third argument is set to "yes".
%
% With replace_labels_instruction_list, the last arg says whether
% it is OK to replace a label in a label instruction itself.
%
:- pred replace_labels_instr(instr::in, instr::out,
map(label, label)::in, bool::in) is det.
:- pred replace_labels_instruction(instruction::in, instruction::out,
map(label, label)::in, bool::in) is det.
:- pred replace_labels_instruction_list(
list(instruction)::in, list(instruction)::out,
map(label, label)::in, bool::in, bool::in) is det.
:- pred replace_labels_comps(
list(foreign_proc_component)::in, list(foreign_proc_component)::out,
map(label, label)::in) is det.
:- pred replace_labels_code_addr(code_addr::in, code_addr::out,
map(label, label)::in) is det.
:- pred replace_labels_maybe_label_list(list(maybe(label))::in,
list(maybe(label))::out, map(label, label)::in) is det.
:- pred replace_labels_label(label::in, label::out, map(label, label)::in)
is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.builtin_ops.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_llds.
:- import_module hlds.special_pred.
:- import_module ll_backend.code_util.
:- import_module ll_backend.exprn_aux.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_data.
:- import_module int.
:- import_module require.
:- import_module set.
:- import_module string.
%-----------------------------------------------------------------------------%
get_prologue(Instrs0, LabelInstr, Comments, Instrs) :-
gather_comments(Instrs0, Comments1, Instrs1),
( if
Instrs1 = [Instr1 | Instrs2],
Instr1 = llds_instr(label(_), _)
then
LabelInstr = Instr1,
gather_comments(Instrs2, Comments2, Instrs),
list.append(Comments1, Comments2, Comments)
else
unexpected($module, $pred, "procedure does not begin with label")
).
gather_comments(Instrs0, Comments, Instrs) :-
( if
Instrs0 = [Instr0 | Instrs1],
Instr0 = llds_instr(comment(_), _)
then
gather_comments(Instrs1, Comments0, Instrs),
Comments = [Instr0 | Comments0]
else
Instrs = Instrs0,
Comments = []
).
gather_comments_livevals(Instrs0, Comments, Instrs) :-
( if
Instrs0 = [Instr0 | Instrs1],
Instr0 = llds_instr(Uinstr0, _),
( Uinstr0 = comment(_)
; Uinstr0 = livevals(_)
)
then
gather_comments_livevals(Instrs1, Comments0, Instrs),
Comments = [Instr0 | Comments0]
else
Instrs = Instrs0,
Comments = []
).
skip_comments(Instrs0, Instrs) :-
( if Instrs0 = [llds_instr(comment(_), _) | Instrs1] then
skip_comments(Instrs1, Instrs)
else
Instrs = Instrs0
).
skip_comments_livevals(Instrs0, Instrs) :-
( if Instrs0 = [llds_instr(comment(_), _) | Instrs1] then
skip_comments(Instrs1, Instrs)
else if Instrs0 = [llds_instr(livevals(_), _) | Instrs1] then
skip_comments_livevals(Instrs1, Instrs)
else
Instrs = Instrs0
).
skip_comments_labels(Instrs0, Instrs) :-
( if Instrs0 = [llds_instr(comment(_), _) | Instrs1] then
skip_comments_labels(Instrs1, Instrs)
else if Instrs0 = [llds_instr(label(_), _) | Instrs1] then
skip_comments_labels(Instrs1, Instrs)
else
Instrs = Instrs0
).
skip_comments_livevals_labels(Instrs0, Instrs) :-
( if Instrs0 = [llds_instr(comment(_), _) | Instrs1] then
skip_comments_livevals_labels(Instrs1, Instrs)
else if Instrs0 = [llds_instr(livevals(_), _) | Instrs1] then
skip_comments_livevals_labels(Instrs1, Instrs)
else if Instrs0 = [llds_instr(label(_), _) | Instrs1] then
skip_comments_livevals_labels(Instrs1, Instrs)
else
Instrs = Instrs0
).
next_assign_to_redoip([Instr | Instrs], AllowedBases, RevSkip,
Redoip, Skip, Rest) :-
Instr = llds_instr(Uinstr, _Comment),
( if
Uinstr = assign(redoip_slot(lval(Fr)),
const(llconst_code_addr(Redoip0))),
list.member(Fr, AllowedBases)
then
Redoip = Redoip0,
list.reverse(RevSkip, Skip),
Rest = Instrs
else if
Uinstr = mkframe(_, _)
then
fail
else if
Uinstr = label(_)
then
fail
else
CanBranchAway = can_instr_branch_away(Uinstr),
(
CanBranchAway = no,
next_assign_to_redoip(Instrs, AllowedBases, [Instr | RevSkip],
Redoip, Skip, Rest)
;
CanBranchAway = yes,
fail
)
).
find_no_fallthrough([], []).
find_no_fallthrough([Instr0 | Instrs0], Instrs) :-
( if
Instr0 = llds_instr(Uinstr0, _),
can_instr_fall_through(Uinstr0) = no
then
Instrs = [Instr0]
else
find_no_fallthrough(Instrs0, Instrs1),
Instrs = [Instr0 | Instrs1]
).
find_first_label([], _) :-
unexpected($module, $pred, "cannot find first label").
find_first_label([Instr0 | Instrs0], Label) :-
( if Instr0 = llds_instr(label(LabelPrime), _) then
Label = LabelPrime
else
find_first_label(Instrs0, Label)
).
skip_to_next_label([], [], []).
skip_to_next_label([Instr0 | Instrs0], Before, Remain) :-
( if Instr0 = llds_instr(label(_), _) then
Before = [],
Remain = [Instr0 | Instrs0]
else
skip_to_next_label(Instrs0, Before1, Remain),
Before = [Instr0 | Before1]
).
is_this_label_next(Label, [Instr | Moreinstr], Remainder) :-
Instr = llds_instr(Uinstr, _Comment),
( if Uinstr = comment(_) then
is_this_label_next(Label, Moreinstr, Remainder)
else if Uinstr = livevals(_) then
% XXX This is questionable.
is_this_label_next(Label, Moreinstr, Remainder)
else if Uinstr = label(NextLabel) then
( if Label = NextLabel then
Remainder = Moreinstr
else
is_this_label_next(Label, Moreinstr, Remainder)
)
else
fail
).
is_proceed_next(Instrs0, InstrsBetween) :-
skip_comments_labels(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
( if Instr1 = llds_instr(assign(succip, lval(stackvar(_))), _) then
Instr1use = Instr1,
skip_comments_labels(Instrs2, Instrs3)
else
Instr1use = llds_instr(comment("no succip restoration"), ""),
Instrs3 = Instrs1
),
Instrs3 = [Instr3 | Instrs4],
( if Instr3 = llds_instr(decr_sp(_), _) then
Instr3use = Instr3,
skip_comments_labels(Instrs4, Instrs5)
else
Instr3use = llds_instr(comment("no sp restoration"), ""),
Instrs5 = Instrs3
),
Instrs5 = [Instr5 | Instrs6],
Instr5 = llds_instr(livevals(_), _),
skip_comments_labels(Instrs6, Instrs7),
Instrs7 = [Instr7 | _],
Instr7 = llds_instr(goto(code_succip), _),
InstrsBetween = [Instr1use, Instr3use, Instr5].
is_sdproceed_next(Instrs0, InstrsBetween) :-
is_sdproceed_next_sf(Instrs0, InstrsBetween, _).
is_sdproceed_next_sf(Instrs0, InstrsBetween, Success) :-
skip_comments_labels(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
( if Instr1 = llds_instr(assign(succip, lval(stackvar(_))), _) then
Instr1use = Instr1,
skip_comments_labels(Instrs2, Instrs3)
else
Instr1use = llds_instr(comment("no succip restoration"), ""),
Instrs3 = Instrs1
),
Instrs3 = [Instr3 | Instrs4],
( if Instr3 = llds_instr(decr_sp(_), _) then
Instr3use = Instr3,
skip_comments_labels(Instrs4, Instrs5)
else
Instr3use = llds_instr(comment("no sp restoration"), ""),
Instrs5 = Instrs3
),
Instrs5 = [Instr5 | Instrs6],
Instr5 = llds_instr(assign(reg(reg_r, 1), const(R1val)), _),
(
R1val = llconst_true,
Success = yes
;
R1val = llconst_false,
Success = no
),
skip_comments_labels(Instrs6, Instrs7),
Instrs7 = [Instr7 | Instrs8],
Instr7 = llds_instr(livevals(_), _),
skip_comments_labels(Instrs8, Instrs9),
Instrs9 = [Instr9 | _],
Instr9 = llds_instr(goto(code_succip), _),
InstrsBetween = [Instr1use, Instr3use, Instr5, Instr7].
is_succeed_next(Instrs0, InstrsBetweenIncl) :-
skip_comments_labels(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
Instr1 = llds_instr(livevals(_), _),
skip_comments_labels(Instrs2, Instrs3),
Instrs3 = [Instr3 | _],
Instr3 = llds_instr(goto(do_succeed(_)), _),
InstrsBetweenIncl = [Instr1, Instr3].
is_forkproceed_next(Instrs0, Sdprocmap, Between) :-
skip_comments_labels(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
Instr1 = llds_instr(Uinstr1, _),
( if
Uinstr1 = if_val(lval(reg(reg_r, 1)), code_label(JumpLabel))
then
map.search(Sdprocmap, JumpLabel, BetweenJump),
is_sdproceed_next(Instrs2, BetweenFall),
filter_out_r1(BetweenJump, yes(llconst_true), BetweenTrue0),
filter_out_livevals(BetweenTrue0, Between),
filter_out_r1(BetweenFall, yes(llconst_false), BetweenFalse0),
filter_out_livevals(BetweenFalse0, Between)
else if
Uinstr1 = if_val(unop(logical_not, lval(reg(reg_r, 1))),
code_label(JumpLabel))
then
map.search(Sdprocmap, JumpLabel, BetweenJump),
is_sdproceed_next(Instrs2, BetweenFall),
filter_out_r1(BetweenJump, yes(llconst_false), BetweenFalse0),
filter_out_livevals(BetweenFalse0, Between),
filter_out_r1(BetweenFall, yes(llconst_true), BetweenTrue0),
filter_out_livevals(BetweenTrue0, Between)
else
fail
).
filter_out_r1([], no, []).
filter_out_r1([Instr0 | Instrs0], Success, Instrs) :-
filter_out_r1(Instrs0, Success0, Instrs1),
( if Instr0 = llds_instr(assign(reg(reg_r, 1), const(Success1)), _) then
Instrs = Instrs1,
Success = yes(Success1)
else
Instrs = [Instr0 | Instrs1],
Success = Success0
).
straight_alternative(Instrs0, Between, After) :-
straight_alternative_2(Instrs0, [], BetweenRev, After),
list.reverse(BetweenRev, Between).
:- pred straight_alternative_2(list(instruction)::in, list(instruction)::in,
list(instruction)::out, list(instruction)::out) is semidet.
straight_alternative_2([Instr0 | Instrs0], !Between, After) :-
Instr0 = llds_instr(Uinstr0, _),
( if
Uinstr0 = label(_)
then
fail
else if
Uinstr0 = goto(do_succeed(no))
then
After = Instrs0
else if
(
can_instr_branch_away(Uinstr0) = no,
touches_nondet_ctrl_instr(Uinstr0) = no
;
Uinstr0 = if_val(_, CodeAddr),
( CodeAddr = do_fail ; CodeAddr = do_redo )
)
then
!:Between = [Instr0 | !.Between],
straight_alternative_2(Instrs0, !Between, After)
else
fail
).
no_stack_straight_line(Instrs0, StraightLine, Instrs) :-
no_stack_straight_line_2(Instrs0, [], RevStraightLine, Instrs),
list.reverse(RevStraightLine, StraightLine).
:- pred no_stack_straight_line_2(list(instruction)::in, list(instruction)::in,
list(instruction)::out, list(instruction)::out) is det.
no_stack_straight_line_2([], !RevStraightLine, []).
no_stack_straight_line_2([Instr0 | Instrs0], !RevStraightLine, Instrs) :-
Instr0 = llds_instr(Uinstr, _),
( if
(
Uinstr = comment(_)
;
Uinstr = livevals(_)
;
Uinstr = assign(Lval, Rval),
lval_refers_stackvars(Lval) = no,
rval_refers_stackvars(Rval) = no
)
then
!:RevStraightLine = [Instr0 | !.RevStraightLine],
no_stack_straight_line_2(Instrs0, !RevStraightLine, Instrs)
else
Instrs = [Instr0 | Instrs0]
).
may_replace_succeed_with_succeed_discard(Instrs0, UntilSucceed, SucceedComment,
Remain) :-
may_replace_succeed_with_succeed_discard_2(Instrs0, [], RevUntilSucceed,
SucceedComment, Remain),
list.reverse(RevUntilSucceed, UntilSucceed).
:- pred may_replace_succeed_with_succeed_discard_2(list(instruction)::in,
list(instruction)::in, list(instruction)::out, string::out,
list(instruction)::out) is semidet.
may_replace_succeed_with_succeed_discard_2([Instr0 | Instrs0],
!RevUntilSucceed, SucceedComment, Remain) :-
Instr0 = llds_instr(Uinstr, Comment),
( if
Uinstr = goto(do_succeed(yes))
then
SucceedComment = Comment,
Remain = Instrs0
else if
(
Uinstr = assign(Lval, Rval),
lval_refers_stackvars(Lval) = no,
rval_refers_stackvars(Rval) = no
;
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = if_val(_, _)
; Uinstr = incr_hp(_, _, _, _, _, _, _, _)
; Uinstr = mark_hp(_)
; Uinstr = restore_hp(_)
; Uinstr = free_heap(_)
; Uinstr = store_ticket(_)
; Uinstr = store_ticket(_)
; Uinstr = reset_ticket(_, _)
; Uinstr = prune_ticket
; Uinstr = discard_ticket
; Uinstr = mark_ticket_stack(_)
; Uinstr = prune_tickets_to(_)
)
)
then
!:RevUntilSucceed = [Instr0 | !.RevUntilSucceed],
may_replace_succeed_with_succeed_discard_2(Instrs0, !RevUntilSucceed,
SucceedComment, Remain)
else
fail
).
lval_refers_stackvars(reg(_, _)) = no.
lval_refers_stackvars(stackvar(_)) = yes.
lval_refers_stackvars(parent_stackvar(_)) = yes.
lval_refers_stackvars(framevar(_)) = yes.
lval_refers_stackvars(double_stackvar(_, _)) = 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(parent_sp) = no.
lval_refers_stackvars(field(_, Rval, FieldNum)) =
bool.or(
rval_refers_stackvars(Rval),
rval_refers_stackvars(FieldNum)).
lval_refers_stackvars(lvar(_)) = _ :-
unexpected($module, $pred, "lvar").
lval_refers_stackvars(temp(_, _)) = no.
lval_refers_stackvars(mem_ref(Rval)) =
rval_refers_stackvars(Rval).
lval_refers_stackvars(global_var_ref(_)) = no.
:- 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($module, $pred, "var").
rval_refers_stackvars(mkword(_, Rval)) =
rval_refers_stackvars(Rval).
rval_refers_stackvars(mkword_hole(_)) = no.
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]) =
( if
(
MaybeRval = no
;
MaybeRval = yes(Rval),
rval_refers_stackvars(Rval) = no
)
then
rvals_refer_stackvars(Tail)
else
yes
).
:- func code_addr_refers_to_stack(code_addr) = bool.
code_addr_refers_to_stack(code_label(_)) = no.
code_addr_refers_to_stack(code_imported_proc(_)) = no.
code_addr_refers_to_stack(code_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 = llds_instr(Uinstr0, _),
(
Uinstr0 = comment(_),
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
;
Uinstr0 = livevals(_),
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
;
Uinstr0 = assign(Lval, Rval),
( if
Lval = stackvar(_),
rval_refers_stackvars(Rval) = no
then
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between, Remain)
else if
Lval = succip,
Rval = lval(stackvar(FrameSize)),
skip_comments(Instrs0, Instrs1),
Instrs1 = [llds_instr(decr_sp(FrameSize), _) | Instrs2]
then
Between = [],
Remain = Instrs2
else
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, _, _, MaybeRegionRval,
MaybeReuse),
lval_refers_stackvars(Lval) = no,
rval_refers_stackvars(Rval) = no,
(
MaybeRegionRval = yes(RegionRval),
rval_refers_stackvars(RegionRval) = no
;
MaybeRegionRval = no
),
(
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval),
rval_refers_stackvars(ReuseRval) = no,
(
MaybeFlagLval = yes(FlagLval),
lval_refers_stackvars(FlagLval) = no
;
MaybeFlagLval = no
)
;
MaybeReuse = no_llds_reuse
),
no_stackvars_til_decr_sp(Instrs0, FrameSize, Between0, Remain),
Between = [Instr0 | Between0]
;
Uinstr0 = decr_sp(FrameSize),
Between = [],
Remain = Instrs0
).
block_refers_to_stack([]) = no.
block_refers_to_stack([Instr | Instrs]) = Refers :-
instr_refers_to_stack(Instr) = InstrRefers,
(
InstrRefers = yes,
Refers = yes
;
InstrRefers = no,
Instr = llds_instr(Uinstr, _),
CanFallThrough = can_instr_fall_through(Uinstr),
(
CanFallThrough = yes,
Refers = block_refers_to_stack(Instrs)
;
CanFallThrough = no,
Refers = no
)
).
instr_refers_to_stack(llds_instr(Uinstr, _)) = Refers :-
(
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = label(_)
; Uinstr = arbitrary_c_code(_, _, _)
; Uinstr = discard_ticket
; Uinstr = prune_ticket
; Uinstr = lc_join_and_terminate(_, _)
),
Refers = no
;
( Uinstr = llcall(_, _, _, _, _, _)
; Uinstr = mkframe(_, _)
; Uinstr = push_region_frame(_, _)
; Uinstr = region_fill_frame(_, _, _, _, _)
; Uinstr = region_set_fixed_slot(_, _, _)
; Uinstr = use_and_maybe_pop_region_frame(_, _)
; Uinstr = incr_sp(_, _, _)
; Uinstr = decr_sp(_)
; Uinstr = decr_sp_and_return(_)
; Uinstr = init_sync_term(_, _, _)
; Uinstr = fork_new_child(_, _)
; Uinstr = join_and_continue(_, _)
; Uinstr = lc_spawn_off(_, _, _)
),
Refers = yes
;
Uinstr = block(_, _, BlockInstrs),
Refers = block_refers_to_stack(BlockInstrs)
;
( Uinstr = assign(Lval, Rval)
; Uinstr = keep_assign(Lval, Rval)
),
Refers = bool.or(
lval_refers_stackvars(Lval),
rval_refers_stackvars(Rval))
;
Uinstr = goto(CodeAddr),
Refers = code_addr_refers_to_stack(CodeAddr)
;
Uinstr = if_val(Rval, CodeAddr),
Refers = bool.or(
rval_refers_stackvars(Rval),
code_addr_refers_to_stack(CodeAddr))
;
( Uinstr = save_maxfr(Lval)
; Uinstr = restore_maxfr(Lval)
; Uinstr = mark_hp(Lval)
; Uinstr = store_ticket(Lval)
; Uinstr = mark_ticket_stack(Lval)
; Uinstr = lc_create_loop_control(_, Lval)
),
Refers = lval_refers_stackvars(Lval)
;
( Uinstr = computed_goto(Rval, _Labels)
; Uinstr = restore_hp(Rval)
; Uinstr = free_heap(Rval)
; Uinstr = reset_ticket(Rval, _Reason)
; Uinstr = prune_tickets_to(Rval)
),
Refers = rval_refers_stackvars(Rval)
;
Uinstr = incr_hp(Lval, _, _, Rval, _, _, MaybeRegionRval,
MaybeReuse),
some [!Refers] (
!:Refers = bool.or(
lval_refers_stackvars(Lval),
rval_refers_stackvars(Rval)),
(
MaybeRegionRval = yes(RegionRval),
bool.or(rval_refers_stackvars(RegionRval), !Refers)
;
MaybeRegionRval = no
),
(
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval),
bool.or(rval_refers_stackvars(ReuseRval), !Refers),
(
MaybeFlagLval = yes(FlagLval),
bool.or(lval_refers_stackvars(FlagLval), !Refers)
;
MaybeFlagLval = no
)
;
MaybeReuse = no_llds_reuse
),
Refers = !.Refers
)
;
Uinstr = foreign_proc_code(_, Components, _, _, _, _, _, _, _, _),
Refers = bool.or_list(list.map(foreign_proc_component_refers_stackvars,
Components))
;
Uinstr = lc_wait_free_slot(Rval, Lval, _),
Refers = bool.or(
rval_refers_stackvars(Rval),
lval_refers_stackvars(Lval))
).
:- func foreign_proc_component_refers_stackvars(foreign_proc_component) = bool.
foreign_proc_component_refers_stackvars(Component) = Refers :-
(
Component = foreign_proc_inputs(Inputs),
bool.or_list(list.map(foreign_proc_input_refers_stackvars, Inputs),
Refers)
;
Component = foreign_proc_outputs(Outputs),
bool.or_list(list.map(foreign_proc_output_refers_stackvars, Outputs),
Refers)
;
( Component = foreign_proc_user_code(_, _, _)
; Component = foreign_proc_raw_code(_, _, _, _)
; Component = foreign_proc_fail_to(_)
; Component = foreign_proc_alloc_id(_)
; Component = foreign_proc_noop
),
Refers = no
).
:- func foreign_proc_input_refers_stackvars(foreign_proc_input) = bool.
foreign_proc_input_refers_stackvars(Input) = Refers :-
Input = foreign_proc_input(_Name, _Type, IsDummy, _OrigType, Rval,
_MaybeForeign, _BoxPolicy),
(
IsDummy = is_dummy_type,
Refers = no
;
IsDummy = is_not_dummy_type,
Refers = rval_refers_stackvars(Rval)
).
:- func foreign_proc_output_refers_stackvars(foreign_proc_output) = bool.
foreign_proc_output_refers_stackvars(Input) = Refers :-
Input = foreign_proc_output(Lval, _Type, IsDummy, _OrigType, _Name,
_MaybeForeign, _BoxPolicy),
(
IsDummy = is_dummy_type,
Refers = no
;
IsDummy = is_not_dummy_type,
Refers = lval_refers_stackvars(Lval)
).
filter_out_labels([], []).
filter_out_labels([Instr0 | Instrs0], Instrs) :-
filter_out_labels(Instrs0, Instrs1),
( if Instr0 = llds_instr(label(_), _) then
Instrs = Instrs1
else
Instrs = [Instr0 | Instrs1]
).
filter_out_bad_livevals([], []).
filter_out_bad_livevals([Instr0 | Instrs0], Instrs) :-
filter_out_bad_livevals(Instrs0, Instrs1),
( if
Instr0 = llds_instr(livevals(_), _),
skip_comments(Instrs1, Instrs2),
Instrs2 = [llds_instr(Uinstr2, _) | _],
can_use_livevals(Uinstr2, no)
then
Instrs = Instrs1
else
Instrs = [Instr0 | Instrs1]
).
filter_out_livevals([], []).
filter_out_livevals([Instr0 | Instrs0], Instrs) :-
filter_out_livevals(Instrs0, Instrs1),
( if Instr0 = llds_instr(livevals(_), _) then
Instrs = Instrs1
else
Instrs = [Instr0 | Instrs1]
).
filter_in_livevals([], []).
filter_in_livevals([Instr0 | Instrs0], Instrs) :-
filter_in_livevals(Instrs0, Instrs1),
( if Instr0 = llds_instr(livevals(_), _) then
Instrs = [Instr0 | Instrs1]
else
Instrs = Instrs1
).
% We recognize only a subset of all constant conditions.
% The time to extend this predicate is when the rest of the compiler
% generates more complicated constant conditions.
is_const_condition(const(Const), Taken) :-
( if Const = llconst_true then
Taken = yes
else if Const = llconst_false then
Taken = no
else
unexpected($module, $pred,
"non-boolean constant as if-then-else condition")
).
is_const_condition(unop(Op, Rval1), Taken) :-
Op = logical_not,
is_const_condition(Rval1, Taken1),
bool.not(Taken1, Taken).
is_const_condition(binop(Op, Rval1, Rval2), Taken) :-
Op = eq(_),
Rval1 = Rval2,
Taken = yes.
can_instr_branch_away(Uinstr) = CanBranchAway :-
(
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = assign(_, _)
; Uinstr = keep_assign(_, _)
; Uinstr = mkframe(_, _)
; Uinstr = label(_)
; Uinstr = arbitrary_c_code(_, _, _)
; Uinstr = save_maxfr(_)
; Uinstr = restore_maxfr(_)
; Uinstr = incr_hp(_, _, _, _, _, _, _, _)
; Uinstr = mark_hp(_)
; Uinstr = restore_hp(_)
; Uinstr = free_heap(_)
; Uinstr = push_region_frame(_, _)
; Uinstr = region_fill_frame(_, _, _, _, _)
; Uinstr = region_set_fixed_slot(_, _, _)
; Uinstr = use_and_maybe_pop_region_frame(_, _)
; Uinstr = store_ticket(_)
; Uinstr = reset_ticket(_, _)
; Uinstr = discard_ticket
; Uinstr = prune_ticket
; Uinstr = mark_ticket_stack(_)
; Uinstr = prune_tickets_to(_)
; Uinstr = incr_sp(_, _, _)
; Uinstr = decr_sp(_)
; Uinstr = init_sync_term(_, _, _)
; Uinstr = fork_new_child(_, _)
; Uinstr = lc_create_loop_control(_, _)
; Uinstr = lc_wait_free_slot(_, _, _)
; Uinstr = lc_join_and_terminate(_, _)
),
CanBranchAway = no
;
( Uinstr = block(_, _, _)
; Uinstr = llcall(_, _, _, _, _, _)
; Uinstr = goto(_)
; Uinstr = computed_goto(_, _)
; Uinstr = if_val(_, _)
; Uinstr = decr_sp_and_return(_)
; Uinstr = join_and_continue(_, _)
; Uinstr = lc_spawn_off(_, _, _)
),
CanBranchAway = yes
;
Uinstr = foreign_proc_code(_, Comps, _, _, _, _, _, _, _, _),
CanBranchAway = can_components_branch_away(Comps)
).
:- func can_components_branch_away(list(foreign_proc_component)) = bool.
can_components_branch_away([]) = no.
can_components_branch_away([Component | Components]) = !:BranchAway :-
!:BranchAway = can_component_branch_away(Component),
(
!.BranchAway = yes
;
!.BranchAway = no,
!:BranchAway = can_components_branch_away(Components)
).
% The input and output components get expanded to straight line code.
% Some of the raw_code components we generate for nondet pragma C codes
% invoke succeed(), which definitely does branch away.
% Also the raw_code components for semidet pragma C codes can
% branch to a label on failure.
% User-written C code cannot branch away because users do not know
% how to do that. (They can call other functions, but those functions
% will return, so control will still go to the instruction following
% this one. We the developers could write C code that branched away,
% but we are careful to preserve a declarative interface, and that
% is incompatible with branching away.)
%
:- func can_component_branch_away(foreign_proc_component) = bool.
can_component_branch_away(foreign_proc_inputs(_)) = no.
can_component_branch_away(foreign_proc_outputs(_)) = no.
can_component_branch_away(foreign_proc_raw_code(CanBranchAway, _, _, _))
= CanBranchAwayBool :-
(
CanBranchAway = can_branch_away,
CanBranchAwayBool = yes
;
CanBranchAway = cannot_branch_away,
CanBranchAwayBool = no
).
can_component_branch_away(foreign_proc_user_code(_, _, _)) = no.
can_component_branch_away(foreign_proc_fail_to(_)) = yes.
can_component_branch_away(foreign_proc_alloc_id(_)) = no.
can_component_branch_away(foreign_proc_noop) = no.
can_instr_fall_through(comment(_)) = yes.
can_instr_fall_through(livevals(_)) = yes.
can_instr_fall_through(block(_, _, Instrs)) = FallThrough :-
can_block_fall_through(Instrs, FallThrough).
can_instr_fall_through(assign(_, _)) = yes.
can_instr_fall_through(keep_assign(_, _)) = yes.
can_instr_fall_through(llcall(_, _, _, _, _, _)) = no.
can_instr_fall_through(mkframe(_, _)) = yes.
can_instr_fall_through(label(_)) = yes.
can_instr_fall_through(goto(_)) = no.
can_instr_fall_through(computed_goto(_, _)) = no.
can_instr_fall_through(arbitrary_c_code(_, _, _)) = yes.
can_instr_fall_through(if_val(_, _)) = yes.
can_instr_fall_through(save_maxfr(_)) = yes.
can_instr_fall_through(restore_maxfr(_)) = yes.
can_instr_fall_through(incr_hp(_, _, _, _, _, _, _, _)) = yes.
can_instr_fall_through(mark_hp(_)) = yes.
can_instr_fall_through(restore_hp(_)) = yes.
can_instr_fall_through(free_heap(_)) = yes.
can_instr_fall_through(push_region_frame(_, _)) = yes.
can_instr_fall_through(region_fill_frame(_, _, _, _, _)) = yes.
can_instr_fall_through(region_set_fixed_slot(_, _, _)) = yes.
can_instr_fall_through(use_and_maybe_pop_region_frame(_, _)) = yes.
can_instr_fall_through(store_ticket(_)) = yes.
can_instr_fall_through(reset_ticket(_, _)) = yes.
can_instr_fall_through(discard_ticket) = yes.
can_instr_fall_through(prune_ticket) = yes.
can_instr_fall_through(mark_ticket_stack(_)) = yes.
can_instr_fall_through(prune_tickets_to(_)) = yes.
can_instr_fall_through(incr_sp(_, _, _)) = yes.
can_instr_fall_through(decr_sp(_)) = yes.
can_instr_fall_through(decr_sp_and_return(_)) = no.
can_instr_fall_through(foreign_proc_code(_, _, _, _, _, _, _, _, _, _)) = yes.
can_instr_fall_through(init_sync_term(_, _, _)) = yes.
can_instr_fall_through(fork_new_child(_, _)) = yes.
can_instr_fall_through(join_and_continue(_, _)) = no.
can_instr_fall_through(lc_create_loop_control(_, _)) = yes.
can_instr_fall_through(lc_wait_free_slot(_, _, _)) = yes.
can_instr_fall_through(lc_spawn_off(_, _, _)) = yes.
can_instr_fall_through(lc_join_and_terminate(_, _)) = no.
% Check whether an instruction sequence can possibly fall through
% to the next instruction without using its label.
%
:- pred can_block_fall_through(list(instruction)::in, bool::out) is det.
can_block_fall_through([], yes).
can_block_fall_through([llds_instr(Uinstr, _) | Instrs], FallThrough) :-
( if can_instr_fall_through(Uinstr) = no then
FallThrough = no
else
can_block_fall_through(Instrs, FallThrough)
).
:- pred can_use_livevals(instr::in, bool::out) is det.
can_use_livevals(comment(_), no).
can_use_livevals(livevals(_), no).
can_use_livevals(block(_, _, _), no).
can_use_livevals(assign(_, _), no).
can_use_livevals(keep_assign(_, _), no).
can_use_livevals(llcall(_, _, _, _, _, _), yes).
can_use_livevals(mkframe(_, _), no).
can_use_livevals(label(_), no).
can_use_livevals(goto(_), yes).
can_use_livevals(computed_goto(_, _), no).
can_use_livevals(arbitrary_c_code(_, _, _), no).
can_use_livevals(if_val(_, _), yes).
can_use_livevals(save_maxfr(_), no).
can_use_livevals(restore_maxfr(_), no).
can_use_livevals(incr_hp(_, _, _, _, _, _, _, _), no).
can_use_livevals(mark_hp(_), no).
can_use_livevals(restore_hp(_), no).
can_use_livevals(free_heap(_), no).
can_use_livevals(push_region_frame(_, _), no).
can_use_livevals(region_fill_frame(_, _, _, _, _), no).
can_use_livevals(region_set_fixed_slot(_, _, _), no).
can_use_livevals(use_and_maybe_pop_region_frame(_, _), no).
can_use_livevals(store_ticket(_), no).
can_use_livevals(reset_ticket(_, _), no).
can_use_livevals(discard_ticket, no).
can_use_livevals(prune_ticket, no).
can_use_livevals(mark_ticket_stack(_), no).
can_use_livevals(prune_tickets_to(_), no).
can_use_livevals(incr_sp(_, _, _), no).
can_use_livevals(decr_sp(_), no).
can_use_livevals(decr_sp_and_return(_), yes).
can_use_livevals(foreign_proc_code(_, _, _, _, _, _, _, _, _, _), no).
can_use_livevals(init_sync_term(_, _, _), no).
can_use_livevals(fork_new_child(_, _), no).
can_use_livevals(join_and_continue(_, _), no).
can_use_livevals(lc_create_loop_control(_, _), no).
can_use_livevals(lc_wait_free_slot(_, _, _), no).
can_use_livevals(lc_spawn_off(_, _, _), yes).
can_use_livevals(lc_join_and_terminate(_, _), no).
instr_labels(Instr, Labels, CodeAddrs) :-
instr_labels_2(Instr, Labels0, CodeAddrs1),
instr_rvals_and_lvals(Instr, Rvals, Lvals),
exprn_aux.rval_list_addrs(to_sorted_list(Rvals), CodeAddrs2, _),
exprn_aux.lval_list_addrs(to_sorted_list(Lvals), CodeAddrs3, _),
CodeAddrs = CodeAddrs1 ++ CodeAddrs2 ++ CodeAddrs3,
find_label_code_addrs(CodeAddrs, Labels0, Labels).
instr_labels_only(Instr, Labels) :-
instr_labels(Instr, Labels, _CodeAddrs).
% Determine all the labels and code_addresses that are directly referenced
% by an instruction (not counting ones referenced indirectly via rvals or
% lvals).
%
:- pred instr_labels_2(instr::in, list(label)::out, list(code_addr)::out)
is det.
instr_labels_2(Uinstr, Labels, CodeAddrs) :-
(
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = assign(_,_)
; Uinstr = keep_assign(_,_)
; Uinstr = mkframe(_, no)
; Uinstr = label(_)
; Uinstr = arbitrary_c_code(_, _, _)
; Uinstr = save_maxfr(_)
; Uinstr = restore_maxfr(_)
; Uinstr = incr_hp(_, _, _, _, _, _, _, _)
; Uinstr = mark_hp(_)
; Uinstr = restore_hp(_)
; Uinstr = free_heap(_)
; Uinstr = push_region_frame(_, _)
; Uinstr = region_fill_frame(_, _, _, _, _)
; Uinstr = region_set_fixed_slot(_, _, _)
; Uinstr = use_and_maybe_pop_region_frame(_, _)
; Uinstr = store_ticket(_)
; Uinstr = reset_ticket(_, _)
; Uinstr = discard_ticket
; Uinstr = prune_ticket
; Uinstr = mark_ticket_stack(_)
; Uinstr = prune_tickets_to(_)
; Uinstr = incr_sp(_, _, _)
; Uinstr = decr_sp(_)
; Uinstr = init_sync_term(_, _, _)
; Uinstr = lc_create_loop_control(_, _)
; Uinstr = lc_join_and_terminate(_, _)
),
Labels = [],
CodeAddrs = []
;
Uinstr = llcall(Target, Ret, _, _, _, _),
Labels = [],
CodeAddrs = [Target, Ret]
;
( Uinstr = mkframe(_, yes(Addr))
; Uinstr = goto(Addr)
; Uinstr = if_val(_, Addr)
),
Labels = [],
CodeAddrs = [Addr]
;
Uinstr = decr_sp_and_return(_),
% XXX decr_sp_and_return does refer to a code addr, but the code addr
% it refers to is the original succip (now in a stack slot), which is
% not necessarily the current succip. However, we introduce
% decr_sp_and_return so late that this predicate should never be
% invoked on such instructions.
unexpected($module, $pred, "decr_sp_and_return")
;
Uinstr = fork_new_child(_, Child),
Labels = [Child],
CodeAddrs = []
;
( Uinstr = join_and_continue(_, Label)
; Uinstr = lc_wait_free_slot(_, _, Label)
; Uinstr = lc_spawn_off(_, _, Label)
),
Labels = [Label],
CodeAddrs = []
;
Uinstr = block(_, _, Instrs),
instr_list_labels(Instrs, Labels, CodeAddrs)
;
Uinstr = computed_goto(_, MaybeLabels),
possible_targets_maybe_labels(MaybeLabels, [], RevLabels),
list.reverse(RevLabels, Labels),
CodeAddrs = []
;
Uinstr = foreign_proc_code(_, _, _, MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, MaybeDefLabel, _, _),
foreign_proc_labels(MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, MaybeDefLabel, Labels),
CodeAddrs = []
).
% Find out which code addresses are also labels.
%
:- pred find_label_code_addrs(list(code_addr)::in,
list(label)::in, list(label)::out) is det.
find_label_code_addrs([], Labels, Labels).
find_label_code_addrs([CodeAddr | Rest], Labels0, Labels) :-
( if CodeAddr = code_label(Label) then
Labels1 = [Label | Labels0]
else
Labels1 = Labels0
),
find_label_code_addrs(Rest, Labels1, Labels).
possible_targets(Uinstr, Labels, CodeAddrs) :-
(
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = assign(_,_)
; Uinstr = keep_assign(_,_)
; Uinstr = mkframe(_, _)
; Uinstr = label(_)
; Uinstr = arbitrary_c_code(_, _, _)
; Uinstr = save_maxfr(_)
; Uinstr = restore_maxfr(_)
; Uinstr = incr_hp(_, _, _, _, _, _, _, _)
; Uinstr = mark_hp(_)
; Uinstr = restore_hp(_)
; Uinstr = free_heap(_)
; Uinstr = push_region_frame(_, _)
; Uinstr = region_fill_frame(_, _, _, _, _)
; Uinstr = region_set_fixed_slot(_, _, _)
; Uinstr = use_and_maybe_pop_region_frame(_, _)
; Uinstr = store_ticket(_)
; Uinstr = reset_ticket(_, _)
; Uinstr = discard_ticket
; Uinstr = prune_ticket
; Uinstr = mark_ticket_stack(_)
; Uinstr = prune_tickets_to(_)
; Uinstr = incr_sp(_, _, _)
; Uinstr = decr_sp(_)
; Uinstr = init_sync_term(_, _, _)
; Uinstr = fork_new_child(_, _)
; Uinstr = lc_create_loop_control(_, _)
; Uinstr = lc_join_and_terminate(_, _)
; Uinstr = lc_wait_free_slot(_, _, _Label)
% The label in an lc_wait_free_slot instruction is NOT the possible
% target of a branch.
),
Labels = [],
CodeAddrs = []
;
Uinstr = llcall(_, Return, _, _, _, _),
( if Return = code_label(ReturnLabel) then
Labels = [ReturnLabel],
CodeAddrs = []
else
Labels = [],
CodeAddrs = [Return]
)
;
( Uinstr = goto(CodeAddr)
; Uinstr = if_val(_, CodeAddr)
),
( if CodeAddr = code_label(Label) then
Labels = [Label],
CodeAddrs = []
else
Labels = [],
CodeAddrs = [CodeAddr]
)
;
Uinstr = decr_sp_and_return(_),
% XXX see the comment in instr_labels_2.
unexpected($module, $pred, "decr_sp_and_return")
;
( Uinstr = join_and_continue(_, Label)
; Uinstr = lc_spawn_off(_, _, Label)
),
Labels = [Label],
CodeAddrs = []
;
Uinstr = block(_, _, _),
unexpected($module, $pred, "block")
;
Uinstr = computed_goto(_, MaybeLabels),
possible_targets_maybe_labels(MaybeLabels, [], RevLabels),
list.reverse(RevLabels, Labels),
CodeAddrs = []
;
Uinstr = foreign_proc_code(_, _, _, MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, MaybeDefLabel, _, _),
foreign_proc_labels(MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, MaybeDefLabel, Labels),
CodeAddrs = []
).
:- pred possible_targets_maybe_labels(list(maybe(label))::in,
list(label)::in, list(label)::out) is det.
possible_targets_maybe_labels([], !RevLabels).
possible_targets_maybe_labels([MaybeLabel | MaybeLabels], !RevLabels) :-
(
MaybeLabel = yes(Label),
!:RevLabels = [Label | !.RevLabels]
;
MaybeLabel = no
),
possible_targets_maybe_labels(MaybeLabels, !RevLabels).
:- pred foreign_proc_labels(maybe(label)::in, maybe(label)::in,
maybe(label)::in, maybe(label)::in, maybe(label)::in, list(label)::out)
is det.
foreign_proc_labels(MaybeFixedLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, MaybeDefLabel, !:Labels) :-
!:Labels = [],
(
MaybeFixedLabel = yes(FixedLabel),
!:Labels = [FixedLabel | !.Labels]
;
MaybeFixedLabel = no
),
(
MaybeLayoutLabel = yes(LayoutLabel),
!:Labels = [LayoutLabel | !.Labels]
;
MaybeLayoutLabel = no
),
(
MaybeOnlyLayoutLabel = yes(OnlyLayoutLabel),
!:Labels = [OnlyLayoutLabel | !.Labels]
;
MaybeOnlyLayoutLabel = no
),
(
MaybeSubLabel = yes(SubLabel),
!:Labels = [SubLabel | !.Labels]
;
MaybeSubLabel = no
),
(
MaybeDefLabel = yes(DefLabel),
!:Labels = [DefLabel | !.Labels]
;
MaybeDefLabel = no
).
% Determine all the labels and code addresses which are referenced
% by a list of instructions.
%
:- pred instr_list_labels(list(instruction)::in,
list(label)::out, list(code_addr)::out) is det.
instr_list_labels([], [], []).
instr_list_labels([llds_instr(Uinstr, _) | Instrs], Labels, CodeAddrs) :-
instr_labels(Uinstr, HeadLabels, HeadCodeAddrs),
instr_list_labels(Instrs, TailLabels, TailCodeAddrs),
Labels = HeadLabels ++ TailLabels,
CodeAddrs = HeadCodeAddrs ++ TailCodeAddrs.
livevals_addr(code_label(Label)) = Result :-
(
Label = internal_label(_, _),
Result = no
;
Label = entry_label(_, _),
Result = yes
).
livevals_addr(code_imported_proc(_)) = yes.
livevals_addr(code_succip) = yes.
livevals_addr(do_succeed(_)) = yes.
livevals_addr(do_redo) = no.
livevals_addr(do_fail) = no.
livevals_addr(do_trace_redo_fail_shallow) = no.
livevals_addr(do_trace_redo_fail_deep) = no.
livevals_addr(do_call_closure(_)) = yes.
livevals_addr(do_call_class_method(_)) = yes.
livevals_addr(do_not_reached) = no.
count_temps_instr_list([], !R, !F).
count_temps_instr_list([llds_instr(Uinstr, _Comment) | Instrs], !R, !F) :-
count_temps_instr(Uinstr, !R, !F),
count_temps_instr_list(Instrs, !R, !F).
count_temps_instr(comment(_), !R, !F).
count_temps_instr(livevals(_), !R, !F).
count_temps_instr(block(_, _, _), !R, !F).
count_temps_instr(assign(Lval, Rval), !R, !F) :-
count_temps_lval(Lval, !R, !F),
count_temps_rval(Rval, !R, !F).
count_temps_instr(keep_assign(Lval, Rval), !R, !F) :-
count_temps_lval(Lval, !R, !F),
count_temps_rval(Rval, !R, !F).
count_temps_instr(llcall(_, _, _, _, _, _), !R, !F).
count_temps_instr(mkframe(_, _), !R, !F).
count_temps_instr(label(_), !R, !F).
count_temps_instr(goto(_), !R, !F).
count_temps_instr(computed_goto(Rval, _), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(if_val(Rval, _), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(arbitrary_c_code(_, _, _), !R, !F).
count_temps_instr(save_maxfr(Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(restore_maxfr(Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(incr_hp(Lval, _, _, Rval, _, _, MaybeRegionRval,
MaybeReuse), !R, !F) :-
count_temps_lval(Lval, !R, !F),
count_temps_rval(Rval, !R, !F),
(
MaybeRegionRval = yes(RegionRval),
count_temps_rval(RegionRval, !R, !F)
;
MaybeRegionRval = no
),
(
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval),
count_temps_rval(ReuseRval, !R, !F),
(
MaybeFlagLval = yes(FlagLval),
count_temps_lval(FlagLval, !R, !F)
;
MaybeFlagLval = no
)
;
MaybeReuse = no_llds_reuse
).
count_temps_instr(mark_hp(Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(restore_hp(Rval), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(free_heap(Rval), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(push_region_frame(_StackId, _EmbeddedStackFrame), !R, !F).
count_temps_instr(region_fill_frame(_FillOp, _EmbeddedStackFrame, IdRval,
NumLval, AddrLval), !R, !F) :-
count_temps_rval(IdRval, !R, !F),
count_temps_lval(NumLval, !R, !F),
count_temps_lval(AddrLval, !R, !F).
count_temps_instr(region_set_fixed_slot(_SetlOp, _EmbeddedStackFrame,
ValueRval), !R, !F) :-
count_temps_rval(ValueRval, !R, !F).
count_temps_instr(use_and_maybe_pop_region_frame(_UseOp, _EmbeddedStackFrame),
!R, !F).
count_temps_instr(store_ticket(Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(reset_ticket(Rval, _Reason), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(discard_ticket, !R, !F).
count_temps_instr(prune_ticket, !R, !F).
count_temps_instr(mark_ticket_stack(Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(prune_tickets_to(Rval), !R, !F) :-
count_temps_rval(Rval, !R, !F).
count_temps_instr(incr_sp(_, _, _), !R, !F).
count_temps_instr(decr_sp(_), !R, !F).
count_temps_instr(decr_sp_and_return(_), !R, !F).
count_temps_instr(foreign_proc_code(_, Comps, _, _, _, _, _, _, _, _),
!R, !F) :-
count_temps_components(Comps, !R, !F).
count_temps_instr(init_sync_term(Lval, _, _), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(fork_new_child(Lval, _), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(join_and_continue(Lval, _), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(lc_create_loop_control(_, Lval), !R, !F) :-
count_temps_lval(Lval, !R, !F).
count_temps_instr(lc_wait_free_slot(Rval, Lval, _), !R, !F) :-
count_temps_rval(Rval, !R, !F),
count_temps_lval(Lval, !R, !F).
count_temps_instr(lc_spawn_off(LCRval, LCSRval, _), !R, !F) :-
count_temps_rval(LCRval, !R, !F),
count_temps_rval(LCSRval, !R, !F).
count_temps_instr(lc_join_and_terminate(LCRval, LCSRval), !R, !F) :-
count_temps_rval(LCRval, !R, !F),
count_temps_rval(LCSRval, !R, !F).
:- pred count_temps_components(list(foreign_proc_component)::in,
int::in, int::out, int::in, int::out) is det.
count_temps_components([], !R, !F).
count_temps_components([Comp | Comps], !R, !F) :-
count_temps_component(Comp, !R, !F),
count_temps_components(Comps, !R, !F).
:- pred count_temps_component(foreign_proc_component::in,
int::in, int::out, int::in, int::out) is det.
count_temps_component(Comp, !R, !F) :-
(
Comp = foreign_proc_inputs(Inputs),
count_temps_inputs(Inputs, !R, !F)
;
Comp = foreign_proc_outputs(Outputs),
count_temps_outputs(Outputs, !R, !F)
;
Comp = foreign_proc_user_code(_, _, _)
;
Comp = foreign_proc_raw_code(_, _, _, _)
;
Comp = foreign_proc_fail_to(_)
;
Comp = foreign_proc_alloc_id(_)
;
Comp = foreign_proc_noop
).
:- pred count_temps_inputs(list(foreign_proc_input)::in,
int::in, int::out, int::in, int::out) is det.
count_temps_inputs([], !R, !F).
count_temps_inputs([Input | Inputs], !R, !F) :-
Input = foreign_proc_input(_VarName, _VarType, _IsDummy, _OrigType,
ArgRval, _MaybeForeignType, _BoxPolicy),
count_temps_rval(ArgRval, !R, !F),
count_temps_inputs(Inputs, !R, !F).
:- pred count_temps_outputs(list(foreign_proc_output)::in,
int::in, int::out, int::in, int::out) is det.
count_temps_outputs([], !R, !F).
count_temps_outputs([Output | Outputs], !R, !F) :-
Output = foreign_proc_output(DestLval, _VarType, _IsDummy, _OrigType,
_VarName, _MaybeForeignType, _BoxPolicy),
count_temps_lval(DestLval, !R, !F),
count_temps_outputs(Outputs, !R, !F).
:- pred count_temps_lval(lval::in, int::in, int::out, int::in, int::out)
is det.
count_temps_lval(Lval, !R, !F) :-
(
( Lval = reg(_, _)
; Lval = succip
; Lval = maxfr
; Lval = curfr
; Lval = hp
; Lval = sp
; Lval = parent_sp
; Lval = stackvar(_)
; Lval = framevar(_)
; Lval = parent_stackvar(_)
; Lval = double_stackvar(_, _)
; Lval = global_var_ref(_)
)
;
Lval = temp(reg_r, N),
int.max(N, !R)
;
Lval = temp(reg_f, N),
int.max(N, !F)
;
Lval = field(_, BaseAddrRval, FieldNumRval),
count_temps_rval(BaseAddrRval, !R, !F),
count_temps_rval(FieldNumRval, !R, !F)
;
( Lval = succip_slot(Rval)
; Lval = succfr_slot(Rval)
; Lval = redoip_slot(Rval)
; Lval = redofr_slot(Rval)
; Lval = prevfr_slot(Rval)
; Lval = mem_ref(Rval)
),
count_temps_rval(Rval, !R, !F)
;
Lval = lvar(_),
unexpected($module, $pred, "lvar")
).
:- pred count_temps_rval(rval::in, int::in, int::out, int::in, int::out)
is det.
count_temps_rval(Rval, !R, !F) :-
(
Rval = lval(Lval),
count_temps_lval(Lval, !R, !F)
;
Rval = var(_),
unexpected($module, $pred, "var")
;
Rval = mkword(_Tag, SubRval),
count_temps_rval(SubRval, !R, !F)
;
Rval = mkword_hole(_Tag)
;
Rval = const(_Const)
;
Rval = unop(_Unop, SubRvalA),
count_temps_rval(SubRvalA, !R, !F)
;
Rval = binop(_Binop, SubRvalA, SubRvalB),
count_temps_rval(SubRvalA, !R, !F),
count_temps_rval(SubRvalB, !R, !F)
;
Rval = mem_addr(MemRef),
count_temps_mem_ref(MemRef, !R, !F)
).
:- pred count_temps_mem_ref(mem_ref::in, int::in, int::out, int::in, int::out)
is det.
count_temps_mem_ref(MemRef, !R, !F) :-
(
( MemRef = stackvar_ref(Rval)
; MemRef = framevar_ref(Rval)
),
count_temps_rval(Rval, !R, !F)
;
MemRef = heap_ref(CellRval, _MaybeTag, FieldNumRval),
count_temps_rval(CellRval, !R, !F),
count_temps_rval(FieldNumRval, !R, !F)
).
format_label(internal_label(_, ProcLabel)) = format_proc_label(ProcLabel).
format_label(entry_label(_, ProcLabel)) = format_proc_label(ProcLabel).
format_proc_label(ordinary_proc_label(_Module, _PredOrFunc, _, Name,
Arity, Mode)) =
Name ++ "/" ++ int_to_string(Arity) ++ " mode " ++ int_to_string(Mode).
format_proc_label(special_proc_label(_Module, SpecialPredId, TypeModule,
TypeName, TypeArity, Mode)) =
PredName ++ "_" ++ TypeName ++ "/" ++ int_to_string(TypeArity)
++ " mode " ++ int_to_string(Mode) :-
TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
PredName = special_pred_name(SpecialPredId, TypeCtor).
has_both_incr_decr_sp(Instrs) :-
has_both_incr_decr_sp_2(Instrs, no, yes, no, yes).
:- pred has_both_incr_decr_sp_2(list(instruction)::in,
bool::in, bool::out, bool::in, bool::out) is det.
has_both_incr_decr_sp_2([], !HasIncr, !HasDecr).
has_both_incr_decr_sp_2([llds_instr(Uinstr, _) | Instrs],
!HasIncr, !HasDecr) :-
( if Uinstr = incr_sp(_, _, _) then
!:HasIncr = yes
else
true
),
( if Uinstr = decr_sp(_) then
!:HasDecr = yes
else
true
),
has_both_incr_decr_sp_2(Instrs, !HasIncr, !HasDecr).
touches_nondet_ctrl([]) = no.
touches_nondet_ctrl([llds_instr(Uinstr, _) | Instrs]) = !:Touch :-
!:Touch = touches_nondet_ctrl_instr(Uinstr),
(
!.Touch = yes
;
!.Touch = no,
!:Touch = touches_nondet_ctrl(Instrs)
).
:- func touches_nondet_ctrl_instr(instr) = bool.
touches_nondet_ctrl_instr(Uinstr) = Touch :-
(
( Uinstr = comment(_)
; Uinstr = livevals(_)
; Uinstr = label(_)
; Uinstr = prune_ticket
; Uinstr = discard_ticket
; Uinstr = incr_sp(_, _, _)
; Uinstr = decr_sp(_)
; Uinstr = decr_sp_and_return(_)
; Uinstr = push_region_frame(_, _)
; Uinstr = use_and_maybe_pop_region_frame(_, _)
),
Touch = no
;
( Uinstr = mkframe(_, _)
; Uinstr = goto(_)
; Uinstr = computed_goto(_, _)
; Uinstr = llcall(_, _, _, _, _, _) % This is a safe approximation.
; Uinstr = if_val(_, _)
; Uinstr = arbitrary_c_code(_, _, _)
; Uinstr = save_maxfr(_)
; Uinstr = restore_maxfr(_)
; Uinstr = init_sync_term(_, _, _) % This is a safe approximation.
; Uinstr = fork_new_child(_, _) % This is a safe approximation.
; Uinstr = join_and_continue(_, _) % This is a safe approximation.
),
Touch = yes
;
( Uinstr = mark_hp(Lval)
; Uinstr = store_ticket(Lval)
; Uinstr = mark_ticket_stack(Lval)
; Uinstr = lc_create_loop_control(_, Lval)
),
Touch = touches_nondet_ctrl_lval(Lval)
;
( Uinstr = restore_hp(Rval)
; Uinstr = free_heap(Rval)
; Uinstr = region_set_fixed_slot(_SetOp, _EmbeddedStackFrame, Rval)
; Uinstr = reset_ticket(Rval, _)
; Uinstr = prune_tickets_to(Rval)
),
Touch = touches_nondet_ctrl_rval(Rval)
;
( Uinstr = assign(Lval, Rval)
; Uinstr = keep_assign(Lval, Rval)
; Uinstr = lc_wait_free_slot(Rval, Lval, _)
),
TouchLval = touches_nondet_ctrl_lval(Lval),
TouchRval = touches_nondet_ctrl_rval(Rval),
bool.or(TouchLval, TouchRval, Touch)
;
( Uinstr = lc_spawn_off(LCRval, LCSRval, _)
; Uinstr = lc_join_and_terminate(LCRval, LCSRval)
),
TouchLC = touches_nondet_ctrl_rval(LCRval),
TouchLCS = touches_nondet_ctrl_rval(LCSRval),
bool.or(TouchLC, TouchLCS, Touch)
;
Uinstr = block(_, _, _),
% Blocks aren't introduced until after the last user of this predicate.
unexpected($module, $pred, "block")
;
Uinstr = incr_hp(Lval, _, _, Rval, _, _, MaybeRegionRval,
MaybeReuse),
some [!Touch] (
!:Touch = bool.or(
touches_nondet_ctrl_lval(Lval),
touches_nondet_ctrl_rval(Rval)),
(
MaybeRegionRval = yes(RegionRval),
bool.or(touches_nondet_ctrl_rval(RegionRval), !Touch)
;
MaybeRegionRval = no
),
(
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval),
bool.or(touches_nondet_ctrl_rval(ReuseRval), !Touch),
(
MaybeFlagLval = yes(FlagLval),
bool.or(touches_nondet_ctrl_lval(FlagLval), !Touch)
;
MaybeFlagLval = no
)
;
MaybeReuse = no_llds_reuse
),
Touch = !.Touch
)
;
Uinstr = region_fill_frame(_FillOp, _EmbeddedStackFrame, IdRval,
NumLval, AddrLval),
Touch = bool.or(
touches_nondet_ctrl_rval(IdRval),
bool.or(
touches_nondet_ctrl_lval(NumLval),
touches_nondet_ctrl_lval(AddrLval)))
;
Uinstr = foreign_proc_code(_, Components, _, _, _, _, _, _, _, _),
Touch = touches_nondet_ctrl_components(Components)
).
:- func touches_nondet_ctrl_lval(lval) = bool.
touches_nondet_ctrl_lval(reg(_, _)) = no.
touches_nondet_ctrl_lval(stackvar(_)) = no.
touches_nondet_ctrl_lval(parent_stackvar(_)) = no.
touches_nondet_ctrl_lval(framevar(_)) = no.
touches_nondet_ctrl_lval(double_stackvar(_, _)) = no.
touches_nondet_ctrl_lval(succip) = no.
touches_nondet_ctrl_lval(maxfr) = yes.
touches_nondet_ctrl_lval(curfr) = 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(parent_sp) = no.
touches_nondet_ctrl_lval(field(_, Rval1, Rval2)) = Touch :-
Touch1 = touches_nondet_ctrl_rval(Rval1),
Touch2 = touches_nondet_ctrl_rval(Rval2),
bool.or(Touch1, Touch2, Touch).
touches_nondet_ctrl_lval(lvar(_)) = no.
touches_nondet_ctrl_lval(temp(_, _)) = no.
touches_nondet_ctrl_lval(mem_ref(Rval)) =
touches_nondet_ctrl_rval(Rval).
touches_nondet_ctrl_lval(global_var_ref(_)) = no.
:- func touches_nondet_ctrl_rval(rval) = bool.
touches_nondet_ctrl_rval(lval(Lval)) =
touches_nondet_ctrl_lval(Lval).
touches_nondet_ctrl_rval(var(_)) = no.
touches_nondet_ctrl_rval(mkword(_, Rval)) =
touches_nondet_ctrl_rval(Rval).
touches_nondet_ctrl_rval(mkword_hole(_)) = no.
touches_nondet_ctrl_rval(const(_)) = no.
touches_nondet_ctrl_rval(unop(_, Rval)) =
touches_nondet_ctrl_rval(Rval).
touches_nondet_ctrl_rval(binop(_, Rval1, Rval2)) = Touch :-
Touch1 = touches_nondet_ctrl_rval(Rval1),
Touch2 = touches_nondet_ctrl_rval(Rval2),
bool.or(Touch1, Touch2, Touch).
touches_nondet_ctrl_rval(mem_addr(MemRef)) =
touches_nondet_ctrl_mem_ref(MemRef).
:- func touches_nondet_ctrl_mem_ref(mem_ref) = bool.
touches_nondet_ctrl_mem_ref(stackvar_ref(_)) = no.
touches_nondet_ctrl_mem_ref(framevar_ref(_)) = no.
touches_nondet_ctrl_mem_ref(heap_ref(Rval, _, _)) =
touches_nondet_ctrl_rval(Rval).
:- func touches_nondet_ctrl_components(list(foreign_proc_component)) = bool.
touches_nondet_ctrl_components([]) = no.
touches_nondet_ctrl_components([Comp | Comps]) = Touch :-
Touch1 = touches_nondet_ctrl_component(Comp),
Touch2 = touches_nondet_ctrl_components(Comps),
bool.or(Touch1, Touch2, Touch).
% The inputs and outputs components get emitted as simple straight-line
% code that do not refer to control slots. The compiler does not generate
% raw_code that refers to control slots. User code shouldn't either, but
% until we have prohibited the use of ordinary pragma C codes for model_non
% procedures, some user code will need to ignore this restriction.
%
:- func touches_nondet_ctrl_component(foreign_proc_component) = bool.
touches_nondet_ctrl_component(foreign_proc_inputs(_)) = no.
touches_nondet_ctrl_component(foreign_proc_outputs(_)) = no.
touches_nondet_ctrl_component(foreign_proc_raw_code(_, _, _, _)) = no.
touches_nondet_ctrl_component(foreign_proc_user_code(_, _, _)) = yes.
touches_nondet_ctrl_component(foreign_proc_fail_to(_)) = no.
touches_nondet_ctrl_component(foreign_proc_alloc_id(_)) = no.
touches_nondet_ctrl_component(foreign_proc_noop) = no.
%-----------------------------------------------------------------------------%
lval_access_rvals(reg(_, _), []).
lval_access_rvals(stackvar(_), []).
lval_access_rvals(parent_stackvar(_), []).
lval_access_rvals(framevar(_), []).
lval_access_rvals(double_stackvar(_, _), []).
lval_access_rvals(succip, []).
lval_access_rvals(maxfr, []).
lval_access_rvals(curfr, []).
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(parent_sp, []).
lval_access_rvals(field(_, Rval1, Rval2), [Rval1, Rval2]).
lval_access_rvals(temp(_, _), []).
lval_access_rvals(lvar(_), _) :-
unexpected($module, $pred, "lvar").
lval_access_rvals(mem_ref(Rval), [Rval]).
lval_access_rvals(global_var_ref(_), []).
%-----------------------------------------------------------------------------%
count_incr_hp(Instrs, N) :-
count_incr_hp_2(Instrs, 0, N).
:- pred count_incr_hp_2(list(instruction)::in, int::in, int::out) is det.
count_incr_hp_2([], !N).
count_incr_hp_2([llds_instr(Uinstr0, _) | Instrs], !N) :-
( if Uinstr0 = incr_hp(_, _, _, _, _, _, _, _) then
!:N = !.N + 1
else
true
),
count_incr_hp_2(Instrs, !N).
%-----------------------------------------------------------------------------%
propagate_livevals(Instrs0, Instrs) :-
list.reverse(Instrs0, RevInstrs0),
set.init(Livevals),
propagate_livevals_2(RevInstrs0, Livevals, RevInstrs),
list.reverse(RevInstrs, Instrs).
:- pred propagate_livevals_2(list(instruction)::in, set(lval)::in,
list(instruction)::out) is det.
propagate_livevals_2([], _, []).
propagate_livevals_2([Instr0 | Instrs0], Livevals0,
[Instr | Instrs]) :-
Instr0 = llds_instr(Uinstr0, Comment),
( if Uinstr0 = livevals(ThisLivevals) then
set.union(Livevals0, ThisLivevals, Livevals),
Instr = llds_instr(livevals(Livevals), Comment)
else
Instr = Instr0,
( if Uinstr0 = assign(Lval, _) then
set.delete(Lval, Livevals0, Livevals)
else if can_instr_fall_through(Uinstr0) = no then
set.init(Livevals)
else
Livevals = Livevals0
)
),
propagate_livevals_2(Instrs0, Livevals, Instrs).
%-----------------------------------------------------------------------------%
%
% The code in this section is concerned with replacing all references
% to one given label with a reference to another given label.
replace_labels_instruction_list([], [], _, _, _).
replace_labels_instruction_list([Instr0 | Instrs0], [Instr | Instrs],
ReplMap, ReplData, ReplLabel) :-
( if
Instr0 = llds_instr(label(InstrLabel), Comment),
ReplLabel = yes
then
replace_labels_label(InstrLabel, ReplInstrLabel, ReplMap),
Instr = llds_instr(label(ReplInstrLabel), Comment)
else
replace_labels_instruction(Instr0, Instr, ReplMap, ReplData)
),
replace_labels_instruction_list(Instrs0, Instrs,
ReplMap, ReplData, ReplLabel).
replace_labels_instruction(Instr0, Instr, ReplMap, ReplData) :-
Instr0 = llds_instr(Uinstr0, Comment),
replace_labels_instr(Uinstr0, Uinstr, ReplMap, ReplData),
Instr = llds_instr(Uinstr, Comment).
replace_labels_instr(Uinstr0, Uinstr, ReplMap, ReplData) :-
(
( Uinstr0 = comment(_)
; Uinstr0 = livevals(_)
; Uinstr0 = discard_ticket
; Uinstr0 = prune_ticket
; Uinstr0 = incr_sp(_, _, _)
; Uinstr0 = decr_sp(_)
; Uinstr0 = decr_sp_and_return(_)
),
Uinstr = Uinstr0
;
Uinstr0 = block(R, F, Instrs0),
% There should be no labels in Instrs0.
replace_labels_instruction_list(Instrs0, Instrs,
ReplMap, ReplData, no),
Uinstr = block(R, F, Instrs)
;
Uinstr0 = assign(Lval0, Rval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Lval = Lval0,
Rval = Rval0
),
Uinstr = assign(Lval, Rval)
;
Uinstr0 = keep_assign(Lval0, Rval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Lval = Lval0,
Rval = Rval0
),
Uinstr = keep_assign(Lval, Rval)
;
Uinstr0 = llcall(Target, Return0, LiveInfo, CXT, GP, CM),
replace_labels_code_addr(Return0, Return, ReplMap),
Uinstr = llcall(Target, Return, LiveInfo, CXT, GP, CM)
;
Uinstr0 = mkframe(NondetFrameInfo, MaybeRedoip0),
(
ReplData = yes,
(
MaybeRedoip0 = yes(Redoip0),
replace_labels_code_addr(Redoip0, Redoip, ReplMap),
MaybeRedoip = yes(Redoip)
;
MaybeRedoip0 = no,
MaybeRedoip = no
)
;
ReplData = no,
MaybeRedoip = MaybeRedoip0
),
Uinstr = mkframe(NondetFrameInfo, MaybeRedoip)
;
Uinstr0 = label(Label),
( if map.search(ReplMap, Label, _) then
% The reason why we are replacing references to this label is that
% it is being eliminated, and in fact should have been already
% eliminated by the time replace_labels_instr is called.
unexpected($module, $pred, "eliminated label")
else
true
),
Uinstr = label(Label)
;
Uinstr0 = goto(Target0),
replace_labels_code_addr(Target0, Target, ReplMap),
Uinstr = goto(Target)
;
Uinstr0 = computed_goto(Rval0, MaybeLabels0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
replace_labels_maybe_label_list(MaybeLabels0, MaybeLabels, ReplMap),
Uinstr = computed_goto(Rval, MaybeLabels)
;
Uinstr0 = arbitrary_c_code(AffectsLiveness, Lvals0, Code),
(
ReplData = yes,
replace_labels_c_code_live_lvals(Lvals0, Lvals, ReplMap)
;
ReplData = no,
Lvals = Lvals0
),
Uinstr = arbitrary_c_code(AffectsLiveness, Lvals, Code)
;
Uinstr0 = if_val(Rval0, Target0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
replace_labels_code_addr(Target0, Target, ReplMap),
Uinstr = if_val(Rval, Target)
;
Uinstr0 = save_maxfr(Lval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = save_maxfr(Lval)
;
Uinstr0 = restore_maxfr(Lval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = restore_maxfr(Lval)
;
Uinstr0 = incr_hp(Lval0, MaybeTag, MO, Rval0, Msg, Atomic,
MaybeRegionRval0, MaybeReuse0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_rval(Rval0, Rval, ReplMap),
(
MaybeRegionRval0 = yes(RegionRval0),
replace_labels_rval(RegionRval0, RegionRval, ReplMap),
MaybeRegionRval = yes(RegionRval)
;
MaybeRegionRval0 = no,
MaybeRegionRval = MaybeRegionRval0
),
(
MaybeReuse0 = llds_reuse(ReuseRval0, MaybeFlagLval0),
replace_labels_rval(ReuseRval0, ReuseRval, ReplMap),
(
MaybeFlagLval0 = yes(FlagLval0),
replace_labels_lval(FlagLval0, FlagLval, ReplMap),
MaybeFlagLval = yes(FlagLval)
;
MaybeFlagLval0 = no,
MaybeFlagLval = no
),
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval)
;
MaybeReuse0 = no_llds_reuse,
MaybeReuse = no_llds_reuse
)
;
ReplData = no,
Lval = Lval0,
Rval = Rval0,
MaybeRegionRval = MaybeRegionRval0,
MaybeReuse = MaybeReuse0
),
Uinstr = incr_hp(Lval, MaybeTag, MO, Rval, Msg, Atomic,
MaybeRegionRval, MaybeReuse)
;
Uinstr0 = mark_hp(Lval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = mark_hp(Lval)
;
Uinstr0 = restore_hp(Rval0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
Uinstr = restore_hp(Rval)
;
Uinstr0 = free_heap(Rval0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
Uinstr = free_heap(Rval)
;
Uinstr0 = push_region_frame(StackId, EmbeddedStackFrame),
Uinstr = push_region_frame(StackId, EmbeddedStackFrame)
;
Uinstr0 = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval0,
NumLval0, AddrLval0),
(
ReplData = yes,
replace_labels_rval(IdRval0, IdRval, ReplMap),
replace_labels_lval(NumLval0, NumLval, ReplMap),
replace_labels_lval(AddrLval0, AddrLval, ReplMap)
;
ReplData = no,
IdRval = IdRval0,
NumLval = NumLval0,
AddrLval = AddrLval0
),
Uinstr = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval,
NumLval, AddrLval)
;
Uinstr0 = region_set_fixed_slot(SetOp, EmbeddedStackFrame,
ValueRval0),
(
ReplData = yes,
replace_labels_rval(ValueRval0, ValueRval, ReplMap)
;
ReplData = no,
ValueRval = ValueRval0
),
Uinstr = region_set_fixed_slot(SetOp, EmbeddedStackFrame,
ValueRval)
;
Uinstr0 = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame),
Uinstr = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame)
;
Uinstr0 = store_ticket(Lval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = store_ticket(Lval)
;
Uinstr0 = reset_ticket(Rval0, Reason),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
Uinstr = reset_ticket(Rval, Reason)
;
Uinstr0 = mark_ticket_stack(Lval0),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = mark_ticket_stack(Lval)
;
Uinstr0 = prune_tickets_to(Rval0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
;
ReplData = no,
Rval = Rval0
),
Uinstr = prune_tickets_to(Rval)
;
Uinstr0 = foreign_proc_code(Decls, Comps0, MayCallMercury,
MaybeFix, MaybeLayout, MaybeOnlyLayout, MaybeSub0, MaybeDef,
StackSlotRef, MayDupl),
(
MaybeFix = no
;
MaybeFix = yes(FixLabel0),
replace_labels_label(FixLabel0, FixLabel, ReplMap),
% We cannot replace the label in the C code string itself.
expect(unify(FixLabel0, FixLabel), $module, $pred,
"trying to replace Mercury label in C code")
),
(
MaybeLayout = no
;
MaybeLayout = yes(LayoutLabel0),
replace_labels_label(LayoutLabel0, LayoutLabel, ReplMap),
% We cannot replace a label that has a layout structure.
expect(unify(LayoutLabel0, LayoutLabel), $module, $pred,
"trying to replace Mercury label with layout")
),
(
MaybeOnlyLayout = no
;
MaybeOnlyLayout = yes(OnlyLayoutLabel0),
replace_labels_label(OnlyLayoutLabel0, OnlyLayoutLabel, ReplMap),
% We cannot replace a label that has a layout structure.
expect(unify(OnlyLayoutLabel0, OnlyLayoutLabel), $module, $pred,
"trying to replace Mercury label with layout")
),
(
MaybeSub0 = no,
MaybeSub = no,
Comps = Comps0
;
MaybeSub0 = yes(SubLabel0),
replace_labels_label(SubLabel0, SubLabel, ReplMap),
MaybeSub = yes(SubLabel),
replace_labels_comps(Comps0, Comps, ReplMap)
),
(
MaybeDef = no
;
MaybeDef = yes(DefLabel0),
replace_labels_label(DefLabel0, DefLabel, ReplMap),
% We cannot replace a label that has a layout structure.
expect(unify(DefLabel0, DefLabel), $module, $pred,
"trying to replace Mercury label with layout")
),
Uinstr = foreign_proc_code(Decls, Comps, MayCallMercury,
MaybeFix, MaybeLayout, MaybeOnlyLayout, MaybeSub, MaybeDef,
StackSlotRef, MayDupl)
;
Uinstr0 = init_sync_term(Lval0, NumConjuncts, TSStringIndex),
(
ReplData = yes,
replace_labels_lval(Lval0, Lval, ReplMap)
;
ReplData = no,
Lval = Lval0
),
Uinstr = init_sync_term(Lval, NumConjuncts, TSStringIndex)
;
Uinstr0 = fork_new_child(Lval0, Child0),
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_label(Child0, Child, ReplMap),
Uinstr = fork_new_child(Lval, Child)
;
Uinstr0 = join_and_continue(Lval0, Label0),
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_label(Label0, Label, ReplMap),
Uinstr = join_and_continue(Lval, Label)
;
Uinstr0 = lc_create_loop_control(NumSLots, Lval0),
replace_labels_lval(Lval0, Lval, ReplMap),
Uinstr = lc_create_loop_control(NumSLots, Lval)
;
Uinstr0 = lc_wait_free_slot(Rval0, Lval0, Label0),
replace_labels_rval(Rval0, Rval, ReplMap),
replace_labels_lval(Lval0, Lval, ReplMap),
replace_labels_label(Label0, Label, ReplMap),
Uinstr = lc_wait_free_slot(Rval, Lval, Label)
;
Uinstr0 = lc_spawn_off(LCRval0, LCSRval0, Label0),
replace_labels_rval(LCRval0, LCRval, ReplMap),
replace_labels_rval(LCSRval0, LCSRval, ReplMap),
replace_labels_label(Label0, Label, ReplMap),
Uinstr = lc_spawn_off(LCRval, LCSRval, Label)
;
Uinstr0 = lc_join_and_terminate(LCRval0, LCSRval0),
replace_labels_rval(LCRval0, LCRval, ReplMap),
replace_labels_rval(LCSRval0, LCSRval, ReplMap),
Uinstr = lc_join_and_terminate(LCRval, LCSRval)
).
replace_labels_comps([], [], _).
replace_labels_comps([Comp0 | Comps0], [Comp | Comps], ReplMap) :-
replace_labels_comp(Comp0, Comp, ReplMap),
replace_labels_comps(Comps0, Comps, ReplMap).
:- pred replace_labels_comp(
foreign_proc_component::in, foreign_proc_component::out,
map(label, label)::in) is det.
replace_labels_comp(Comp0, Comp, ReplMap) :-
(
( Comp0 = foreign_proc_inputs(_)
; Comp0 = foreign_proc_outputs(_)
; Comp0 = foreign_proc_user_code(_, _, _)
; Comp0 = foreign_proc_raw_code(_, _, _, _)
; Comp0 = foreign_proc_alloc_id(_)
; Comp0 = foreign_proc_noop
),
Comp = Comp0
;
Comp0 = foreign_proc_fail_to(Label0),
replace_labels_label(Label0, Label, ReplMap),
Comp = foreign_proc_fail_to(Label)
).
:- pred replace_labels_c_code_live_lvals(
c_code_live_lvals::in, c_code_live_lvals::out, map(label, label)::in)
is det.
replace_labels_c_code_live_lvals(LiveLvals0, LiveLvals, ReplMap) :-
(
LiveLvals0 = no_live_lvals_info,
LiveLvals = LiveLvals0
;
LiveLvals0 = live_lvals_info(LvalSet0),
set.to_sorted_list(LvalSet0, Lvals0),
list.map(replace_labels_lval_map(ReplMap), Lvals0, Lvals),
% We cannot replace the lvals inside the C code.
expect(unify(Lvals0, Lvals), $module, $pred, "some replacements"),
LiveLvals = LiveLvals0
).
:- pred replace_labels_lval_map(map(label, label)::in, lval::in, lval::out)
is det.
replace_labels_lval_map(ReplMap, Lval0, Lval) :-
replace_labels_lval(Lval0, Lval, ReplMap).
:- pred replace_labels_lval(lval::in, lval::out, map(label, label)::in) is det.
replace_labels_lval(Lval0, Lval, ReplMap) :-
(
( Lval0 = reg(_, _)
; Lval0 = temp(_, _)
; Lval0 = stackvar(_)
; Lval0 = framevar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = double_stackvar(_, _)
; Lval0 = succip
; Lval0 = maxfr
; Lval0 = curfr
; Lval0 = hp
; Lval0 = sp
; Lval0 = parent_sp
; Lval0 = lvar(_)
; Lval0 = global_var_ref(_)
),
Lval = Lval0
;
Lval0 = succip_slot(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = succip_slot(Rval)
;
Lval0 = succfr_slot(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = succfr_slot(Rval)
;
Lval0 = redoip_slot(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = redoip_slot(Rval)
;
Lval0 = redofr_slot(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = redofr_slot(Rval)
;
Lval0 = prevfr_slot(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = prevfr_slot(Rval)
;
Lval0 = field(Tag, BaseRval0, OffsetRval0),
replace_labels_rval(BaseRval0, BaseRval, ReplMap),
replace_labels_rval(OffsetRval0, OffsetRval, ReplMap),
Lval = field(Tag, BaseRval, OffsetRval)
;
Lval0 = mem_ref(Rval0),
replace_labels_rval(Rval0, Rval, ReplMap),
Lval = mem_ref(Rval)
).
:- pred replace_labels_rval(rval::in, rval::out, map(label, label)::in) is det.
replace_labels_rval(Rval0, Rval, ReplMap) :-
(
Rval0 = lval(Lval0),
replace_labels_lval(Lval0, Lval, ReplMap),
Rval = lval(Lval)
;
Rval0 = var(_Var),
Rval = Rval0
;
Rval0 = mkword(Tag, SubRval0),
replace_labels_rval(SubRval0, SubRval, ReplMap),
Rval = mkword(Tag, SubRval)
;
Rval0 = mkword_hole(Tag),
Rval = mkword_hole(Tag)
;
Rval0 = const(Const0),
replace_labels_rval_const(Const0, Const, ReplMap),
Rval = const(Const)
;
Rval0 = unop(UnOp, SubRvalA0),
replace_labels_rval(SubRvalA0, SubRvalA, ReplMap),
Rval = unop(UnOp, SubRvalA)
;
Rval0 = binop(BinOp, SubRvalA0, SubRvalB0),
replace_labels_rval(SubRvalA0, SubRvalA, ReplMap),
replace_labels_rval(SubRvalB0, SubRvalB, ReplMap),
Rval = binop(BinOp, SubRvalA, SubRvalB)
;
Rval0 = mem_addr(MemRef0),
replace_labels_mem_ref(MemRef0, MemRef, ReplMap),
Rval = mem_addr(MemRef)
).
:- pred replace_labels_mem_ref(mem_ref::in, mem_ref::out,
map(label, label)::in) is det.
replace_labels_mem_ref(MemRef0, MemRef, ReplMap) :-
(
( MemRef0 = stackvar_ref(_)
; MemRef0 = framevar_ref(_)
),
MemRef = MemRef0
;
MemRef0 = heap_ref(CellRval0, MaybeTag, FieldNumRval0),
replace_labels_rval(CellRval0, CellRval, ReplMap),
replace_labels_rval(FieldNumRval0, FieldNumRval, ReplMap),
MemRef = heap_ref(CellRval, MaybeTag, FieldNumRval)
).
:- pred replace_labels_rval_const(rval_const::in, rval_const::out,
map(label, label)::in) is det.
replace_labels_rval_const(Const0, Const, ReplMap) :-
(
( Const0 = llconst_true
; Const0 = llconst_false
; Const0 = llconst_int(_)
; Const0 = llconst_uint(_)
; Const0 = llconst_int8(_)
; Const0 = llconst_uint8(_)
; Const0 = llconst_int16(_)
; Const0 = llconst_uint16(_)
; Const0 = llconst_int32(_)
; Const0 = llconst_uint32(_)
; Const0 = llconst_int64(_)
; Const0 = llconst_uint64(_)
; Const0 = llconst_foreign(_, _)
; Const0 = llconst_float(_)
; Const0 = llconst_string(_)
; Const0 = llconst_multi_string(_)
; Const0 = llconst_data_addr(_, _)
),
Const = Const0
;
Const0 = llconst_code_addr(Addr0),
replace_labels_code_addr(Addr0, Addr, ReplMap),
Const = llconst_code_addr(Addr)
).
replace_labels_code_addr(Addr0, Addr, ReplMap) :-
(
Addr0 = code_label(Label0),
replace_labels_label(Label0, Label, ReplMap),
Addr = code_label(Label)
;
( Addr0 = code_imported_proc(_)
; Addr0 = code_succip
; Addr0 = do_succeed(_)
; Addr0 = do_redo
; Addr0 = do_fail
; Addr0 = do_trace_redo_fail_shallow
; Addr0 = do_trace_redo_fail_deep
; Addr0 = do_call_closure(_)
; Addr0 = do_call_class_method(_)
; Addr0 = do_not_reached
),
Addr = Addr0
).
replace_labels_maybe_label_list([], [], _ReplMap).
replace_labels_maybe_label_list([MaybeLabel0 | MaybeLabels0],
[MaybeLabel | MaybeLabels], ReplMap) :-
(
MaybeLabel0 = yes(Label0),
replace_labels_label(Label0, Label, ReplMap),
MaybeLabel = yes(Label)
;
MaybeLabel0 = no,
MaybeLabel = no
),
replace_labels_maybe_label_list(MaybeLabels0, MaybeLabels, ReplMap).
replace_labels_label(Label0, Label, ReplMap) :-
( if map.search(ReplMap, Label0, NewLabel) then
Label = NewLabel
else
Label = Label0
).
%-----------------------------------------------------------------------------%
:- end_module ll_backend.opt_util.
%-----------------------------------------------------------------------------%