%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 2007-2011. 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%
%%

-module(beam_trim).
-export([module/2]).

-import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]).

-record(st,
	{safe,					%Safe labels.
	 lbl					%Code at each label.
	 }).

module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
    Fs = [function(F) || F <- Fs0],
    {ok,{Mod,Exp,Attr,Fs,Lc}}.

function({function,Name,Arity,CLabel,Is0}) ->
    %%ok = io:fwrite("~w: ~p\n", [?LINE,{Name,Arity}]),
    St = #st{safe=safe_labels(Is0, []),lbl=beam_utils:index_labels(Is0)},
    Is = trim(Is0, St, []),
    {function,Name,Arity,CLabel,Is}.

trim([{kill,_}|_]=Is0, St, Acc) ->
    {Kills0,Is1} = splitwith(fun({kill,_}) -> true;
			       (_) -> false
			    end, Is0),
    Kills = sort(Kills0),
    try
	{FrameSize,Layout} = frame_layout(Is1, Kills, St),
	Configs = trim_instructions(Layout),
	try_remap(Configs, Is1, FrameSize)
	of
	{Is,TrimInstr} ->
	    trim(Is, St, reverse(TrimInstr)++Acc)
    catch
	not_possible ->
	    trim(Is1, St, reverse(Kills, Acc))
    end;
trim([I|Is], St, Acc) ->
    trim(Is, St, [I|Acc]);
trim([], _, Acc) ->
    reverse(Acc).

%% trim_instructions([{kill,R}|{live,R}|{dead,R}]) -> {[Instruction],MapFun}
%%  Figure out the sequence of moves and trim to use.

trim_instructions(Layout) ->
    Cost = length([I || {kill,_}=I <- Layout]),
    trim_instructions_1(Layout, 0, [], {Cost,[]}).

trim_instructions_1([{kill,{y,Trim0}}|Ks], Trim0, Moves, Config0) ->
    Trim = Trim0 + 1,
    Config = save_config(Ks, Trim, Moves, Config0),
    trim_instructions_1(Ks, Trim, Moves, Config);
trim_instructions_1([{dead,{y,Trim0}}|Ks], Trim0, Moves, Config0) ->
    Trim = Trim0 + 1,
    Config = save_config(Ks, Trim, Moves, Config0),
    trim_instructions_1(Ks, Trim, Moves, Config);
trim_instructions_1([{live,{y,Trim0}=Src}|Ks0], Trim0, Moves0, Config0) ->
    case take_last_dead(Ks0) of
	none ->
	    {_,ConfigList} = Config0,
	    ConfigList;
	{Dst,Ks} ->
	    Trim = Trim0 + 1,
	    Moves = [{move,Src,Dst}|Moves0],
	    Config = save_config(Ks, Trim, Moves, Config0),
	    trim_instructions_1(Ks, Trim, Moves, Config)
    end;
trim_instructions_1([], _, _, {_,ConfigList}) ->
    ConfigList.

take_last_dead(L) ->
    take_last_dead_1(reverse(L)).

take_last_dead_1([{kill,Reg}|Is]) ->
    {Reg,reverse(Is)};
take_last_dead_1([{dead,Reg}|Is]) ->
    {Reg,reverse(Is)};
take_last_dead_1(_) -> none.

save_config(Ks, Trim, Moves, {MaxCost,Acc}=Config) ->
    case config_cost(Ks, Moves) of
	Cost when Cost =< MaxCost ->
	    {MaxCost,[{Ks,Trim,Moves}|Acc]};
	_Cost ->
	    Config
    end.

config_cost(Ks, Moves) ->
    %% We estimate that a {move,{y,_},{y,_}} instruction is roughly twice as
    %% expensive as a {kill,{y,_}} instruction. A {trim,_} instruction is
    %% roughly as expensive as a {kill,{y,_}} instruction.

    config_cost_1(Ks, 1+2*length(Moves)).

config_cost_1([{kill,_}|Ks], Cost) ->
    config_cost_1(Ks, Cost+1);
config_cost_1([_|Ks], Cost) ->
    config_cost_1(Ks, Cost);
config_cost_1([], Cost) -> Cost.

expand_config({Layout,Trim,Moves}, FrameSize) ->
    Kills = [Kill || {kill,_}=Kill <- Layout],
    {Kills++reverse(Moves, [{trim,Trim,FrameSize-Trim}]),create_map(Trim, Moves)}.

create_map(Trim, []) ->
    fun({y,Y}) when Y < Trim -> throw(not_possible);
       ({y,Y}) -> {y,Y-Trim};
       ({frame_size,N}) -> N - Trim;
       (Any) -> Any
    end;
create_map(Trim, Moves) ->
    GbTree0 = [{Src,Dst-Trim} || {move,{y,Src},{y,Dst}} <- Moves],
    GbTree = gb_trees:from_orddict(sort(GbTree0)),
    IllegalTargets = gb_sets:from_list([Dst || {move,_,{y,Dst}} <- Moves]),
    fun({y,Y0}) when Y0 < Trim ->
	    case gb_trees:lookup(Y0, GbTree) of
		{value,Y} -> {y,Y};
		none -> throw(not_possible)
	    end;
       ({y,Y}) ->
	    case gb_sets:is_element(Y, IllegalTargets) of
		true -> throw(not_possible);
		false -> {y,Y-Trim}
	    end;
       ({frame_size,N}) -> N - Trim;
       (Any) -> Any
    end.

try_remap([C|Cs], Is, FrameSize) ->
    {TrimInstr,Map} = expand_config(C, FrameSize),
    try
	{remap(Is, Map, []),TrimInstr}
    catch
	throw:not_possible ->
	    try_remap(Cs, Is, FrameSize)
    end;
try_remap([], _, _) -> throw(not_possible).

remap([{block,Bl0}|Is], Map, Acc) ->
    Bl = remap_block(Bl0, Map, []),
    remap(Is, Map, [{block,Bl}|Acc]);
remap([{call_fun,_}=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]);
remap([{call,_,_}=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]);
remap([{call_ext,_,_}=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]);
remap([{apply,_}=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]);
remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) ->
    I = {bif,Name,Fail,[Map(S) || S <- Ss],Map(D)},
    remap(Is, Map, [I|Acc]);
remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) ->
    I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)},
    remap(Is, Map, [I|Acc]);
remap([{bs_append=Op,Fail,Bits,Heap,Live,Unit,Bin,Flags,D}|Is], Map, Acc) ->
    I = {Op,Fail,Map(Bits),Heap,Live,Unit,Map(Bin),Flags,Map(D)},
    remap(Is, Map, [I|Acc]);
remap([{bs_private_append=Op,Fail,Bits,Unit,Bin,Flags,D}|Is], Map, Acc) ->
    I = {Op,Fail,Map(Bits),Unit,Map(Bin),Flags,Map(D)},
    remap(Is, Map, [I|Acc]);
remap([bs_init_writable=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]);
remap([{bs_init2,Fail,Src,Live,U,Flags,D}|Is], Map, Acc) ->
    I = {bs_init2,Fail,Map(Src),Live,U,Flags,Map(D)},
    remap(Is, Map, [I|Acc]);
remap([{bs_init_bits,Fail,Src,Live,U,Flags,D}|Is], Map, Acc) ->
    I = {bs_init_bits,Fail,Map(Src),Live,U,Flags,Map(D)},
    remap(Is, Map, [I|Acc]);
remap([{bs_put=Op,Fail,Info,Ss}|Is], Map, Acc) ->
    I = {Op,Fail,Info,[Map(S) || S <- Ss]},
    remap(Is, Map, [I|Acc]);
remap([{kill,Y}|T], Map, Acc) ->
    remap(T, Map, [{kill,Map(Y)}|Acc]);
remap([send=I|T], Map, Acc) ->
    remap(T, Map, [I|Acc]);
remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) ->
    remap(T, Map, [I|Acc]);
remap([{deallocate,N}|Is], Map, Acc) ->
    I = {deallocate,Map({frame_size,N})},
    remap(Is, Map, [I|Acc]);
remap([{test,Name,Fail,Ss}|Is], Map, Acc) ->
    I = {test,Name,Fail,[Map(S) || S <- Ss]},
    remap(Is, Map, [I|Acc]);
remap([{test,Name,Fail,Live,Ss,Dst}|Is], Map, Acc) ->
    I = {test,Name,Fail,Live,[Map(S) || S <- Ss],Map(Dst)},
    remap(Is, Map, [I|Acc]);
remap([return|_]=Is, _, Acc) ->
    reverse(Acc, Is);
remap([{call_last,Ar,Name,N}|Is], Map, Acc) ->
    I = {call_last,Ar,Name,Map({frame_size,N})},
    reverse(Acc, [I|Is]);
remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) ->
    I = {call_ext_last,Ar,Name,Map({frame_size,N})},
    reverse(Acc, [I|Is]);
remap([{line,_}=I|Is], Map, Acc) ->
    remap(Is, Map, [I|Acc]).
    
remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) ->
    Ds = [Map(D) || D <- Ds0],
    Ss = [Map(S) || S <- Ss0],
    remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]);
remap_block([], _, Acc) -> reverse(Acc).
    
safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y ->
    safe_labels(Is, [L|Acc]);
safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y ->
    safe_labels(Is, [L|Acc]);
safe_labels([{label,L},{line,_},if_end|Is], Acc) ->
    safe_labels(Is, [L|Acc]);
safe_labels([{label,L},
	     {block,[{set,[{x,0}],[{Tag,_}],move}]},
	     {line,_},
	     {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y ->
    safe_labels(Is, [L|Acc]);
safe_labels([_|Is], Acc) ->
    safe_labels(Is, Acc);
safe_labels([], Acc) -> gb_sets:from_list(Acc).

%% frame_layout([Instruction], [{kill,_}], St) ->
%%      [{kill,Reg} | {live,Reg} | {dead,Reg}]
%%  Figure out the layout of the stack frame.

frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) ->
    N = frame_size(Is, Safe),
    IsKilled = fun(R) -> beam_utils:is_killed(R, Is, D) end,
    {N,frame_layout_1(Kills, 0, N, IsKilled, [])}.

frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) ->
    frame_layout_1(Ks, Y+1, N, IsKilled, [I|Acc]);
frame_layout_1(Ks, Y, N, IsKilled, Acc) when Y < N ->
    R = {y,Y},
    I = case IsKilled(R) of
	    false -> {live,R};
	    true -> {dead,R}
	end,
    frame_layout_1(Ks, Y+1, N, IsKilled, [I|Acc]);
frame_layout_1([], Y, Y, _, Acc) ->
    frame_layout_2(Acc).

frame_layout_2([{live,_}|Is]) -> frame_layout_2(Is);
frame_layout_2(Is) -> reverse(Is).

%% frame_size([Instruction], SafeLabels) -> FrameSize
%%  Find out the frame size by looking at the code that follows.

frame_size([{block,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{call_fun,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{call,_,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{call_ext,A,{extfunc,M,F,A}}|Is], Safe) ->
    case erl_bifs:is_exit_bif(M, F, A) of
	true -> throw(not_possible);
	false -> frame_size(Is, Safe)
    end;
frame_size([{apply,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{bif,_,{f,L},_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{gc_bif,_,{f,L},_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{test,_,{f,L},_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{test,_,{f,L},_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{bs_append,{f,L},_,_,_,_,_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{bs_private_append,{f,L},_,_,_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([bs_init_writable|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{bs_init2,{f,L},_,_,_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{bs_init_bits,{f,L},_,_,_,_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{bs_put,{f,L},_,_}|Is], Safe) ->
    frame_size_branch(L, Is, Safe);
frame_size([{kill,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([send|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{make_fun2,_,_,_,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([{deallocate,N}|_], _) -> N;
frame_size([{call_last,_,_,N}|_], _) -> N;
frame_size([{call_ext_last,_,_,N}|_], _) -> N;
frame_size([{line,_}|Is], Safe) ->
    frame_size(Is, Safe);
frame_size([_|_], _) -> throw(not_possible).

frame_size_branch(0, Is, Safe) ->
    frame_size(Is, Safe);
frame_size_branch(L, Is, Safe) ->
    case gb_sets:is_member(L, Safe) of
	false -> throw(not_possible);
	true -> frame_size(Is, Safe)
    end.