%%%------------------------------------------------------------------- %%% @author Ulf Norell %%% @copyright (C) 2019, Aeternity Anstalt %%% @doc %%% Fate backend for Sophia compiler %%% @end %%% Created : 11 Jan 2019 %%% %%%------------------------------------------------------------------- -module(aeso_fcode_to_fate). -export([compile/2]). %% -- Preamble --------------------------------------------------------------- -define(TODO(What), error({todo, ?FILE, ?LINE, ?FUNCTION_NAME, What})). -define(i(X), {immediate, X}). -define(a, {stack, 0}). -define(IsBinOp(Op), (Op =:= 'ADD' orelse Op =:= 'SUB' orelse Op =:= 'MUL' orelse Op =:= 'DIV' orelse Op =:= 'MOD' orelse Op =:= 'POW' orelse Op =:= 'LT' orelse Op =:= 'GT' orelse Op =:= 'EQ' orelse Op =:= 'ELT' orelse Op =:= 'EGT' orelse Op =:= 'NEQ' orelse Op =:= 'AND' orelse Op =:= 'OR' orelse Op =:= 'ELEMENT')). -record(env, { args = [], stack = [], locals = [], tailpos = true }). %% -- Debugging -------------------------------------------------------------- debug(Tag, Options, Fmt, Args) -> Tags = proplists:get_value(debug, Options, []), case Tags == all orelse lists:member(Tag, Tags) orelse Tag == any andalso Tags /= [] of true -> io:format(Fmt, Args); false -> ok end. %% -- Main ------------------------------------------------------------------- %% @doc Main entry point. compile(ICode, Options) -> #{ contract_name := _ContractName, state_type := _StateType, functions := Functions } = ICode, SFuns = functions_to_scode(Functions, Options), SFuns1 = optimize_scode(SFuns, Options), BBFuns = to_basic_blocks(SFuns1, Options), FateCode = #{ functions => BBFuns, symbols => #{}, annotations => #{} }, debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), FateCode. make_function_name(init) -> <<"init">>; make_function_name({entrypoint, Name}) -> Name; make_function_name({local_fun, Xs}) -> list_to_binary("." ++ string:join(Xs, ".")). functions_to_scode(Functions, Options) -> maps:from_list( [ {make_function_name(Name), function_to_scode(Name, Args, Body, Type, Options)} || {Name, #{args := Args, body := Body, return := Type}} <- maps:to_list(Functions), Name /= init ]). %% TODO: skip init for now function_to_scode(Name, Args, Body, ResType, Options) -> debug(scode, Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), ArgTypes = [ T || {_, T} <- Args ], SCode = to_scode(init_env(Args), Body), debug(scode, Options, " scode: ~p\n", [SCode]), {{ArgTypes, ResType}, SCode}. %% -- Phase I ---------------------------------------------------------------- %% Icode to structured assembly %% -- Environment functions -- init_env(Args) -> #env{ args = Args, stack = [], tailpos = true }. push_env(Type, Env) -> Env#env{ stack = [Type | Env#env.stack] }. bind_local(Name, Env = #env{ locals = Locals }) -> {length(Locals), Env#env{ locals = Locals ++ [Name] }}. notail(Env) -> Env#env{ tailpos = false }. lookup_var(Env = #env{ args = Args, locals = Locals }, X) -> case {find_index(X, Locals), keyfind_index(X, 1, Args)} of {false, false} -> error({unbound_variable, X, Env}); {false, Arg} -> {arg, Arg}; {Local, _} -> {var, Local} end. %% -- The compiler -- to_scode(_Env, {integer, N}) -> [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring to_scode(Env, {var, X}) -> [aeb_fate_code:push(lookup_var(Env, X))]; to_scode(Env, {binop, Type, Op, A, B}) -> [ to_scode(notail(Env), B), to_scode(push_env(Type, Env), A), binop_to_scode(Op) ]; to_scode(Env, {'if', Dec, Then, Else}) -> [ to_scode(notail(Env), Dec), {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; to_scode(Env, {switch, Expr, Alts}) -> [ to_scode(notail(Env), Expr), alts_to_scode(Env, Alts) ]; to_scode(_Env, Icode) -> ?TODO(Icode). alts_to_scode(Env, [{'case', {var, X}, Body}]) -> {I, Env1} = bind_local(X, Env), [ aeb_fate_code:store({var, I}, {stack, 0}), to_scode(Env1, Body) ]; alts_to_scode(Env, Alts = [{'case', {tuple, Pats}, Body}]) -> Xs = lists:flatmap(fun({var, X}) -> [X]; (_) -> [] end, Pats), N = length(Pats), case length(Xs) == N of false -> ?TODO(Alts); true -> {Code, Env1} = match_tuple(Env, Xs), [Code, to_scode(Env1, Body)] end; alts_to_scode(_Env, Alts) -> ?TODO(Alts). %% Tuple is in the accumulator. Arguments are the variable names. match_tuple(Env, Xs) -> match_tuple(Env, 0, Xs). match_tuple(Env, I, ["_" | Xs]) -> match_tuple(Env, I + 1, Xs); match_tuple(Env, I, [X | Xs]) -> {J, Env1} = bind_local(X, Env), {Code, Env2} = match_tuple(Env1, I + 1, Xs), {[ [aeb_fate_code:dup() || [] /= [Y || Y <- Xs, Y /= "_"]], %% Don't DUP the last one aeb_fate_code:element_op({var, J}, ?i(I), ?a), Code], Env2}; match_tuple(Env, _, []) -> {[], Env}. %% -- Operators -- binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants binop_to_scode('-') -> sub_a_a_a(); binop_to_scode('==') -> eq_a_a_a(). % binop_to_scode(Op) -> ?TODO(Op). add_a_a_a() -> aeb_fate_code:add(?a, ?a, ?a). sub_a_a_a() -> aeb_fate_code:sub(?a, ?a, ?a). eq_a_a_a() -> aeb_fate_code:eq(?a, ?a, ?a). %% -- Phase II --------------------------------------------------------------- %% Optimize optimize_scode(Funs, Options) -> maps:map(fun(Name, Def) -> optimize_fun(Funs, Name, Def, Options) end, Funs). flatten(Code) -> lists:map(fun flatten_s/1, lists:flatten(Code)). flatten_s({ifte, Then, Else}) -> {ifte, flatten(Then), flatten(Else)}; flatten_s(I) -> I. optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), debug(opt, Options, "Optimizing ~s\n", [Name]), ACode = annotate_code(Code0), debug(opt, Options, " original:\n~s\n", [pp_ann(" ", ACode)]), Code1 = simplify(ACode, Options), debug(opt, Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]), Code2 = desugar(Code1), {{Args, Res}, Code2}. pp_ann(Ind, [{ifte, Then, Else} | Code]) -> [Ind, "IF-THEN\n", pp_ann(" " ++ Ind, Then), Ind, "ELSE\n", pp_ann(" " ++ Ind, Else), pp_ann(Ind, Code)]; pp_ann(Ind, [{#{ live_in := In, live_out := Out }, I} | Code]) -> Fmt = fun([]) -> "()"; (Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ") end, Op = [Ind, aeb_fate_pp:format_op(I, #{})], Ann = [[" % ", Fmt(In), " -> ", Fmt(Out)] || In ++ Out /= []], [io_lib:format("~-40s~s\n", [Op, Ann]), pp_ann(Ind, Code)]; pp_ann(_, []) -> []. %% -- Analysis -- annotate_code(Code) -> {WCode, _} = ann_writes(Code, ordsets:new(), []), {RCode, _} = ann_reads(WCode, ordsets:new(), []), RCode. %% Reverses the code ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> {Then1, WritesThen} = ann_writes(Then, Writes, []), {Else1, WritesElse} = ann_writes(Else, Writes, []), Writes1 = ordsets:union(Writes, ordsets:intersection(WritesThen, WritesElse)), ann_writes(Code, Writes1, [{ifte, Then1, Else1} | Acc]); ann_writes([I | Code], Writes, Acc) -> #{ write := Ws } = attributes(I), Writes1 = ordsets:union(Writes, Ws), Ann = #{ writes_in => Writes, writes_out => Writes1 }, ann_writes(Code, Writes1, [{Ann, I} | Acc]); ann_writes([], Writes, Acc) -> {Acc, Writes}. %% Takes reversed code and unreverses it. ann_reads([{ifte, Then, Else} | Code], Reads, Acc) -> {Then1, ReadsThen} = ann_reads(Then, Reads, []), {Else1, ReadsElse} = ann_reads(Else, Reads, []), Reads1 = ordsets:union(Reads, ordsets:union(ReadsThen, ReadsElse)), ann_reads(Code, Reads1, [{ifte, Then1, Else1} | Acc]); ann_reads([{Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, #{ read := Rs, write := Ws, pure := Pure } = attributes(I), Reads1 = case Pure andalso length(Ws) == 1 andalso not ordsets:is_element(hd(Ws), Reads) of %% This is a little bit dangerous: if writing to a dead variable, we ignore %% the reads. Relies on dead writes to be removed by the %% optimisations below (r_write_to_dead_var). true -> Reads; false -> ordsets:union(Reads, Rs) end, LiveIn = ordsets:intersection(Reads1, WritesIn), LiveOut = ordsets:intersection(Reads, WritesOut), Ann1 = #{ live_in => LiveIn, live_out => LiveOut }, ann_reads(Code, Reads1, [{Ann1, I} | Acc]); ann_reads([], Reads, Acc) -> {Acc, Reads}. %% Read/write to variables and purity. attributes(I) -> Set = fun(L) when is_list(L) -> ordsets:from_list([X || X <- L, X /= ?a]); (X) -> ordsets:from_list([X || X /= ?a]) end, WR = fun(W, R) -> #{read => Set(R), write => Set(W), pure => false} end, R = fun(X) -> WR([], X) end, W = fun(X) -> WR(X, []) end, None = WR([], []), Pure = fun(A) -> A#{ pure := true } end, case I of 'RETURN' -> None; {'RETURNR', A} -> R(A); {'CALL', _} -> None; {'CALL_R', A, _} -> R(A); {'CALL_T', _} -> None; {'CALL_TR', A, _} -> R(A); {'JUMP', _} -> Pure(None); {'JUMPIF', A, _} -> Pure(R(A)); {'SWITCH_V2', A, _, _} -> Pure(R(A)); {'SWITCH_V3', A, _, _, _} -> Pure(R(A)); {'SWITCH_VN', A, _} -> Pure(R(A)); {'PUSH', A} -> Pure(R(A)); 'DUPA' -> Pure(None); {'DUP', A} -> Pure(R(A)); {'POP', A} -> Pure(W(A)); {'STORE', A, B} -> Pure(WR(A, B)); 'INCA' -> Pure(None); {'INC', A} -> Pure(WR(A, A)); 'DECA' -> Pure(None); {'DEC', A} -> Pure(WR(A, A)); {'ADD', A, B, C} -> Pure(WR(A, [B, C])); {'SUB', A, B, C} -> Pure(WR(A, [B, C])); {'MUL', A, B, C} -> Pure(WR(A, [B, C])); {'DIV', A, B, C} -> Pure(WR(A, [B, C])); {'MOD', A, B, C} -> Pure(WR(A, [B, C])); {'POW', A, B, C} -> Pure(WR(A, [B, C])); {'LT', A, B, C} -> Pure(WR(A, [B, C])); {'GT', A, B, C} -> Pure(WR(A, [B, C])); {'EQ', A, B, C} -> Pure(WR(A, [B, C])); {'ELT', A, B, C} -> Pure(WR(A, [B, C])); {'EGT', A, B, C} -> Pure(WR(A, [B, C])); {'NEQ', A, B, C} -> Pure(WR(A, [B, C])); {'AND', A, B, C} -> Pure(WR(A, [B, C])); {'OR', A, B, C} -> Pure(WR(A, [B, C])); {'NOT', A, B} -> Pure(WR(A, B)); {'TUPLE', _} -> Pure(None); {'ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); {'MAP_EMPTY', A} -> Pure(W(A)); {'MAP_LOOKUP', A, B, C} -> Pure(WR(A, [B, C])); {'MAP_LOOKUPD', A, B, C, D} -> Pure(WR(A, [B, C, D])); {'MAP_UPDATE', A, B, C, D} -> Pure(WR(A, [B, C, D])); {'MAP_DELETE', A, B, C} -> Pure(WR(A, [B, C])); {'MAP_MEMBER', A, B, C} -> Pure(WR(A, [B, C])); {'MAP_FROM_LIST', A, B} -> Pure(WR(A, B)); {'NIL', A} -> Pure(W(A)); {'IS_NIL', A, B} -> Pure(WR(A, B)); {'CONS', A, B, C} -> Pure(WR(A, [B, C])); {'HD', A, B} -> Pure(WR(A, B)); {'TL', A, B} -> Pure(WR(A, B)); {'LENGTH', A, B} -> Pure(WR(A, B)); {'STR_EQ', A, B, C} -> Pure(WR(A, [B, C])); {'STR_JOIN', A, B, C} -> Pure(WR(A, [B, C])); {'INT_TO_STR', A, B} -> Pure(WR(A, B)); {'ADDR_TO_STR', A, B} -> Pure(WR(A, B)); {'STR_REVERSE', A, B} -> Pure(WR(A, B)); {'INT_TO_ADDR', A, B} -> Pure(WR(A, B)); {'VARIANT', A, B, C, D} -> Pure(WR(A, [B, C, D])); {'VARIANT_TEST', A, B, C} -> Pure(WR(A, [B, C])); {'VARIANT_ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); 'BITS_NONEA' -> Pure(None); {'BITS_NONE', A} -> Pure(W(A)); 'BITS_ALLA' -> Pure(None); {'BITS_ALL', A} -> Pure(W(A)); {'BITS_ALL_N', A, B} -> Pure(WR(A, B)); {'BITS_SET', A, B, C} -> Pure(WR(A, [B, C])); {'BITS_CLEAR', A, B, C} -> Pure(WR(A, [B, C])); {'BITS_TEST', A, B, C} -> Pure(WR(A, [B, C])); {'BITS_SUM', A, B} -> Pure(WR(A, B)); {'BITS_OR', A, B, C} -> Pure(WR(A, [B, C])); {'BITS_AND', A, B, C} -> Pure(WR(A, [B, C])); {'BITS_DIFF', A, B, C} -> Pure(WR(A, [B, C])); {'ADDRESS', A} -> Pure(W(A)); {'BALANCE', A} -> Pure(W(A)); {'ORIGIN', A} -> Pure(W(A)); {'CALLER', A} -> Pure(W(A)); {'GASPRICE', A} -> Pure(W(A)); {'BLOCKHASH', A} -> Pure(W(A)); {'BENEFICIARY', A} -> Pure(W(A)); {'TIMESTAMP', A} -> Pure(W(A)); {'GENERATION', A} -> Pure(W(A)); {'MICROBLOCK', A} -> Pure(W(A)); {'DIFFICULTY', A} -> Pure(W(A)); {'GASLIMIT', A} -> Pure(W(A)); {'GAS', A} -> Pure(W(A)); {'LOG0', A, B} -> R([A, B]); {'LOG1', A, B, C} -> R([A, B, C]); {'LOG2', A, B, C, D} -> R([A, B, C, D]); {'LOG3', A, B, C, D, E} -> R([A, B, C, D, E]); {'LOG4', A, B, C, D, E, F} -> R([A, B, C, D, E, F]); 'DEACTIVATE' -> None; {'SPEND', A, B} -> R([A, B]); {'ORACLE_REGISTER', A, B, C, D, E, F} -> WR(A, [B, C, D, E, F]); 'ORACLE_QUERY' -> None; %% TODO 'ORACLE_RESPOND' -> None; %% TODO 'ORACLE_EXTEND' -> None; %% TODO 'ORACLE_GET_ANSWER' -> None; %% TODO 'ORACLE_GET_QUESTION' -> None; %% TODO 'ORACLE_QUERY_FEE' -> None; %% TODO 'AENS_RESOLVE' -> None; %% TODO 'AENS_PRECLAIM' -> None; %% TODO 'AENS_CLAIM' -> None; %% TODO 'AENS_UPDATE' -> None; %% TODO 'AENS_TRANSFER' -> None; %% TODO 'AENS_REVOKE' -> None; %% TODO 'ECVERIFY' -> Pure(None); %% TODO 'SHA3' -> Pure(None); %% TODO 'SHA256' -> Pure(None); %% TODO 'BLAKE2B' -> Pure(None); %% TODO {'ABORT', A} -> R(A); {'EXIT', A} -> R(A); 'NOP' -> Pure(None) end. merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> #{ live_in => LiveIn, live_out => LiveOut }. %% When swapping two instructions swap_ann(#{ live_in := Live1, live_out := Live2 }, #{ live_in := Live2, live_out := Live3 }) -> Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation {#{ live_in => Live1, live_out => Live2_ }, #{ live_in => Live2_, live_out => Live3 }}. %% live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). %% -- Optimizations -- simplify([], _) -> []; simplify([I | Code], Options) -> simpl_top(simpl_s(I, Options), simplify(Code, Options), Options). simpl_s({ifte, Then, Else}, Options) -> {ifte, simplify(Then, Options), simplify(Else, Options)}; simpl_s(I, _) -> I. simpl_top(I, Code, Options) -> apply_rules(rules(), I, Code, Options). apply_rules([], I, Code, _) -> [I | Code]; apply_rules([{_RName, Rule} | Rules], I, Code, Options) -> Cons = fun(X, Xs) -> simpl_top(X, Xs, Options) end, case Rule(I, Code) of false -> apply_rules(Rules, I, Code, Options); {New, Rest} -> debug(opt_rules, Options, "Applied ~p:\n~s ==>\n~s", [_RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), lists:foldr(Cons, Rest, New) end. -define(RULE(Name), {Name, fun Name/2}). rules() -> [?RULE(r_push_consume), ?RULE(r_dup_to_push), ?RULE(r_swap_instrs), ?RULE(r_one_shot_var), ?RULE(r_write_to_dead_var) ]. %% Removing pushes that are immediately consumed. r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of true -> {[{merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; false -> {[], Code} end; %% Writing directly to memory instead of going through the accumulator. r_push_consume({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations r_dup_to_push(I = {Ann, {'PUSH', A}}, [{_, 'DUPA'} | Code]) -> #{ live_in := Live } = Ann, Ann1 = #{ live_in => Live, live_out => Live }, {[{Ann1, {'PUSH', A}}, I], Code}; r_dup_to_push(_, _) -> false. %% Move PUSH A past an operator. Make sure the next instruction isn't writing %% to A, pushing to the stack or reading the accumulator. r_swap_instrs({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinOp(Op), A /= R, A /= ?a, B /= ?a, C /= ?a -> {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), {[{Ann1_, I}, {Ann2_, {'PUSH', A}}], Code}; %% Move writes to a variable as late as possible r_swap_instrs({Ann1, I1 = {Op1, R = {var, _}, A, B}}, [{Ann2, I2 = {Op2, S, C, D}} | Code]) when ?IsBinOp(Op1), ?IsBinOp(Op2), element(1, S) /= var orelse S < R, S /= A, S /= B, C /= R, D /= R, A /= ?a andalso B /= ?a orelse S /= ?a andalso C /= ?a andalso D /= ?a -> {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), {[{Ann1_, I2}, {Ann2_, I1}], Code}; r_swap_instrs(_, _) -> false. %% Shortcut write followed by final read r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> Copy = case J of {'PUSH', R} -> {write_to, ?a}; {'STORE', S, R} -> {write_to, S}; _ -> false end, case {live_out(R, Ann2), Copy} of {false, {write_to, X}} -> {[{merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code}; _ -> false end; r_one_shot_var(_, _) -> false. %% Remove writes to dead variables r_write_to_dead_var({Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> case live_out(R, Ann) of false -> %% Subtle: we still have to pop the stack if any of the arguments %% came from there. In this case we pop to R, which we know is %% unused. {[{Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; true -> false end; r_write_to_dead_var(_, _) -> false. %% Desugar and specialize and remove annotations desugar({_Ann, {'ADD', ?a, ?i(1), ?a}}) -> [aeb_fate_code:inc()]; desugar({_Ann, {'SUB', ?a, ?a, ?i(1)}}) -> [aeb_fate_code:dec()]; desugar({ifte, Then, Else}) -> [{ifte, desugar(Then), desugar(Else)}]; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); desugar({_Ann, I}) -> [I]. %% -- Phase III -------------------------------------------------------------- %% Constructing basic blocks to_basic_blocks(Funs, Options) -> maps:from_list([ {Name, {{Args, Res}, bb(Name, Code ++ [aeb_fate_code:return()], Options)}} || {Name, {{Args, Res}, Code}} <- maps:to_list(Funs) ]). bb(_Name, Code, _Options) -> Blocks0 = blocks(Code), Blocks = optimize_blocks(Blocks0), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), BBs = [ set_labels(Labels, B) || B <- Blocks ], maps:from_list(BBs). %% -- Break up scode into basic blocks -- blocks(Code) -> Top = make_ref(), blocks([{Top, Code}], []). blocks([], Acc) -> lists:reverse(Acc); blocks([{Ref, Code} | Blocks], Acc) -> block(Ref, Code, [], Blocks, Acc). block(Ref, [], CodeAcc, Blocks, BlockAcc) -> blocks(Blocks, [{Ref, lists:reverse(CodeAcc)} | BlockAcc]); block(Ref, [{ifte, Then, Else} | Code], Acc, Blocks, BlockAcc) -> ThenLbl = make_ref(), RestLbl = make_ref(), block(Ref, Else ++ [{jump, RestLbl}], [{jumpif, ThenLbl} | Acc], [{ThenLbl, Then ++ [{jump, RestLbl}]}, {RestLbl, Code} | Blocks], BlockAcc); block(Ref, [I | Code], Acc, Blocks, BlockAcc) -> block(Ref, Code, [I | Acc], Blocks, BlockAcc). %% -- Reorder, inline, and remove dead blocks -- optimize_blocks(Blocks) -> %% We need to look at the last instruction a lot, so reverse all blocks. Rev = fun(Bs) -> [ {Ref, lists:reverse(Code)} || {Ref, Code} <- Bs ] end, RBlocks = Rev(Blocks), RBlockMap = maps:from_list(RBlocks), RBlocks1 = reorder_blocks(RBlocks, []), RBlocks2 = [ {Ref, inline_block(RBlockMap, Ref, Code)} || {Ref, Code} <- RBlocks1 ], RBlocks3 = remove_dead_blocks(RBlocks2), RBlocks4 = [ {Ref, use_returnr(Code)} || {Ref, Code} <- RBlocks3 ], Rev(RBlocks4). %% Choose the next block based on the final jump. reorder_blocks([], Acc) -> lists:reverse(Acc); reorder_blocks([{Ref, Code} | Blocks], Acc) -> reorder_blocks(Ref, Code, Blocks, Acc). reorder_blocks(Ref, Code, Blocks, Acc) -> Acc1 = [{Ref, Code} | Acc], case Code of ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); [{jump, L}|_] -> NotL = fun({L1, _}) -> L1 /= L end, case lists:splitwith(NotL, Blocks) of {Blocks1, [{L, Code1} | Blocks2]} -> reorder_blocks(L, Code1, Blocks1 ++ Blocks2, Acc1); {_, []} -> reorder_blocks(Blocks, Acc1) end end. %% Inline short blocks (≤ 2 instructions) inline_block(BlockMap, Ref, [{jump, L} | Code] = Code0) when L /= Ref -> case maps:get(L, BlockMap, nocode) of Dest when length(Dest) < 3 -> %% Remove Ref to avoid infinite loops inline_block(maps:remove(Ref, BlockMap), L, Dest) ++ Code; _ -> Code0 end; inline_block(_, _, Code) -> Code. %% Remove unused blocks remove_dead_blocks(Blocks = [{Top, _} | _]) -> BlockMap = maps:from_list(Blocks), LiveBlocks = chase_labels([Top], BlockMap, #{}), [ B || B = {L, _} <- Blocks, maps:is_key(L, LiveBlocks) ]. chase_labels([], _, Live) -> Live; chase_labels([L | Ls], Map, Live) -> Code = maps:get(L, Map), Jump = fun({jump, A}) -> [A || not maps:is_key(A, Live)]; ({jumpif, A}) -> [A || not maps:is_key(A, Live)]; (_) -> [] end, New = lists:flatmap(Jump, Code), chase_labels(New ++ Ls, Map, Live#{ L => true }). %% Replace PUSH, RETURN by RETURNR use_returnr(['RETURN', {'PUSH', A} | Code]) -> [{'RETURNR', A} | Code]; use_returnr(Code) -> Code. %% -- Translate label refs to indices -- set_labels(Labels, {Ref, Code}) when is_reference(Ref) -> {maps:get(Ref, Labels), [ set_labels(Labels, I) || I <- Code ]}; set_labels(Labels, {jump, Ref}) -> aeb_fate_code:jump(maps:get(Ref, Labels)); set_labels(Labels, {jumpif, Ref}) -> aeb_fate_code:jumpif(?a, maps:get(Ref, Labels)); set_labels(_, I) -> I. %% -- Helpers ---------------------------------------------------------------- with_ixs(Xs) -> lists:zip(lists:seq(0, length(Xs) - 1), Xs). keyfind_index(X, J, Xs) -> case [ I || {I, E} <- with_ixs(Xs), X == element(J, E) ] of [I | _] -> I; [] -> false end. find_index(X, Xs) -> case lists:keyfind(X, 2, with_ixs(Xs)) of {I, _} -> I; false -> false end.