%% -*- Erlang -*-
%% -*- erlang-indent-level: 2 -*-
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%%-----------------------------------------------------------------------------
%% File : hipe_ssa_const_prop.inc
%% Author : Kostis Sagonas <kostis@it.uu.se>
%% Description : Supporting routines for sparse conditional constant
%% propagation on SSA form.
%%
%% Created : 21 June 2004 by Kostis Sagonas <kostis@it.uu.se>
%%-----------------------------------------------------------------------------
%%-----------------------------------------------------------------------------
%% Procedure : propagate/1
%% Purpose : Perform sparse conditional constant propagation on a
%% control flow graph
%% Arguments : CFG - The cfg to work on
%% Returns : A new cfg.
%%-----------------------------------------------------------------------------
-spec propagate(#cfg{}) -> #cfg{}.
propagate(CFG) ->
Environment = create_env(CFG),
StartEdge = {?CFG:start_label(CFG), ?CFG:start_label(CFG)},
NewEnvironment = scc([StartEdge], [], Environment),
NewCFG = update_cfg(NewEnvironment),
NewCFG.
%%-----------------------------------------------------------------------------
%% Procedure : visit_expressions/2 & visit_expressions/4
%% Purpose : visit each instruction in a list of instructions.
%% Arguments : Instructions - the list of instructions to visit
%% Environment - have a guess.
%% FlowWork - list of destination part of flowgraph edges
%% from the visited instructions
%% SSAWork - resulting ssa-edges from visited instrs.
%% Returns : {FlowWorkList, SSAWorkList, Environment}
%%-----------------------------------------------------------------------------
visit_expressions(Instructions, Environment) ->
visit_expressions(Instructions, Environment, [], []).
visit_expressions([], Environment, FlowWork, SSAWork) ->
{FlowWork, SSAWork, Environment};
visit_expressions([Inst | Insts], Environment, FlowWork, SSAWork) ->
{MoreFlowWork, MoreSSAWork, Environment1}
= visit_expression(Inst, Environment),
FlowWork1 = MoreFlowWork ++ FlowWork,
SSAWork1 = MoreSSAWork ++ SSAWork,
visit_expressions(Insts, Environment1, FlowWork1, SSAWork1).
%%-----------------------------------------------------------------------------
%% The environment record: Shared between incarnations of SCCP.
%%-----------------------------------------------------------------------------
-record(env, {cfg :: #cfg{},
executable_flags = gb_sets:empty() :: gb_set(),
handled_blocks = gb_sets:empty() :: gb_set(),
lattice_values = gb_trees:empty() :: gb_tree(),
ssa_edges = gb_trees:empty() :: gb_tree()
}).
create_env(CFG) ->
#env{cfg = CFG,
executable_flags = gb_sets:empty(),
handled_blocks = gb_sets:empty(),
lattice_values = initialize_lattice(CFG),
ssa_edges = initialize_ssa_edges(CFG)
}.
env__cfg(#env{cfg=CFG}) -> CFG.
env__executable_flags(#env{executable_flags=Flags}) -> Flags.
env__lattice_values(#env{lattice_values=Values}) -> Values.
env__ssa_edges(#env{ssa_edges=Edges}) -> Edges.
%%-----------------------------------------------------------------------------
%% Procedure : initialize_lattice/1
%% Purpose : Compute the initial value-lattice for the CFG
%% Arguments : CFG a control flow graph
%% Returns : a value-latice (gb_tree)
%%-----------------------------------------------------------------------------
initialize_lattice(CFG) ->
Lattice = gb_trees:empty(),
Parameters = ?CFG:params(CFG),
Inserter = fun(Parameter, Tree) ->
gb_trees:insert(Parameter, bottom, Tree)
end,
lists:foldl(Inserter, Lattice, Parameters).
%%-----------------------------------------------------------------------------
%% Procedure : initialize_ssa_edges/1
%% Purpose : Compute the SSA edges in the CFG. SSA edges are used to map
%% the definition of a value to its uses.
%% Arguments : CFG - the cfg
%% Returns : A gb_tree of values (variables & registers) to
%% lists of {Node, Instruction} pairs.
%%-----------------------------------------------------------------------------
initialize_ssa_edges(CFG) ->
IterateNodes =
fun(Node, Tree1) ->
IterateInstructions =
fun(Instruction, Tree2) ->
IterateArguments =
fun(Argument, Tree3) ->
Data = gb_trees:lookup(Argument, Tree3),
NewEdge = {Node, Instruction},
case Data of
none ->
%% insert assumes key is not present
gb_trees:insert(Argument, [NewEdge], Tree3);
{value, EdgeList} ->
%% update assumes key is present
gb_trees:update(Argument, [NewEdge|EdgeList], Tree3)
end
end,
Arguments = ?CODE:uses(Instruction),
lists:foldl(IterateArguments, Tree2, Arguments)
end,
Instructions = hipe_bb:code(?CFG:bb(CFG, Node)),
lists:foldl(IterateInstructions, Tree1, Instructions)
end,
NodeList = ?CFG:labels(CFG),
lists:foldl(IterateNodes, gb_trees:empty(), NodeList).
%%-----------------------------------------------------------------------------
%% Procedure : scc/3
%% Purpose : Do the symbolic execution of a cfg and compute the resulting
%% value-lattice, and reachability information (Environment).
%% This is the main loop that does a fixpoint computation of the
%% lattice-values for each variable and register.
%% Arguments : FlowWorkList - work list of control-flow edges
%% SSAWorkList - work list of ssa-edges
%% Environment - the environment that have been computed so far.
%% Returns : The environment after execution
%%-----------------------------------------------------------------------------
scc([], [], Environment) ->
Environment;
%% Take an element from the FlowWorkList and process it
scc([{Source,Destination} | FlowWorkList], SSAWorkList, Environment) ->
case executable({Source, Destination}, Environment) of
true ->
scc(FlowWorkList, SSAWorkList, Environment);
false ->
Environment1 = mark_as_executable({Source,Destination}, Environment),
Code = extract_code(Destination, Environment),
{Environment2, Code1, ExtraSSA} =
visit_phi_nodes(Code, Destination, Environment1, []),
case handled(Destination, Environment2) of
true ->
scc(FlowWorkList, ExtraSSA ++ SSAWorkList, Environment2);
false ->
{MoreFlowDests, MoreSSAWork, Environment3} =
visit_expressions(Code1, Environment2),
MoreFlowWork = [{Destination, Node} || Node <- MoreFlowDests],
FlowWorkList1 = MoreFlowWork ++ FlowWorkList,
SSAWorkList1 = ExtraSSA ++ MoreSSAWork ++ SSAWorkList,
Environment4 = mark_as_handled(Destination, Environment3),
scc(FlowWorkList1, SSAWorkList1, Environment4)
end
end;
%% Take an element from the SSAWorkList and process it
scc([], [{Node, Instruction} | SSAWorkList], Environment) ->
case reachable(Node, Environment) of
true ->
case ?CODE:is_phi(Instruction) of
true ->
{Environment1, MoreSSA} = visit_phi(Instruction, Node, Environment),
scc([], MoreSSA ++ SSAWorkList, Environment1);
false ->
{MoreFlowDests, MoreSSAWork, Environment1} =
visit_expression(Instruction, Environment),
SSAWorkList1 = MoreSSAWork ++ SSAWorkList,
MoreFlowWork = [{Node, Destination} || Destination<-MoreFlowDests],
scc(MoreFlowWork, SSAWorkList1, Environment1)
end;
false ->
scc([], SSAWorkList, Environment)
end.
%%-----------------------------------------------------------------------------
%% Procedure : update_cfg/1
%% Purpose : Transforms the cfg into something more pleasant.
%% Here the mapping of variables & registers to lattice-values is
%% used to actually change the code.
%% Arguments : Environment - in which everything happens.
%% Returns : A new CFG.
%%-----------------------------------------------------------------------------
update_cfg(Environment) ->
NodeList = get_nodelist(Environment),
CFG1 = update_nodes(NodeList, Environment),
%% why not hipe_???_ssa:remove_dead_code ?
CFG2 = ?CFG:remove_unreachable_code(CFG1),
CFG2.
%%-----------------------------------------------------------------------------
%% Procedure : update_nodes/2
%% Purpose : loop over all nodes in a list of nodes, ignoring any
%% non-reachable node.
%% Arguments : NodeList - the list of nodes.
%% Environment - in which everything happens.
%% Returns : a new cfg.
%%-----------------------------------------------------------------------------
update_nodes([], Environment) ->
env__cfg(Environment);
update_nodes([Node | NodeList], Environment) ->
NewEnvironment =
case reachable(Node, Environment) of
true ->
Instructions = extract_code(Node, Environment),
Updater = fun(Instruction) ->
update_instruction(Instruction, Environment)
end,
NewInstructions = lists:flatmap(Updater, Instructions),
update_code(Node, NewInstructions, Environment);
false ->
Environment
end,
update_nodes(NodeList, NewEnvironment).
%%-----------------------------------------------------------------------------
%% Procedure : update_code/3
%% Purpose : Insert a list of new instructions into the cfg in the
%% environment
%% Arguments : Node - name of the bb whose instructions we replace.
%% NewInstructions - The list of new instructions
%% Env - The environment
%% Returns : A new environment
%%-----------------------------------------------------------------------------
update_code(Node, NewInstructions, Environment) ->
CFG = env__cfg(Environment),
BB = ?CFG:bb(CFG, Node),
OrderedInstructions = put_phi_nodes_first(NewInstructions),
NewBB = hipe_bb:code_update(BB, OrderedInstructions),
NewCFG = ?CFG:bb_add(CFG, Node, NewBB),
Environment#env{cfg = NewCFG}.
%%-----------------------------------------------------------------------------
%% Procedure : put_phi_nodes_first/1
%% Purpose : Move all phi-instructions to the beginning of the basic block.
%% Arguments : Instructions - The list of instructions
%% Returns : A list of instructions where the phi-nodes are first.
%%-----------------------------------------------------------------------------
put_phi_nodes_first(Instructions) ->
{PhiInstructions, OtherInstructions} =
partition(fun(X) -> ?CODE:is_phi(X) end, Instructions),
PhiInstructions ++ OtherInstructions.
%%-----------------------------------------------------------------------------
partition(Function, List) ->
partition(Function, List, [], []).
partition(_Function, [], True, False) ->
{lists:reverse(True), lists:reverse(False)};
partition(Function, [Hd | Tail], True, False) ->
case Function(Hd) of
true ->
partition(Function, Tail, [Hd | True], False);
false ->
partition(Function, Tail, True, [Hd | False])
end.
%%-----------------------------------------------------------------------------
%% Procedure : visit_phi_nodes/4
%% Purpose : visit all the phi-nodes in a bb and return the list of
%% remaining instructions, new ssa-edges and a new environment.
%% Arguments : [Inst|Insts] - The list of instructions in the bb
%% Node - Name of the current node.
%% Environment - the environment
%% SSAWork - the ssawork found so far.
%% Returns : {Environment, Instruction list, SSAWorkList}
%%-----------------------------------------------------------------------------
visit_phi_nodes([], CurrentNode, _Environment, _SSAWork) ->
?EXIT({"~w: visit_phi_nodes/4 Basic block contains no code",
?MODULE, CurrentNode});
visit_phi_nodes(Is = [Inst | Insts], Node, Environment, SSAWork) ->
case ?CODE:is_phi(Inst) of
true ->
{Environment1, NewSSA} = visit_phi(Inst, Node, Environment),
visit_phi_nodes(Insts, Node, Environment1, NewSSA ++ SSAWork);
false ->
{Environment, Is, SSAWork}
end.
%%-----------------------------------------------------------------------------
%% Procedure : visit_phi/3
%% Purpose : visit a phi-node
%% Arguments : PhiInstruction- The instruction
%% CurrentNode - Name of the current node.
%% Environment - the environment
%% Returns : {NewEnvironment, SSAWork}
%%-----------------------------------------------------------------------------
visit_phi(PhiInstruction, CurrentNode, Environment) ->
ArgumentList = ?CODE:phi_arglist(PhiInstruction),
Value = get_phi_value(ArgumentList, CurrentNode, Environment, top),
Name = ?CODE:phi_dst(PhiInstruction),
{Environment1, SSAWork} = update_lattice_value({Name, Value}, Environment),
{Environment1, SSAWork}.
%%-----------------------------------------------------------------------------
%% Procedure : get_phi_value/4
%% Purpose : compute the result of a phi-function, taking care to ignore
%% edges that are not yet executable.
%% Arguments : ArgList - the list of arguments {Node, Value pair}
%% CurrentNode - the current node
%% Environment - well...
%% CurrentValue - the meet of the relevant already processed values
%% Returns : Integer, top or bottom
%%-----------------------------------------------------------------------------
%% the arglist contains {predecessor, variable} elements. Remember
%% to be optimistic in this part, hopefully, topvalues will fall down
%% to become constants. Hence topvalues are more or less ignored here.
get_phi_value([], _CurrentNode, _Environment, CurrentValue) ->
CurrentValue;
get_phi_value([{PredecessorNode, Variable}| ArgList],
CurrentNode,
Environment,
CurrentValue) ->
case executable({PredecessorNode, CurrentNode}, Environment) of
true ->
NewValue = lookup_lattice_value(Variable, Environment),
case NewValue of
bottom ->
bottom;
top ->
get_phi_value(ArgList, CurrentNode, Environment, CurrentValue);
_ ->
case CurrentValue of
top ->
get_phi_value(ArgList, CurrentNode, Environment, NewValue);
_ ->
case (NewValue =:= CurrentValue) of
true ->
get_phi_value(ArgList, CurrentNode, Environment, NewValue);
false -> %% two different constants.
bottom
end
end
end;
false -> %% non-executable transitions don't affect the value.
get_phi_value(ArgList, CurrentNode, Environment, CurrentValue)
end.
%%------------------------------ environment ----------------------------------
reachable(Node, Environment) ->
Predecessors = predecessors(Node, Environment),
Executable = fun(Pred) -> executable({Pred, Node}, Environment) end,
lists:any(Executable, Predecessors).
%%-----------------------------------------------------------------------------
mark_as_executable(Edge, Environment) ->
ExecutableFlags = env__executable_flags(Environment),
ExecutableFlags1 = gb_sets:add(Edge, ExecutableFlags),
Environment#env{executable_flags = ExecutableFlags1}.
%%-----------------------------------------------------------------------------
mark_as_handled(Node, Environment = #env{handled_blocks=Handled}) ->
NewHandled = gb_sets:add_element(Node, Handled),
Environment#env{handled_blocks=NewHandled}.
handled(Node, #env{handled_blocks=Handled}) ->
gb_sets:is_element(Node, Handled).
%%-----------------------------------------------------------------------------
extract_code(Node, Environment) ->
CFG = env__cfg(Environment),
case ?CFG:bb(CFG, Node) of
not_found -> ?WARNING_MSG("Could not find label ~w.\n", [Node]),
[];
BB -> hipe_bb:code(BB)
end.
%%-----------------------------------------------------------------------------
predecessors(Node, Environment) ->
CFG = env__cfg(Environment),
?CFG:pred(CFG, Node).
%%-----------------------------------------------------------------------------
executable(Edge, Environment) ->
ExecutableFlags = env__executable_flags(Environment),
gb_sets:is_member(Edge, ExecutableFlags).
%%-----------------------------------------------------------------------------
update_lattice_value({[], _NewValue}, Environment) ->
{Environment, []};
update_lattice_value({Names, NewValue}, Environment) when is_list(Names) ->
Update =
fun(Dst, {Env, SSA}) ->
{NewEnv, NewSSA} =
update_lattice_value({Dst, NewValue}, Env),
{NewEnv, SSA ++ NewSSA}
end,
lists:foldl(Update, {Environment, []}, Names);
%% update_lattice_value({Name, {Res, N, Z, C, V} }, _) ->
%% ?EXIT({"inserting dumt grejs", {Name, {Res, N, Z, C, V} } });
update_lattice_value({Name, NewValue}, Environment) ->
LatticeValues = env__lattice_values(Environment),
{LatticeValues1, SSAWork} =
case gb_trees:lookup(Name, LatticeValues) of
none ->
{gb_trees:insert(Name, NewValue, LatticeValues),
lookup_ssa_edges(Name, Environment)};
{value, NewValue} ->
{LatticeValues, []};
{value, _} ->
{gb_trees:update(Name, NewValue, LatticeValues),
lookup_ssa_edges(Name, Environment)}
end,
{Environment#env{lattice_values = LatticeValues1}, SSAWork}.
%%-----------------------------------------------------------------------------
lookup_ssa_edges(Variable, Environment) ->
SSAEdges = env__ssa_edges(Environment),
case gb_trees:lookup(Variable, SSAEdges) of
{value, X} ->
X;
_ -> % Unused variable
[]
end.
%%-----------------------------------------------------------------------------
get_nodelist(Environment) ->
CFG = env__cfg(Environment),
?CFG:labels(CFG).
%%-----------------------------------------------------------------------------
-ifdef(DEBUG).
%%-----------------------------------------------------------------------------
%%---------------------------------- DEBUG ------------------------------------
error(Text) ->
error(Text, []).
error(Text, Data) ->
io:format("Internal compiler error in ~w\n",[?MODULE]),
io:format(Text, Data),
io:format("\n\n"),
halt().
%%-----------------------------------------------------------------------------
print_environment(Environment) ->
io:format("============================================================\n"),
io:format("Executable flags: "),
print_executable_flags(env__executable_flags(Environment)),
io:format("Lattice values --->\n"),
print_lattice_values(env__lattice_values(Environment)),
io:format("SSA edges --->\n"),
print_ssa_edges(env__ssa_edges(Environment)),
io:format("============================================================\n").
%%-----------------------------------------------------------------------------
print_executable_flags(ExecutableFlags) ->
ListOfFlags = gb_sets:to_list(ExecutableFlags),
Printer = fun ({Source, Destination}) ->
io:format("(~w, ~w), ", [Source, Destination]) end,
lists:foreach(Printer, ListOfFlags),
io:format("()\n").
%%-----------------------------------------------------------------------------
print_lattice_values(LatticeValues) ->
ListOfLatticeValues = gb_trees:to_list(LatticeValues),
Printer = fun ({Key, Value}) ->
io:format("~w = ~w\n", [Key, Value]) end,
lists:foreach(Printer, ListOfLatticeValues).
%%-----------------------------------------------------------------------------
print_ssa_edges(SSAEdges) ->
ListOfSSAEdges = gb_trees:to_list(SSAEdges),
Printer = fun ({Key, Value}) ->
io:format("~w: ~w\n", [Key, Value]) end,
lists:foreach(Printer, ListOfSSAEdges).
%%-----------------------------------------------------------------------------
-endif. %% DEBUG
%%-----------------------------------------------------------------------------
